This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c786a5f4e5cb9a4d82eca55340fae4397db2c386
[perl5.git] / ext / Digest / MD5 / t / files.t
1 BEGIN {
2         chdir 't' if -d 't';
3         @INC = '../lib';
4 }
5
6 print "1..2\n";
7
8 use strict;
9 use Digest::MD5 qw(md5 md5_hex md5_base64);
10
11 #
12 # This is the output of: 'md5sum MD5.pm MD5.xs'
13 #
14 my $EXPECT;
15
16 if (ord('A') == 193) { # EBCDIC
17 $EXPECT = <<EOT;
18 95a81f17a8e6c2273aecac12d8c4cb90  ext/Digest/MD5/MD5.pm
19 9cecc5dbb27bd64b98f61f558b4db378  ext/Digest/MD5/MD5.xs
20 EOT
21 } else { # ASCII
22 $EXPECT = <<EOT;
23 3d0146bf194e4fe68733d00fba02a49e  ext/Digest/MD5/MD5.pm
24 5526659171a63f532d990dd73791b60e  ext/Digest/MD5/MD5.xs
25 EOT
26 }
27
28 my $B64 = 1;
29 eval { require MIME::Base64; };
30 if ($@) {
31     print $@;
32     print "# Will not test base64 methods\n";
33     $B64 = 0;
34 }
35
36 my $testno = 0;
37
38 use File::Spec;
39
40 for (split /^/, $EXPECT) {
41      my($md5hex, $file) = split ' ';
42      my @path = split(m:/:, $file);
43      my $last = pop @path;
44      my $path = File::Spec->updir;
45      while (@path) {
46          $path = File::Spec->catdir($path, shift @path);
47      }
48      $file = File::Spec->catfile($path, $last);
49      my $md5bin = pack("H*", $md5hex);
50      my $md5b64;
51      if ($B64) {
52          $md5b64 = MIME::Base64::encode($md5bin, "");
53          chop($md5b64); chop($md5b64);   # remove padding
54      }
55      my $failed;
56
57      if (digest_file($file, 'digest') ne $md5bin) {
58          print "$file: Bad digest\n";
59          $failed++;
60      }
61
62      if (digest_file($file, 'hexdigest') ne $md5hex) {
63          print "$file: Bad hexdigest\n";
64          $failed++;
65      }
66
67      if ($B64 && digest_file($file, 'b64digest') ne $md5b64) {
68          print "$file: Bad b64digest\n";
69          $failed++;
70      }
71
72      my $data = cat_file($file);
73      if (md5($data) ne $md5bin) {
74          print "$file: md5() failed\n";
75          $failed++;
76      }
77      if (md5_hex($data) ne $md5hex) {
78          print "$file: md5_hex() failed\n";
79          $failed++;
80      }
81      if ($B64 && md5_base64($data) ne $md5b64) {
82          print "$file: md5_base64() failed\n";
83          $failed++;
84      }
85
86      if (Digest::MD5->new->add($data)->digest ne $md5bin) {
87          print "$file: MD5->new->add(...)->digest failed\n";
88          $failed++;
89      }
90      if (Digest::MD5->new->add($data)->hexdigest ne $md5hex) {
91          print "$file: MD5->new->add(...)->hexdigest failed\n";
92          $failed++;
93      }
94      if ($B64 && Digest::MD5->new->add($data)->b64digest ne $md5b64) {
95          print "$file: MD5->new->add(...)->b64digest failed\n";
96          $failed++;
97      }
98
99      my @data = split //, $data;
100      if (md5(@data) ne $md5bin) {
101          print "$file: md5(\@data) failed\n";
102          $failed++;
103      }
104      if (Digest::MD5->new->add(@data)->digest ne $md5bin) {
105          print "$file: MD5->new->add(\@data)->digest failed\n";
106          $failed++;
107      }
108      my $md5 = Digest::MD5->new;
109      for (@data) {
110          $md5->add($_);
111      }
112      if ($md5->digest ne $md5bin) {
113          print "$file: $md5->add()-loop failed\n";
114          $failed++;
115      }
116
117      print "not " if $failed;
118      print "ok ", ++$testno, "\n";
119 }
120
121
122 sub digest_file
123 {
124     my($file, $method) = @_;
125     $method ||= "digest";
126     #print "$file $method\n";
127
128     open(FILE, $file) or die "Can't open $file: $!";
129 # Digests avove are generated on UNIX without CRLF
130 # so leave handles in text mode
131 #    binmode(FILE);
132     my $digest = Digest::MD5->new->addfile(*FILE)->$method();
133     close(FILE);
134
135     $digest;
136 }
137
138 sub cat_file
139 {
140     my($file) = @_;
141     local $/;  # slurp
142     open(FILE, $file) or die "Can't open $file: $!";
143 # Digests avove are generated on UNIX without CRLF
144 # so leave handles in text mode
145 #    binmode(FILE);
146     my $tmp = <FILE>;
147     close(FILE);
148     $tmp;
149 }
150