files.t revision 1.13
1250003Sadrian 2250003Sadrianprint "1..3\n"; 3250003Sadrian 4250003Sadrianuse strict; 5250003Sadrianuse Digest::MD5 qw(md5 md5_hex md5_base64); 6250003Sadrian 7250003Sadrian# To update the EBCDIC section even on a Latin 1 platform, 8250003Sadrian# run this script with $ENV{EBCDIC_MD5SUM} set to a true value. 9250003Sadrian# (You'll need to have Perl 5.7.3 or later, to have the Encode installed.) 10250003Sadrian# (And remember that under the Perl core distribution you should 11250003Sadrian# also have the $ENV{PERL_CORE} set to a true value.) 12250003Sadrian 13250003Sadrianmy $EXPECT; 14250003Sadrianif (ord "A" == 193) { # EBCDIC 15250003Sadrian $EXPECT = <<EOT; 16250003Sadrian0956ffb4f6416082b27d6680b4cf73fc README 17250003Sadrian2a61dd5022b11faa35eed27d1c6c98c2 MD5.xs 18250003Sadrian276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt 19250003SadrianEOT 20250003Sadrian} else { 21250003Sadrian # This is the output of: 'md5sum README MD5.xs rfc1321.txt' 22250003Sadrian $EXPECT = <<EOT; 23250003Sadrian2f93400875dbb56f36691d5f69f3eba5 README 24250003Sadrian0a0cf2512d18d24c6881d7d755e2b609 MD5.xs 25250003Sadrian754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt 26250008SadrianEOT 27250003Sadrian} 28250003Sadrian 29250003Sadrianif (!(-f "README") && -f "../README") { 30250003Sadrian chdir("..") or die "Can't chdir: $!"; 31250003Sadrian} 32250003Sadrian 33250003Sadrianmy $testno = 0; 34250003Sadrian 35250003Sadrianmy $B64 = 1; 36250003Sadrianeval { require MIME::Base64; }; 37250003Sadrianif ($@) { 38250003Sadrian print "# $@: Will not test base64 methods\n"; 39250003Sadrian $B64 = 0; 40250003Sadrian} 41250003Sadrian 42250003Sadrianfor (split /^/, $EXPECT) { 43250003Sadrian my($md5hex, $file) = split ' '; 44250003Sadrian my $base = $file; 45250003Sadrian# print "# $base\n"; 46250003Sadrian if ($ENV{PERL_CORE}) { 47250003Sadrian # Don't have these in core. 48250008Sadrian if ($file eq 'rfc1321.txt' or $file eq 'README') { 49250003Sadrian print "ok ", ++$testno, " # Skip: PERL_CORE\n"; 50250003Sadrian next; 51250008Sadrian } 52250003Sadrian } 53250003Sadrian# print "# file = $file\n"; 54250003Sadrian unless (-f $file) { 55250003Sadrian warn "No such file: $file\n"; 56250003Sadrian next; 57250003Sadrian } 58250003Sadrian if ($ENV{EBCDIC_MD5SUM}) { 59250003Sadrian require Encode; 60250003Sadrian my $data = cat_file($file); 61250003Sadrian Encode::from_to($data, 'latin1', 'cp1047'); 62250003Sadrian print md5_hex($data), " $base\n"; 63250003Sadrian next; 64250003Sadrian } 65250003Sadrian my $md5bin = pack("H*", $md5hex); 66250003Sadrian my $md5b64; 67250003Sadrian if ($B64) { 68250003Sadrian $md5b64 = MIME::Base64::encode($md5bin, ""); 69250003Sadrian chop($md5b64); chop($md5b64); # remove padding 70250003Sadrian } 71250003Sadrian my $failed; 72250003Sadrian my $got; 73250003Sadrian 74250003Sadrian if (digest_file($file, 'digest') ne $md5bin) { 75250003Sadrian print "$file: Bad digest\n"; 76250003Sadrian $failed++; 77250003Sadrian } 78250003Sadrian 79250003Sadrian if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { 80250003Sadrian print "$file: Bad hexdigest: got $got expected $md5hex\n"; 81250003Sadrian $failed++; 82250003Sadrian } 83250003Sadrian 84250003Sadrian if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { 85250003Sadrian print "$file: Bad b64digest\n"; 86250003Sadrian $failed++; 87250003Sadrian } 88250003Sadrian 89250003Sadrian my $data = cat_file($file); 90250003Sadrian if (md5($data) ne $md5bin) { 91250003Sadrian print "$file: md5() failed\n"; 92250003Sadrian $failed++; 93250003Sadrian } 94250003Sadrian if (md5_hex($data) ne $md5hex) { 95250003Sadrian print "$file: md5_hex() failed\n"; 96250003Sadrian $failed++; 97250003Sadrian } 98250003Sadrian if ($B64 && md5_base64($data) ne $md5b64) { 99250003Sadrian print "$file: md5_base64() failed\n"; 100250003Sadrian $failed++; 101250003Sadrian } 102250003Sadrian 103250003Sadrian if (Digest::MD5->new->add($data)->digest ne $md5bin) { 104250003Sadrian print "$file: MD5->new->add(...)->digest failed\n"; 105250003Sadrian $failed++; 106250003Sadrian } 107250003Sadrian if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { 108250003Sadrian print "$file: MD5->new->add(...)->hexdigest failed\n"; 109250003Sadrian $failed++; 110250003Sadrian } 111250003Sadrian if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { 112250003Sadrian print "$file: MD5->new->add(...)->b64digest failed\n"; 113250003Sadrian $failed++; 114250003Sadrian } 115250003Sadrian 116250003Sadrian my @data = split //, $data; 117250003Sadrian if (md5(@data) ne $md5bin) { 118250003Sadrian print "$file: md5(\@data) failed\n"; 119250003Sadrian $failed++; 120250003Sadrian } 121250003Sadrian if (Digest::MD5->new->add(@data)->digest ne $md5bin) { 122250003Sadrian print "$file: MD5->new->add(\@data)->digest failed\n"; 123250003Sadrian $failed++; 124250003Sadrian } 125250003Sadrian my $md5 = Digest::MD5->new; 126250003Sadrian for (@data) { 127250003Sadrian $md5->add($_); 128250003Sadrian } 129250003Sadrian if ($md5->digest ne $md5bin) { 130250003Sadrian print "$file: $md5->add()-loop failed\n"; 131250003Sadrian $failed++; 132250003Sadrian } 133250003Sadrian 134250003Sadrian print "not " if $failed; 135250003Sadrian print "ok ", ++$testno, "\n"; 136250003Sadrian} 137250003Sadrian 138250003Sadrian 139250003Sadriansub digest_file 140250003Sadrian{ 141250003Sadrian my($file, $method) = @_; 142250003Sadrian $method ||= "digest"; 143250003Sadrian #print "$file $method\n"; 144250003Sadrian 145250003Sadrian open(FILE, $file) or die "Can't open $file: $!"; 146250003Sadrian my $digest = Digest::MD5->new->addfile(*FILE)->$method(); 147250003Sadrian close(FILE); 148250003Sadrian 149250003Sadrian $digest; 150250003Sadrian} 151250003Sadrian 152250003Sadriansub cat_file 153250003Sadrian{ 154250003Sadrian my($file) = @_; 155250003Sadrian local $/; # slurp 156250003Sadrian open(FILE, $file) or die "Can't open $file: $!"; 157250003Sadrian 158250003Sadrian # For PerlIO in case of UTF-8 locales. 159250003Sadrian eval 'binmode(FILE, ":bytes")' if $] >= 5.008; 160250003Sadrian 161250003Sadrian my $tmp = <FILE>; 162250003Sadrian close(FILE); 163250003Sadrian $tmp; 164250003Sadrian} 165250008Sadrian 166250003Sadrian