Fix files.t for blead.
[p5sagit/p5-mst-13.2.git] / ext / Digest / MD5 / t / files.t
CommitLineData
9508959b 1BEGIN {
2 if ($ENV{PERL_CORE}) {
3 chdir 't' if -d 't';
4 @INC = '../lib';
5 }
6}
7
5a046520 8print "1..5\n";
3357b1b1 9
10use strict;
4d5cc332 11use Digest::MD5 qw(md5 md5_hex md5_base64);
3357b1b1 12
13#
5a046520 14# This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt'
3357b1b1 15#
9508959b 16my $EXPECT;
17
18if (ord "A" == 193) { # EBCDIC
19 $EXPECT = <<EOT;
5a046520 2023cafa2de11474f0df8f808cc588bcc9 Changes
213519f3d02c7c91158f732f0f00064657 README
220268931475ae2a2e843ff58504cfa3f0 MD5.pm
231be293491bba726810f8e87671ee0328 MD5.xs
24754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
fed3f325 25EOT
9508959b 26} else {
27 $EXPECT = <<EOT;
2823cafa2de11474f0df8f808cc588bcc9 Changes
293519f3d02c7c91158f732f0f00064657 README
300268931475ae2a2e843ff58504cfa3f0 MD5.pm
311be293491bba726810f8e87671ee0328 MD5.xs
32754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
33EOT
34}
5a046520 35
36if (!(-f "README") && -f "../README") {
37 chdir("..") or die "Can't chdir: $!";
fed3f325 38}
8c42d64c 39
5a046520 40my $testno = 0;
41
4d5cc332 42my $B64 = 1;
43eval { require MIME::Base64; };
44if ($@) {
9508959b 45 print "# $@: Will not test base64 methods\n";
4d5cc332 46 $B64 = 0;
47}
48
3357b1b1 49for (split /^/, $EXPECT) {
50 my($md5hex, $file) = split ' ';
9508959b 51 if ($ENV{PERL_CORE}) {
52 if ($file eq 'rfc1321.txt') { # Don't have it in core.
53 print "ok ", ++$testno, " # Skip: PERL_CORE\n";
54 next;
55 }
56 use File::Spec;
57 my @path = qw(ext Digest MD5);
58 my $path = File::Spec->updir;
59 while (@path) {
60 $path = File::Spec->catdir($path, shift @path);
61 }
62 $file = File::Spec->catfile($path, $file);
63 }
64# print "# file = $file\n";
3357b1b1 65 my $md5bin = pack("H*", $md5hex);
4d5cc332 66 my $md5b64;
67 if ($B64) {
68 $md5b64 = MIME::Base64::encode($md5bin, "");
69 chop($md5b64); chop($md5b64); # remove padding
70 }
3357b1b1 71 my $failed;
9508959b 72 my $got;
3357b1b1 73
74 if (digest_file($file, 'digest') ne $md5bin) {
75 print "$file: Bad digest\n";
76 $failed++;
77 }
78
9508959b 79 if (($got = digest_file($file, 'hexdigest')) ne $md5hex) {
80 print "$file: Bad hexdigest: got $got expected $md5hex\n";
3357b1b1 81 $failed++;
82 }
83
4d5cc332 84 if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
85 print "$file: Bad b64digest\n";
86 $failed++;
87 }
88
3357b1b1 89 my $data = cat_file($file);
90 if (md5($data) ne $md5bin) {
91 print "$file: md5() failed\n";
92 $failed++;
93 }
94 if (md5_hex($data) ne $md5hex) {
95 print "$file: md5_hex() failed\n";
96 $failed++;
97 }
4d5cc332 98 if ($B64 && md5_base64($data) ne $md5b64) {
99 print "$file: md5_base64() failed\n";
100 $failed++;
101 }
3357b1b1 102
103 if (Digest::MD5->new->add($data)->digest ne $md5bin) {
104 print "$file: MD5->new->add(...)->digest failed\n";
105 $failed++;
106 }
107 if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
108 print "$file: MD5->new->add(...)->hexdigest failed\n";
109 $failed++;
110 }
4d5cc332 111 if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
112 print "$file: MD5->new->add(...)->b64digest failed\n";
113 $failed++;
114 }
3357b1b1 115
116 my @data = split //, $data;
117 if (md5(@data) ne $md5bin) {
118 print "$file: md5(\@data) failed\n";
119 $failed++;
120 }
121 if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
122 print "$file: MD5->new->add(\@data)->digest failed\n";
123 $failed++;
124 }
125 my $md5 = Digest::MD5->new;
126 for (@data) {
127 $md5->add($_);
128 }
129 if ($md5->digest ne $md5bin) {
130 print "$file: $md5->add()-loop failed\n";
131 $failed++;
132 }
133
134 print "not " if $failed;
135 print "ok ", ++$testno, "\n";
136}
137
138
139sub digest_file
140{
141 my($file, $method) = @_;
142 $method ||= "digest";
143 #print "$file $method\n";
144
145 open(FILE, $file) or die "Can't open $file: $!";
5a046520 146 binmode(FILE);
3357b1b1 147 my $digest = Digest::MD5->new->addfile(*FILE)->$method();
148 close(FILE);
149
150 $digest;
151}
152
153sub cat_file
154{
155 my($file) = @_;
156 local $/; # slurp
157 open(FILE, $file) or die "Can't open $file: $!";
5a046520 158 binmode(FILE);
3357b1b1 159 my $tmp = <FILE>;
160 close(FILE);
161 $tmp;
162}
163