BEGIN {
if
(
$ENV
{PERL_CORE}) {
chdir
't'
if
-d
't'
;
@INC
=
'../lib'
;
}
}
print
"1..5\n"
;
my
$EXPECT
;
if
(
ord
"A"
== 193) {
$EXPECT
=
<<EOT;
fcc48d6bb88ca8065bf9ddfcb9e7483e Changes
0565ec21b15c0f23f4c51fb327c8926d README
1965beb0e48253b694220fbb5d6230f5 MD5.pm
5b3c24da3f70f3c0938cc7c205a28ab7 MD5.xs
276da0aa4e9a08b7fe09430c9c5690aa rfc1321.txt
EOT
}
elsif
(
"\n"
eq
"\015"
) {
$EXPECT
=
<<EOT;
f161f474603c54a0093ad2f6f93be33b Changes
6c950a0211a5a28f023bb482037698cd README
18178c90bc13d6824f6c96973b6e9433 MD5.pm
2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
else
{
$EXPECT
=
<<EOT;
029fa5059ba0b2175cee09ab5d9b7b73 Changes
6c950a0211a5a28f023bb482037698cd README
18178c90bc13d6824f6c96973b6e9433 MD5.pm
2c7fdb2ffa3840dc4f8dcdcf13241015 MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
if
(!(-f
"README"
) && -f
"../README"
) {
chdir
(
".."
) or
die
"Can't chdir: $!"
;
}
my
$testno
= 0;
my
$B64
= 1;
if
($@) {
print
"# $@: Will not test base64 methods\n"
;
$B64
= 0;
}
for
(
split
/^/,
$EXPECT
) {
my
(
$md5hex
,
$file
) =
split
' '
;
my
$base
=
$file
;
if
(
$ENV
{PERL_CORE}) {
if
(
$file
eq
'rfc1321.txt'
) {
print
"ok "
, ++
$testno
,
" # Skip: PERL_CORE\n"
;
next
;
}
my
@path
=
qw(ext Digest MD5)
;
my
$path
= File::Spec->updir;
while
(
@path
) {
$path
= File::Spec->catdir(
$path
,
shift
@path
);
}
$file
= File::Spec->catfile(
$path
,
$file
);
}
unless
(-f
$file
) {
warn
"No such file: $file\n"
;
next
;
}
if
(
$ENV
{EBCDIC_MD5SUM}) {
my
$data
= cat_file(
$file
);
Encode::from_to(
$data
,
'latin1'
,
'cp1047'
);
print
md5_hex(
$data
),
" $base\n"
;
next
;
}
if
(
$ENV
{MAC_MD5SUM}) {
my
$data
= cat_file(
$file
);
Encode::from_to(
$data
,
'latin1'
,
'MacRoman'
);
print
md5_hex(
$data
),
" $base\n"
;
next
;
}
my
$md5bin
=
pack
(
"H*"
,
$md5hex
);
my
$md5b64
;
if
(
$B64
) {
$md5b64
= MIME::Base64::encode(
$md5bin
,
""
);
chop
(
$md5b64
);
chop
(
$md5b64
);
}
my
$failed
;
my
$got
;
if
(digest_file(
$file
,
'digest'
) ne
$md5bin
) {
print
"$file: Bad digest\n"
;
$failed
++;
}
if
((
$got
= digest_file(
$file
,
'hexdigest'
)) ne
$md5hex
) {
print
"$file: Bad hexdigest: got $got expected $md5hex\n"
;
$failed
++;
}
if
(
$B64
&& digest_file(
$file
,
'b64digest'
) ne
$md5b64
) {
print
"$file: Bad b64digest\n"
;
$failed
++;
}
my
$data
= cat_file(
$file
);
if
(md5(
$data
) ne
$md5bin
) {
print
"$file: md5() failed\n"
;
$failed
++;
}
if
(md5_hex(
$data
) ne
$md5hex
) {
print
"$file: md5_hex() failed\n"
;
$failed
++;
}
if
(
$B64
&& md5_base64(
$data
) ne
$md5b64
) {
print
"$file: md5_base64() failed\n"
;
$failed
++;
}
if
(Digest::MD5->new->add(
$data
)->digest ne
$md5bin
) {
print
"$file: MD5->new->add(...)->digest failed\n"
;
$failed
++;
}
if
(Digest::MD5->new->add(
$data
)->hexdigest ne
$md5hex
) {
print
"$file: MD5->new->add(...)->hexdigest failed\n"
;
$failed
++;
}
if
(
$B64
&& Digest::MD5->new->add(
$data
)->b64digest ne
$md5b64
) {
print
"$file: MD5->new->add(...)->b64digest failed\n"
;
$failed
++;
}
my
@data
=
split
//,
$data
;
if
(md5(
@data
) ne
$md5bin
) {
print
"$file: md5(\@data) failed\n"
;
$failed
++;
}
if
(Digest::MD5->new->add(
@data
)->digest ne
$md5bin
) {
print
"$file: MD5->new->add(\@data)->digest failed\n"
;
$failed
++;
}
my
$md5
= Digest::MD5->new;
for
(
@data
) {
$md5
->add(
$_
);
}
if
(
$md5
->digest ne
$md5bin
) {
print
"$file: $md5->add()-loop failed\n"
;
$failed
++;
}
print
"not "
if
$failed
;
print
"ok "
, ++
$testno
,
"\n"
;
}
sub
digest_file
{
my
(
$file
,
$method
) =
@_
;
$method
||=
"digest"
;
open
(FILE,
$file
) or
die
"Can't open $file: $!"
;
my
$digest
= Digest::MD5->new->addfile(
*FILE
)->
$method
();
close
(FILE);
$digest
;
}
sub
cat_file
{
my
(
$file
) =
@_
;
local
$/;
open
(FILE,
$file
) or
die
"Can't open $file: $!"
;
eval
'binmode(FILE, ":bytes")'
if
$] >= 5.008;
my
$tmp
= <FILE>;
close
(FILE);
$tmp
;
}