This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
f431a385a5541dd95a09898739074de3e417e08f
[perl5.git] / cpan / Digest / t / file.t
1 #!perl -w
2
3 use Test qw(plan ok);
4 plan tests => 5;
5
6 {
7    package Digest::Foo;
8    require Digest::base;
9    use vars qw(@ISA $VERSION);
10    @ISA = qw(Digest::base);
11
12    sub new {
13         my $class = shift;
14         my $str = "";
15         bless \$str, $class;
16    }
17
18    sub add {
19         my $self = shift;
20         $$self .= join("", @_);
21         return $self;
22    }
23
24    sub digest {
25         my $self = shift;
26         return sprintf "%04d", length($$self);
27    }
28 }
29
30 use Digest::file qw(digest_file digest_file_hex digest_file_base64);
31
32 my $file = "test-$$";
33 die if -f $file;
34 open(F, ">$file") || die "Can't create '$file': $!";
35 binmode(F);
36 print F "foo\0\n";
37 close(F) || die "Can't write '$file': $!";
38
39 ok(digest_file($file, "Foo"), "0005");
40
41 if (ord('A') == 193) { # EBCDIC.
42     ok(digest_file_hex($file, "Foo"), "f0f0f0f5");
43     ok(digest_file_base64($file, "Foo"), "8PDw9Q");
44 } else {
45     ok(digest_file_hex($file, "Foo"), "30303035");
46     ok(digest_file_base64($file, "Foo"), "MDAwNQ");
47 }
48
49 unlink($file) || warn "Can't unlink '$file': $!";
50
51 ok(eval { digest_file("not-there.txt", "Foo") }, undef);
52 ok($@);