Commit | Line | Data |
---|---|---|
9508959b JH |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { | |
3 | chdir 't' if -d 't'; | |
4 | @INC = '../lib'; | |
5 | } | |
6 | } | |
7 | ||
5a046520 | 8 | print "1..5\n"; |
3357b1b1 JH |
9 | |
10 | use strict; | |
4d5cc332 | 11 | use Digest::MD5 qw(md5 md5_hex md5_base64); |
3357b1b1 | 12 | |
8ff693ee JH |
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.) | |
e69a2255 | 18 | # Similarly, to update MacOS section, run with $ENV{MAC_MD5SUM} set. |
8ff693ee | 19 | |
9a03235d | 20 | my $EXPECT; |
9508959b JH |
21 | if (ord "A" == 193) { # EBCDIC |
22 | $EXPECT = <<EOT; | |
ac70dec1 | 23 | fcc48d6bb88ca8065bf9ddfcb9e7483e Changes |
f62a1bde | 24 | 0565ec21b15c0f23f4c51fb327c8926d README |
ac70dec1 | 25 | 1965beb0e48253b694220fbb5d6230f5 MD5.pm |
263df5f1 | 26 | 5b3c24da3f70f3c0938cc7c205a28ab7 MD5.xs |
e69a2255 JH |
27 | 276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt |
28 | EOT | |
4c7fc0a4 | 29 | } elsif ("\n" eq "\015") { # MacOS |
e69a2255 | 30 | $EXPECT = <<EOT; |
ac70dec1 | 31 | f161f474603c54a0093ad2f6f93be33b Changes |
f05fc781 | 32 | 6c950a0211a5a28f023bb482037698cd README |
ac70dec1 | 33 | 18178c90bc13d6824f6c96973b6e9433 MD5.pm |
263df5f1 | 34 | 2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs |
9a03235d | 35 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
fed3f325 | 36 | EOT |
9508959b | 37 | } else { |
9a03235d | 38 | # This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt' |
9508959b | 39 | $EXPECT = <<EOT; |
ac70dec1 | 40 | 029fa5059ba0b2175cee09ab5d9b7b73 Changes |
f62a1bde | 41 | 6c950a0211a5a28f023bb482037698cd README |
ac70dec1 | 42 | 18178c90bc13d6824f6c96973b6e9433 MD5.pm |
263df5f1 | 43 | 2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs |
9508959b JH |
44 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
45 | EOT | |
46 | } | |
5a046520 JH |
47 | |
48 | if (!(-f "README") && -f "../README") { | |
49 | chdir("..") or die "Can't chdir: $!"; | |
fed3f325 | 50 | } |
8c42d64c | 51 | |
5a046520 JH |
52 | my $testno = 0; |
53 | ||
4d5cc332 JH |
54 | my $B64 = 1; |
55 | eval { require MIME::Base64; }; | |
56 | if ($@) { | |
9508959b | 57 | print "# $@: Will not test base64 methods\n"; |
4d5cc332 JH |
58 | $B64 = 0; |
59 | } | |
60 | ||
3357b1b1 JH |
61 | for (split /^/, $EXPECT) { |
62 | my($md5hex, $file) = split ' '; | |
8ff693ee | 63 | my $base = $file; |
f05fc781 | 64 | # print "# $base\n"; |
9508959b | 65 | if ($ENV{PERL_CORE}) { |
34791a82 | 66 | if ($file eq 'rfc1321.txt') { # Don't have it in core. |
9508959b JH |
67 | print "ok ", ++$testno, " # Skip: PERL_CORE\n"; |
68 | next; | |
69 | } | |
70 | use File::Spec; | |
71 | my @path = qw(ext Digest MD5); | |
72 | my $path = File::Spec->updir; | |
73 | while (@path) { | |
74 | $path = File::Spec->catdir($path, shift @path); | |
75 | } | |
76 | $file = File::Spec->catfile($path, $file); | |
77 | } | |
78 | # print "# file = $file\n"; | |
8ff693ee JH |
79 | unless (-f $file) { |
80 | warn "No such file: $file\n"; | |
81 | next; | |
82 | } | |
83 | if ($ENV{EBCDIC_MD5SUM}) { | |
0dfa9f37 | 84 | require Encode; |
8ff693ee | 85 | my $data = cat_file($file); |
0dfa9f37 | 86 | Encode::from_to($data, 'latin1', 'cp1047'); |
e69a2255 JH |
87 | print md5_hex($data), " $base\n"; |
88 | next; | |
89 | } | |
90 | if ($ENV{MAC_MD5SUM}) { | |
f05fc781 | 91 | require Encode; |
e69a2255 | 92 | my $data = cat_file($file); |
f05fc781 | 93 | Encode::from_to($data, 'latin1', 'MacRoman'); |
e69a2255 | 94 | print md5_hex($data), " $base\n"; |
8ff693ee JH |
95 | next; |
96 | } | |
3357b1b1 | 97 | my $md5bin = pack("H*", $md5hex); |
4d5cc332 JH |
98 | my $md5b64; |
99 | if ($B64) { | |
100 | $md5b64 = MIME::Base64::encode($md5bin, ""); | |
101 | chop($md5b64); chop($md5b64); # remove padding | |
102 | } | |
3357b1b1 | 103 | my $failed; |
9508959b | 104 | my $got; |
3357b1b1 JH |
105 | |
106 | if (digest_file($file, 'digest') ne $md5bin) { | |
107 | print "$file: Bad digest\n"; | |
108 | $failed++; | |
109 | } | |
110 | ||
9508959b JH |
111 | if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { |
112 | print "$file: Bad hexdigest: got $got expected $md5hex\n"; | |
3357b1b1 JH |
113 | $failed++; |
114 | } | |
115 | ||
4d5cc332 JH |
116 | if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { |
117 | print "$file: Bad b64digest\n"; | |
118 | $failed++; | |
119 | } | |
120 | ||
3357b1b1 JH |
121 | my $data = cat_file($file); |
122 | if (md5($data) ne $md5bin) { | |
123 | print "$file: md5() failed\n"; | |
124 | $failed++; | |
125 | } | |
126 | if (md5_hex($data) ne $md5hex) { | |
127 | print "$file: md5_hex() failed\n"; | |
128 | $failed++; | |
129 | } | |
4d5cc332 JH |
130 | if ($B64 && md5_base64($data) ne $md5b64) { |
131 | print "$file: md5_base64() failed\n"; | |
132 | $failed++; | |
133 | } | |
3357b1b1 JH |
134 | |
135 | if (Digest::MD5->new->add($data)->digest ne $md5bin) { | |
136 | print "$file: MD5->new->add(...)->digest failed\n"; | |
137 | $failed++; | |
138 | } | |
139 | if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { | |
140 | print "$file: MD5->new->add(...)->hexdigest failed\n"; | |
141 | $failed++; | |
142 | } | |
4d5cc332 JH |
143 | if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { |
144 | print "$file: MD5->new->add(...)->b64digest failed\n"; | |
145 | $failed++; | |
146 | } | |
3357b1b1 JH |
147 | |
148 | my @data = split //, $data; | |
149 | if (md5(@data) ne $md5bin) { | |
150 | print "$file: md5(\@data) failed\n"; | |
151 | $failed++; | |
152 | } | |
153 | if (Digest::MD5->new->add(@data)->digest ne $md5bin) { | |
154 | print "$file: MD5->new->add(\@data)->digest failed\n"; | |
155 | $failed++; | |
156 | } | |
157 | my $md5 = Digest::MD5->new; | |
158 | for (@data) { | |
159 | $md5->add($_); | |
160 | } | |
161 | if ($md5->digest ne $md5bin) { | |
162 | print "$file: $md5->add()-loop failed\n"; | |
163 | $failed++; | |
164 | } | |
165 | ||
166 | print "not " if $failed; | |
167 | print "ok ", ++$testno, "\n"; | |
168 | } | |
169 | ||
170 | ||
171 | sub digest_file | |
172 | { | |
173 | my($file, $method) = @_; | |
174 | $method ||= "digest"; | |
175 | #print "$file $method\n"; | |
176 | ||
177 | open(FILE, $file) or die "Can't open $file: $!"; | |
3357b1b1 JH |
178 | my $digest = Digest::MD5->new->addfile(*FILE)->$method(); |
179 | close(FILE); | |
180 | ||
181 | $digest; | |
182 | } | |
183 | ||
184 | sub cat_file | |
185 | { | |
186 | my($file) = @_; | |
187 | local $/; # slurp | |
188 | open(FILE, $file) or die "Can't open $file: $!"; | |
19f0e64f | 189 | |
9a03235d GA |
190 | # For PerlIO in case of UTF-8 locales. |
191 | eval 'binmode(FILE, ":bytes")' if $] >= 5.008; | |
19f0e64f | 192 | |
3357b1b1 JH |
193 | my $tmp = <FILE>; |
194 | close(FILE); | |
195 | $tmp; | |
196 | } | |
197 |