1N/A#!perl -w
1N/A
2N/Ause Test::More tests => 12;
1N/A
1N/A{
1N/A package LenDigest;
1N/A require Digest::base;
1N/A use vars qw(@ISA);
1N/A @ISA = qw(Digest::base);
1N/A
1N/A sub new {
1N/A my $class = shift;
1N/A my $str = "";
1N/A bless \$str, $class;
1N/A }
1N/A
1N/A sub add {
1N/A my $self = shift;
1N/A $$self .= join("", @_);
1N/A return $self;
1N/A }
1N/A
1N/A sub digest {
1N/A my $self = shift;
1N/A my $len = length($$self);
1N/A my $first = ($len > 0) ? substr($$self, 0, 1) : "X";
1N/A $$self = "";
1N/A return sprintf "$first%04d", $len;
1N/A }
1N/A}
1N/A
1N/Amy $ctx = LenDigest->new;
2N/Ais($ctx->digest, "X0000");
2N/A
2N/Amy $EBCDIC = ord('A') == 193;
2N/A
2N/Aif ($EBCDIC) {
2N/A is($ctx->hexdigest, "e7f0f0f0f0");
2N/A is($ctx->b64digest, "5/Dw8PA");
2N/A} else {
2N/A is($ctx->hexdigest, "5830303030");
2N/A is($ctx->b64digest, "WDAwMDA");
2N/A}
1N/A
1N/A$ctx->add("foo");
2N/Ais($ctx->digest, "f0003");
1N/A
1N/A$ctx->add("foo");
2N/Ais($ctx->hexdigest, $EBCDIC ? "86f0f0f0f3" : "6630303033");
1N/A
1N/A$ctx->add("foo");
2N/Ais($ctx->b64digest, $EBCDIC ? "hvDw8PM" : "ZjAwMDM");
1N/A
1N/Aopen(F, ">xxtest$$") || die;
1N/Abinmode(F);
1N/Aprint F "abc" x 100, "\n";
1N/Aclose(F) || die;
1N/A
1N/Aopen(F, "xxtest$$") || die;
1N/A$ctx->addfile(*F);
1N/Aclose(F);
1N/Aunlink("xxtest$$") || warn;
1N/A
2N/Ais($ctx->digest, "a0301");
1N/A
1N/Aeval {
1N/A $ctx->add_bits("1010");
1N/A};
2N/Alike($@, '/^Number of bits must be multiple of 8/');
1N/A
2N/A$ctx->add_bits($EBCDIC ? "11100100" : "01010101");
2N/Ais($ctx->digest, "U0001");
1N/A
1N/Aeval {
1N/A $ctx->add_bits("abc", 12);
1N/A};
2N/Alike($@, '/^Number of bits must be multiple of 8/');
1N/A
1N/A$ctx->add_bits("abc", 16);
2N/Ais($ctx->digest, "a0002");
1N/A
1N/A$ctx->add_bits("abc", 32);
2N/Ais($ctx->digest, "a0003");