This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix compilation with c++ compilers
[perl5.git] / cpan / Digest-MD5 / t / files.t
CommitLineData
326fafaa 1
c8780a73 2print "1..3\n";
3357b1b1
JH
3
4use strict;
4d5cc332 5use Digest::MD5 qw(md5 md5_hex md5_base64);
3357b1b1 6
8ff693ee
JH
7# To update the EBCDIC section even on a Latin 1 platform,
8# run this script with $ENV{EBCDIC_MD5SUM} set to a true value.
9# (You'll need to have Perl 5.7.3 or later, to have the Encode installed.)
10# (And remember that under the Perl core distribution you should
11# also have the $ENV{PERL_CORE} set to a true value.)
12
9a03235d 13my $EXPECT;
9508959b
JH
14if (ord "A" == 193) { # EBCDIC
15 $EXPECT = <<EOT;
62d37bf0 164f932585bed0cc942186fb51daff4839 README
5ec56f72 17b0f7cb93ec1b43f9417f089bb7b87bb0 MD5.xs
e69a2255
JH
18276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
19EOT
9508959b 20} else {
c8780a73 21 # This is the output of: 'md5sum README MD5.xs rfc1321.txt'
9508959b 22 $EXPECT = <<EOT;
62d37bf0 23c8d3f8457a2d6983253d771ffddb9f4c README
5ec56f72 2414b929c388c5a9bd8eca3d37160e1b8a MD5.xs
9508959b
JH
25754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
26EOT
27}
5a046520
JH
28
29if (!(-f "README") && -f "../README") {
30 chdir("..") or die "Can't chdir: $!";
fed3f325 31}
8c42d64c 32
5a046520
JH
33my $testno = 0;
34
4d5cc332
JH
35my $B64 = 1;
36eval { require MIME::Base64; };
37if ($@) {
9508959b 38 print "# $@: Will not test base64 methods\n";
4d5cc332
JH
39 $B64 = 0;
40}
41
3357b1b1
JH
42for (split /^/, $EXPECT) {
43 my($md5hex, $file) = split ' ';
8ff693ee 44 my $base = $file;
f05fc781 45# print "# $base\n";
9508959b 46 if ($ENV{PERL_CORE}) {
34791a82 47 if ($file eq 'rfc1321.txt') { # Don't have it in core.
9508959b
JH
48 print "ok ", ++$testno, " # Skip: PERL_CORE\n";
49 next;
50 }
9508959b
JH
51 }
52# print "# file = $file\n";
8ff693ee
JH
53 unless (-f $file) {
54 warn "No such file: $file\n";
55 next;
56 }
57 if ($ENV{EBCDIC_MD5SUM}) {
0dfa9f37 58 require Encode;
8ff693ee 59 my $data = cat_file($file);
0dfa9f37 60 Encode::from_to($data, 'latin1', 'cp1047');
e69a2255
JH
61 print md5_hex($data), " $base\n";
62 next;
63 }
3357b1b1 64 my $md5bin = pack("H*", $md5hex);
4d5cc332
JH
65 my $md5b64;
66 if ($B64) {
67 $md5b64 = MIME::Base64::encode($md5bin, "");
68 chop($md5b64); chop($md5b64); # remove padding
69 }
3357b1b1 70 my $failed;
9508959b 71 my $got;
3357b1b1
JH
72
73 if (digest_file($file, 'digest') ne $md5bin) {
74 print "$file: Bad digest\n";
75 $failed++;
76 }
77
9508959b
JH
78 if (($got = digest_file($file, 'hexdigest')) ne $md5hex) {
79 print "$file: Bad hexdigest: got $got expected $md5hex\n";
3357b1b1
JH
80 $failed++;
81 }
82
4d5cc332
JH
83 if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
84 print "$file: Bad b64digest\n";
85 $failed++;
86 }
87
3357b1b1
JH
88 my $data = cat_file($file);
89 if (md5($data) ne $md5bin) {
90 print "$file: md5() failed\n";
91 $failed++;
92 }
93 if (md5_hex($data) ne $md5hex) {
94 print "$file: md5_hex() failed\n";
95 $failed++;
96 }
4d5cc332
JH
97 if ($B64 && md5_base64($data) ne $md5b64) {
98 print "$file: md5_base64() failed\n";
99 $failed++;
100 }
3357b1b1
JH
101
102 if (Digest::MD5->new->add($data)->digest ne $md5bin) {
103 print "$file: MD5->new->add(...)->digest failed\n";
104 $failed++;
105 }
106 if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
107 print "$file: MD5->new->add(...)->hexdigest failed\n";
108 $failed++;
109 }
4d5cc332
JH
110 if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
111 print "$file: MD5->new->add(...)->b64digest failed\n";
112 $failed++;
113 }
3357b1b1
JH
114
115 my @data = split //, $data;
116 if (md5(@data) ne $md5bin) {
117 print "$file: md5(\@data) failed\n";
118 $failed++;
119 }
120 if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
121 print "$file: MD5->new->add(\@data)->digest failed\n";
122 $failed++;
123 }
124 my $md5 = Digest::MD5->new;
125 for (@data) {
126 $md5->add($_);
127 }
128 if ($md5->digest ne $md5bin) {
129 print "$file: $md5->add()-loop failed\n";
130 $failed++;
131 }
132
133 print "not " if $failed;
134 print "ok ", ++$testno, "\n";
135}
136
137
138sub digest_file
139{
140 my($file, $method) = @_;
141 $method ||= "digest";
142 #print "$file $method\n";
143
144 open(FILE, $file) or die "Can't open $file: $!";
3357b1b1
JH
145 my $digest = Digest::MD5->new->addfile(*FILE)->$method();
146 close(FILE);
147
148 $digest;
149}
150
151sub cat_file
152{
153 my($file) = @_;
154 local $/; # slurp
155 open(FILE, $file) or die "Can't open $file: $!";
19f0e64f 156
9a03235d
GA
157 # For PerlIO in case of UTF-8 locales.
158 eval 'binmode(FILE, ":bytes")' if $] >= 5.008;
19f0e64f 159
3357b1b1
JH
160 my $tmp = <FILE>;
161 close(FILE);
162 $tmp;
163}
164