Commit | Line | Data |
9508959b |
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 |
9 | |
10 | use strict; |
4d5cc332 |
11 | use Digest::MD5 qw(md5 md5_hex md5_base64); |
3357b1b1 |
12 | |
8ff693ee |
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 |
21 | if (ord "A" == 193) { # EBCDIC |
22 | $EXPECT = <<EOT; |
f62a1bde |
23 | ed8efe2e2dbab62fcc9dea2df6682569 Changes |
24 | 0565ec21b15c0f23f4c51fb327c8926d README |
25 | 0fcdd6d6e33b8772bd4b4832043035cd MD5.pm |
dcec8ef4 |
26 | de2c149900efee0fbb39ad87dea68a43 MD5.xs |
e69a2255 |
27 | 276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt |
28 | EOT |
4c7fc0a4 |
29 | } elsif ("\n" eq "\015") { # MacOS |
e69a2255 |
30 | $EXPECT = <<EOT; |
f62a1bde |
31 | 2879619f967d5fc5a00ffe37b639f2ee Changes |
32 | 6c950a0211a5a28f023bb482037698cd README |
33 | 4e1043f0a7a266416d8408d6fa96f454 MD5.pm |
dcec8ef4 |
34 | df178436ead9d354d63089fa0e01af27 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; |
f62a1bde |
40 | 2879619f967d5fc5a00ffe37b639f2ee Changes |
41 | 6c950a0211a5a28f023bb482037698cd README |
42 | 4e1043f0a7a266416d8408d6fa96f454 MD5.pm |
dcec8ef4 |
43 | df178436ead9d354d63089fa0e01af27 MD5.xs |
9508959b |
44 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
45 | EOT |
46 | } |
5a046520 |
47 | |
48 | if (!(-f "README") && -f "../README") { |
49 | chdir("..") or die "Can't chdir: $!"; |
fed3f325 |
50 | } |
8c42d64c |
51 | |
5a046520 |
52 | my $testno = 0; |
53 | |
4d5cc332 |
54 | my $B64 = 1; |
55 | eval { require MIME::Base64; }; |
56 | if ($@) { |
9508959b |
57 | print "# $@: Will not test base64 methods\n"; |
4d5cc332 |
58 | $B64 = 0; |
59 | } |
60 | |
3357b1b1 |
61 | for (split /^/, $EXPECT) { |
62 | my($md5hex, $file) = split ' '; |
8ff693ee |
63 | my $base = $file; |
dcec8ef4 |
64 | print "# $base\n"; |
9508959b |
65 | if ($ENV{PERL_CORE}) { |
34791a82 |
66 | if ($file eq 'rfc1321.txt') { # Don't have it in core. |
9508959b |
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 |
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 |
87 | print md5_hex($data), " $base\n"; |
88 | next; |
89 | } |
90 | if ($ENV{MAC_MD5SUM}) { |
91 | my $data = cat_file($file); |
92 | print md5_hex($data), " $base\n"; |
8ff693ee |
93 | next; |
94 | } |
3357b1b1 |
95 | my $md5bin = pack("H*", $md5hex); |
4d5cc332 |
96 | my $md5b64; |
97 | if ($B64) { |
98 | $md5b64 = MIME::Base64::encode($md5bin, ""); |
99 | chop($md5b64); chop($md5b64); # remove padding |
100 | } |
3357b1b1 |
101 | my $failed; |
9508959b |
102 | my $got; |
3357b1b1 |
103 | |
104 | if (digest_file($file, 'digest') ne $md5bin) { |
105 | print "$file: Bad digest\n"; |
106 | $failed++; |
107 | } |
108 | |
9508959b |
109 | if (($got = digest_file($file, 'hexdigest')) ne $md5hex) { |
110 | print "$file: Bad hexdigest: got $got expected $md5hex\n"; |
3357b1b1 |
111 | $failed++; |
112 | } |
113 | |
4d5cc332 |
114 | if ($B64 && digest_file($file, 'b64digest') ne $md5b64) { |
115 | print "$file: Bad b64digest\n"; |
116 | $failed++; |
117 | } |
118 | |
3357b1b1 |
119 | my $data = cat_file($file); |
120 | if (md5($data) ne $md5bin) { |
121 | print "$file: md5() failed\n"; |
122 | $failed++; |
123 | } |
124 | if (md5_hex($data) ne $md5hex) { |
125 | print "$file: md5_hex() failed\n"; |
126 | $failed++; |
127 | } |
4d5cc332 |
128 | if ($B64 && md5_base64($data) ne $md5b64) { |
129 | print "$file: md5_base64() failed\n"; |
130 | $failed++; |
131 | } |
3357b1b1 |
132 | |
133 | if (Digest::MD5->new->add($data)->digest ne $md5bin) { |
134 | print "$file: MD5->new->add(...)->digest failed\n"; |
135 | $failed++; |
136 | } |
137 | if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) { |
138 | print "$file: MD5->new->add(...)->hexdigest failed\n"; |
139 | $failed++; |
140 | } |
4d5cc332 |
141 | if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) { |
142 | print "$file: MD5->new->add(...)->b64digest failed\n"; |
143 | $failed++; |
144 | } |
3357b1b1 |
145 | |
146 | my @data = split //, $data; |
147 | if (md5(@data) ne $md5bin) { |
148 | print "$file: md5(\@data) failed\n"; |
149 | $failed++; |
150 | } |
151 | if (Digest::MD5->new->add(@data)->digest ne $md5bin) { |
152 | print "$file: MD5->new->add(\@data)->digest failed\n"; |
153 | $failed++; |
154 | } |
155 | my $md5 = Digest::MD5->new; |
156 | for (@data) { |
157 | $md5->add($_); |
158 | } |
159 | if ($md5->digest ne $md5bin) { |
160 | print "$file: $md5->add()-loop failed\n"; |
161 | $failed++; |
162 | } |
163 | |
164 | print "not " if $failed; |
165 | print "ok ", ++$testno, "\n"; |
166 | } |
167 | |
168 | |
169 | sub digest_file |
170 | { |
171 | my($file, $method) = @_; |
172 | $method ||= "digest"; |
173 | #print "$file $method\n"; |
174 | |
175 | open(FILE, $file) or die "Can't open $file: $!"; |
3357b1b1 |
176 | my $digest = Digest::MD5->new->addfile(*FILE)->$method(); |
177 | close(FILE); |
178 | |
179 | $digest; |
180 | } |
181 | |
182 | sub cat_file |
183 | { |
184 | my($file) = @_; |
185 | local $/; # slurp |
186 | open(FILE, $file) or die "Can't open $file: $!"; |
19f0e64f |
187 | |
9a03235d |
188 | # For PerlIO in case of UTF-8 locales. |
189 | eval 'binmode(FILE, ":bytes")' if $] >= 5.008; |
19f0e64f |
190 | |
3357b1b1 |
191 | my $tmp = <FILE>; |
192 | close(FILE); |
193 | $tmp; |
194 | } |
195 | |