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 | |
13 | # |
5a046520 |
14 | # This is the output of: 'md5sum Changes README MD5.pm MD5.xs rfc1321.txt' |
3357b1b1 |
15 | # |
9508959b |
16 | my $EXPECT; |
17 | |
18 | if (ord "A" == 193) { # EBCDIC |
19 | $EXPECT = <<EOT; |
5a046520 |
20 | 23cafa2de11474f0df8f808cc588bcc9 Changes |
21 | 3519f3d02c7c91158f732f0f00064657 README |
22 | 0268931475ae2a2e843ff58504cfa3f0 MD5.pm |
23 | 1be293491bba726810f8e87671ee0328 MD5.xs |
24 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
fed3f325 |
25 | EOT |
9508959b |
26 | } else { |
27 | $EXPECT = <<EOT; |
28 | 23cafa2de11474f0df8f808cc588bcc9 Changes |
29 | 3519f3d02c7c91158f732f0f00064657 README |
30 | 0268931475ae2a2e843ff58504cfa3f0 MD5.pm |
31 | 1be293491bba726810f8e87671ee0328 MD5.xs |
32 | 754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt |
33 | EOT |
34 | } |
5a046520 |
35 | |
36 | if (!(-f "README") && -f "../README") { |
37 | chdir("..") or die "Can't chdir: $!"; |
fed3f325 |
38 | } |
8c42d64c |
39 | |
5a046520 |
40 | my $testno = 0; |
41 | |
4d5cc332 |
42 | my $B64 = 1; |
43 | eval { require MIME::Base64; }; |
44 | if ($@) { |
9508959b |
45 | print "# $@: Will not test base64 methods\n"; |
4d5cc332 |
46 | $B64 = 0; |
47 | } |
48 | |
3357b1b1 |
49 | for (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 | |
139 | sub 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 | |
153 | sub 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 | |