1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir 't' if -d 't'; 4 @INC = '../lib'; 5 } 6} 7 8print "1..4\n"; 9 10use strict; 11use Digest::MD5 qw(md5 md5_hex md5_base64); 12 13# To update the EBCDIC section even on a Latin 1 platform, 14# run this script with $ENV{EBCDIC_MD5SUM} set to a true value. 15# (You'll need to have Perl 5.7.3 or later, to have the Encode installed.) 16# (And remember that under the Perl core distribution you should 17# also have the $ENV{PERL_CORE} set to a true value.) 18# Similarly, to update MacOS section, run with $ENV{MAC_MD5SUM} set. 19 20my $EXPECT; 21if (ord "A" == 193) { # EBCDIC 22 $EXPECT = <<EOT; 23c7b68bb806b2d42f4a11511132e94ae8 Changes 2411e8028ee426273db6b6db270a8bb38c README 25347d5b9f257eb62eaab60b3d952451f7 MD5.pm 26b61eb1bba8cc490040d02f6bf24874f7 MD5.xs 27EOT 28} elsif ("\n" eq "\015") { # MacOS 29 $EXPECT = <<EOT; 30628699b88b6a803225678802d2470067 Changes 31c95549c6c5e1e1c078b27042f1dc850f README 3277503ff007841a671275fdf544dad68e MD5.pm 33716c3278fd80338727c100e5d2a76795 MD5.xs 34EOT 35} else { 36 # This is the output of: 'md5sum Changes README MD5.pm MD5.xs' 37 $EXPECT = <<EOT; 38412c1a5ebd635befbf501531541a8743 Changes 39c95549c6c5e1e1c078b27042f1dc850f README 4077503ff007841a671275fdf544dad68e MD5.pm 415289d80c50daace1e08c9d4dd3840199 MD5.xs 42EOT 43} 44 45if (!(-f "README") && -f "../README") { 46 chdir("..") or die "Can't chdir: $!"; 47} 48 49my $testno = 0; 50 51my $B64 = 1; 52eval { require MIME::Base64; }; 53if ($@) { 54 print "# $@: Will not test base64 methods\n"; 55 $B64 = 0; 56} 57 58for (split /^/, $EXPECT) { 59 my($md5hex, $file) = split ' '; 60 my $base = $file; 61# print "# $base\n"; 62 if ($ENV{PERL_CORE}) { 63 use File::Spec; 64 my @path = qw(ext Digest MD5); 65 my $path = File::Spec->updir; 66 while (@path) { 67 $path = File::Spec->catdir($path, shift @path); 68 } 69 $file = File::Spec->catfile($path, $file); 70 } 71# print "# file = $file\n"; 72 unless (-f $file) { 73 warn "No such file: $file\n"; 74 next; 75 } 76 if ($ENV{EBCDIC_MD5SUM}) { 77 require Encode; 78 my $data = cat_file($file); 79 Encode::from_to($data, 'latin1', 'cp1047'); 80 print md5_hex($data), " $base\n"; 81 next; 82 } 83 if ($ENV{MAC_MD5SUM}) { 84 require Encode; 85 my $data = cat_file($file); 86 Encode::from_to($data, 'latin1', 'MacRoman'); 87 print md5_hex($data), " $base\n"; 88 next; 89 } 90 my $md5bin = pack("H*", $md5hex); 91 my $md5b64; 92 if ($B64) { 93 $md5b64 = MIME::Base64::encode($md5bin, ""); 94 chop($md5b64); chop($md5b64); # remove padding 95 } 96 my $failed; 97 my $got; 98 99 if (digest_file($file, 'digest') ne $md5bin) { 100 print "$file: Bad digest\n"; 101 $failed++; 102 } 103 104 if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { 105 print "$file: Bad hexdigest: got $got expected $md5hex\n"; 106 $failed++; 107 } 108 109 if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { 110 print "$file: Bad b64digest\n"; 111 $failed++; 112 } 113 114 my $data = cat_file($file); 115 if (md5($data) ne $md5bin) { 116 print "$file: md5() failed\n"; 117 $failed++; 118 } 119 if (md5_hex($data) ne $md5hex) { 120 print "$file: md5_hex() failed\n"; 121 $failed++; 122 } 123 if ($B64 && md5_base64($data) ne $md5b64) { 124 print "$file: md5_base64() failed\n"; 125 $failed++; 126 } 127 128 if (Digest::MD5->new->add($data)->digest ne $md5bin) { 129 print "$file: MD5->new->add(...)->digest failed\n"; 130 $failed++; 131 } 132 if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { 133 print "$file: MD5->new->add(...)->hexdigest failed\n"; 134 $failed++; 135 } 136 if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { 137 print "$file: MD5->new->add(...)->b64digest failed\n"; 138 $failed++; 139 } 140 141 my @data = split //, $data; 142 if (md5(@data) ne $md5bin) { 143 print "$file: md5(\@data) failed\n"; 144 $failed++; 145 } 146 if (Digest::MD5->new->add(@data)->digest ne $md5bin) { 147 print "$file: MD5->new->add(\@data)->digest failed\n"; 148 $failed++; 149 } 150 my $md5 = Digest::MD5->new; 151 for (@data) { 152 $md5->add($_); 153 } 154 if ($md5->digest ne $md5bin) { 155 print "$file: $md5->add()-loop failed\n"; 156 $failed++; 157 } 158 159 print "not " if $failed; 160 print "ok ", ++$testno, "\n"; 161} 162 163 164sub digest_file 165{ 166 my($file, $method) = @_; 167 $method ||= "digest"; 168 #print "$file $method\n"; 169 170 open(FILE, $file) or die "Can't open $file: $!"; 171 my $digest = Digest::MD5->new->addfile(*FILE)->$method(); 172 close(FILE); 173 174 $digest; 175} 176 177sub cat_file 178{ 179 my($file) = @_; 180 local $/; # slurp 181 open(FILE, $file) or die "Can't open $file: $!"; 182 183 # For PerlIO in case of UTF-8 locales. 184 eval 'binmode(FILE, ":bytes")' if $] >= 5.008; 185 186 my $tmp = <FILE>; 187 close(FILE); 188 $tmp; 189} 190 191