dslinux/user/perl/ext/MIME/Base64/t base64.t quoted-print.t unicode.t warn.t
cayenne
dslinux_cayenne at user.in-berlin.de
Tue Dec 5 05:26:53 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/MIME/Base64/t
In directory antilope:/tmp/cvs-serv7729/ext/MIME/Base64/t
Added Files:
base64.t quoted-print.t unicode.t warn.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: unicode.t ---
BEGIN {
unless ($] >= 5.006) {
print "1..0\n";
exit(0);
}
if ($ENV{PERL_CORE}) {
chdir 't' if -d 't';
@INC = '../lib';
}
}
print "1..2\n";
require MIME::Base64;
eval {
my $tmp = MIME::Base64::encode(v300);
print "# enc: $tmp\n";
};
print "# $@" if $@;
print "not " unless $@;
print "ok 1\n";
require MIME::QuotedPrint;
eval {
my $tmp = MIME::QuotedPrint::encode(v300);
print "# enc: $tmp\n";
};
print "# $@" if $@;
print "not " unless $@;
print "ok 2\n";
--- NEW FILE: warn.t ---
#!perl -w
BEGIN {
if ($ENV{'PERL_CORE'}){
chdir 't' if -d 't';
@INC = '../lib';
}
}
BEGIN {
eval {
require warnings;
};
if ($@) {
print "1..0\n";
print $@;
exit;
}
}
use strict;
use MIME::Base64 qw(decode_base64);
print "1..1\n";
use warnings;
my @warn;
$SIG{__WARN__} = sub { push(@warn, @_) };
warn;
my $a;
$a = decode_base64("aa");
$a = decode_base64("a===");
warn;
$a = do {
no warnings;
decode_base64("aa");
};
$a = do {
no warnings;
decode_base64("a===");
};
warn;
$a = do {
local $^W;
decode_base64("aa");
};
$a = do {
local $^W;
decode_base64("a===");
};
warn;
for (@warn) {
print "# $_";
}
print "not " unless join("", @warn) eq <<"EOT"; print "ok 1\n";
Warning: something's wrong at $0 line 31.
Premature end of base64 data at $0 line 33.
Premature padding of base64 data at $0 line 34.
Warning: something's wrong at $0 line 35.
Premature end of base64 data at $0 line 38.
Premature padding of base64 data at $0 line 42.
Warning: something's wrong at $0 line 44.
Warning: something's wrong at $0 line 53.
EOT
--- NEW FILE: quoted-print.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
chdir 't' if -d 't';
@INC = '../lib';
}
}
use MIME::QuotedPrint;
$x70 = "x" x 70;
@tests =
(
# plain ascii should not be encoded
["", ""],
["quoted printable" =>
"quoted printable=\n"],
# 8-bit chars should be encoded
["v\xe5re kj\xe6re norske tegn b\xf8r \xe6res" =>
"v=E5re kj=E6re norske tegn b=F8r =E6res=\n"],
# trailing space should be encoded
[" " => "=20=20=\n"],
["\tt\t" => "\tt=09=\n"],
["test \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"],
# "=" is special an should be decoded
["=30\n" => "=3D30\n"],
["\0\xff0" => "=00=FF0=\n"],
# Very long lines should be broken (not more than 76 chars
["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." =>
"The Quoted-Printable encoding is intended to represent data that largly con=
sists of octets that correspond to printable characters in the ASCII charac=
ter set.=\n"
],
# Long lines after short lines were broken through 2.01.
["short line
In America, any boy may become president and I suppose that's just one of the risks he takes. -- Adlai Stevenson" =>
"short line
In America, any boy may become president and I suppose that's just one of t=
he risks he takes. -- Adlai Stevenson=\n"],
# My (roderick at argon.org) first crack at fixing that bug failed for
# multiple long lines.
["College football is a game which would be much more interesting if the faculty played instead of the students, and even more interesting if the
trustees played. There would be a great increase in broken arms, legs, and necks, and simultaneously an appreciable diminution in the loss to humanity. -- H. L. Mencken" =>
"College football is a game which would be much more interesting if the facu=
lty played instead of the students, and even more interesting if the
trustees played. There would be a great increase in broken arms, legs, and=
necks, and simultaneously an appreciable diminution in the loss to humanit=
y. -- H. L. Mencken=\n"],
# Don't break a line that's near but not over 76 chars.
["$x70!23" => "$x70!23=\n"],
["$x70!234" => "$x70!234=\n"],
["$x70!2345" => "$x70!2345=\n"],
["$x70!23456" => "$x70!23456=\n"],
["$x70!234567" => "$x70!2345=\n67=\n"],
["$x70!23456=" => "$x70!2345=\n6=3D=\n"],
["$x70!23\n" => "$x70!23\n"],
["$x70!234\n" => "$x70!234\n"],
["$x70!2345\n" => "$x70!2345\n"],
["$x70!23456\n" => "$x70!23456\n"],
["$x70!234567\n" => "$x70!2345=\n67\n"],
["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
# Not allowed to break =XX escapes using soft line break
["$x70===xxxxx" => "$x70=3D=\n=3D=3Dxxxxx=\n"],
["$x70!===xxxx" => "$x70!=3D=\n=3D=3Dxxxx=\n"],
["$x70!2===xxx" => "$x70!2=3D=\n=3D=3Dxxx=\n"],
["$x70!23===xx" => "$x70!23=\n=3D=3D=3Dxx=\n"],
["$x70!234===x" => "$x70!234=\n=3D=3D=3Dx=\n"],
["$x70!2=\n" => "$x70!2=3D\n"],
["$x70!23=\n" => "$x70!23=\n=3D\n"],
["$x70!234=\n" => "$x70!234=\n=3D\n"],
["$x70!2345=\n" => "$x70!2345=\n=3D\n"],
["$x70!23456=\n" => "$x70!2345=\n6=3D\n"],
# ^
# 70123456|
# max
# line width
# some extra special cases we have had problems with
["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx=\n"],
["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"],
# trailing whitespace
["foo \t ", "foo=20=09=20=\n"],
["foo\t \n \t", "foo=09=20\n=20=09=\n"],
);
$notests = @tests + 16;
print "1..$notests\n";
$testno = 0;
for (@tests) {
$testno++;
($plain, $encoded) = @$_;
if (ord('A') == 193) { # EBCDIC 8 bit chars are different
if ($testno == 2) { $plain =~ s/\xe5/\x47/; $plain =~ s/\xe6/\x9c/g; $plain =~ s/\xf8/\x70/; }
if ($testno == 7) { $plain =~ s/\xff/\xdf/; }
}
$x = encode_qp($plain);
if ($x ne $encoded) {
print "Encode test failed\n";
print "Got: '$x'\n";
print "Expected: '$encoded'\n";
print "not ok $testno\n";
next;
}
$x = decode_qp($encoded);
if ($x ne $plain) {
print "Decode test failed\n";
print "Got: '$x'\n";
print "Expected: '$plain'\n";
print "not ok $testno\n";
next;
}
print "ok $testno\n";
}
# Some extra testing for a case that was wrong until libwww-perl-5.09
print "not " unless decode_qp("foo \n\nfoo =\n\nfoo=20\n\n") eq
"foo\n\nfoo \nfoo \n\n";
$testno++; print "ok $testno\n";
# Same test but with "\r\n" terminated lines
print "not " unless decode_qp("foo \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq
"foo\n\nfoo \nfoo \n\n";
$testno++; print "ok $testno\n";
# Trailing whitespace
print "not " unless decode_qp("foo ") eq "foo ";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo \n") eq "foo\n";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo = \t\x20\nbar\t\x20\n") eq "foo bar\n";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo = \t\x20\r\nbar\t\x20\r\n") eq "foo bar\n";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo = \t\x20\n") eq "foo ";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo = \t\x20\r\n") eq "foo ";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo = \t\x20y\r\n") eq "foo = \t\x20y\n";
$testno++; print "ok $testno\n";
print "not " unless decode_qp("foo =xy\n") eq "foo =xy\n";
$testno++; print "ok $testno\n";
# Test with with alternative line break
print "not " unless encode_qp("$x70!2345$x70\n", "***") eq "$x70!2345=***$x70***";
$testno++; print "ok $testno\n";
# Test with no line breaks
print "not " unless encode_qp("$x70!2345$x70\n", "") eq "$x70!2345$x70=0A";
$testno++; print "ok $testno\n";
# Test binary encoding
print "not " unless encode_qp("foo", undef, 1) eq "foo=\n";
$testno++; print "ok $testno\n";
print "not " unless encode_qp("foo\nbar\r\n", undef, 1) eq "foo=0Abar=0D=0A=\n";
$testno++; print "ok $testno\n";
print "not " unless encode_qp(join("", map chr, 0..255), undef, 1) eq <<'EOT'; $testno++; print "ok $testno\n";
=00=01=02=03=04=05=06=07=08=09=0A=0B=0C=0D=0E=0F=10=11=12=13=14=15=16=17=18=
=19=1A=1B=1C=1D=1E=1F !"#$%&'()*+,-./0123456789:;<=3D>?@ABCDEFGHIJKLMNOPQRS=
TUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~=7F=80=81=82=83=84=85=86=87=88=
=89=8A=8B=8C=8D=8E=8F=90=91=92=93=94=95=96=97=98=99=9A=9B=9C=9D=9E=9F=A0=A1=
=A2=A3=A4=A5=A6=A7=A8=A9=AA=AB=AC=AD=AE=AF=B0=B1=B2=B3=B4=B5=B6=B7=B8=B9=BA=
=BB=BC=BD=BE=BF=C0=C1=C2=C3=C4=C5=C6=C7=C8=C9=CA=CB=CC=CD=CE=CF=D0=D1=D2=D3=
=D4=D5=D6=D7=D8=D9=DA=DB=DC=DD=DE=DF=E0=E1=E2=E3=E4=E5=E6=E7=E8=E9=EA=EB=EC=
=ED=EE=EF=F0=F1=F2=F3=F4=F5=F6=F7=F8=F9=FA=FB=FC=FD=FE=FF=
EOT
print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@);
$testno++; print "ok $testno\n";
--- NEW FILE: base64.t ---
BEGIN {
if ($ENV{'PERL_CORE'}){
chdir 't' if -d 't';
@INC = '../lib';
}
}
use strict;
use MIME::Base64;
print "1..283\n";
print "# Testing MIME::Base64-", $MIME::Base64::VERSION, "\n";
BEGIN {
if (ord('A') == 0x41) {
*ASCII = sub { return $_[0] };
}
else {
require Encode;
*ASCII = sub { Encode::encode('ascii',$_[0]) };
}
}
my $testno = 1;
# instead of "for my $test (...)" , which is my preference.
# Not sure which perl version has started supporting. MIME::Base64
# was supposed to work with very old perl5, right?
my $test;
encodeTest();
decodeTest();
# This used to generate a warning
print "not " unless decode_base64(encode_base64("foo")) eq "foo";
print "ok ", $testno++, "\n";
sub encodeTest
{
print "# encode test\n";
my @encode_tests = (
# All values
["\000" => "AA=="],
["\001" => "AQ=="],
["\002" => "Ag=="],
["\003" => "Aw=="],
["\004" => "BA=="],
["\005" => "BQ=="],
["\006" => "Bg=="],
["\007" => "Bw=="],
["\010" => "CA=="],
["\011" => "CQ=="],
["\012" => "Cg=="],
["\013" => "Cw=="],
["\014" => "DA=="],
["\015" => "DQ=="],
["\016" => "Dg=="],
["\017" => "Dw=="],
["\020" => "EA=="],
["\021" => "EQ=="],
["\022" => "Eg=="],
["\023" => "Ew=="],
["\024" => "FA=="],
["\025" => "FQ=="],
["\026" => "Fg=="],
["\027" => "Fw=="],
["\030" => "GA=="],
["\031" => "GQ=="],
["\032" => "Gg=="],
["\033" => "Gw=="],
["\034" => "HA=="],
["\035" => "HQ=="],
["\036" => "Hg=="],
["\037" => "Hw=="],
["\040" => "IA=="],
["\041" => "IQ=="],
["\042" => "Ig=="],
["\043" => "Iw=="],
["\044" => "JA=="],
["\045" => "JQ=="],
["\046" => "Jg=="],
["\047" => "Jw=="],
["\050" => "KA=="],
["\051" => "KQ=="],
["\052" => "Kg=="],
["\053" => "Kw=="],
["\054" => "LA=="],
["\055" => "LQ=="],
["\056" => "Lg=="],
["\057" => "Lw=="],
["\060" => "MA=="],
["\061" => "MQ=="],
["\062" => "Mg=="],
["\063" => "Mw=="],
["\064" => "NA=="],
["\065" => "NQ=="],
["\066" => "Ng=="],
["\067" => "Nw=="],
["\070" => "OA=="],
["\071" => "OQ=="],
["\072" => "Og=="],
["\073" => "Ow=="],
["\074" => "PA=="],
["\075" => "PQ=="],
["\076" => "Pg=="],
["\077" => "Pw=="],
["\100" => "QA=="],
["\101" => "QQ=="],
["\102" => "Qg=="],
["\103" => "Qw=="],
["\104" => "RA=="],
["\105" => "RQ=="],
["\106" => "Rg=="],
["\107" => "Rw=="],
["\110" => "SA=="],
["\111" => "SQ=="],
["\112" => "Sg=="],
["\113" => "Sw=="],
["\114" => "TA=="],
["\115" => "TQ=="],
["\116" => "Tg=="],
["\117" => "Tw=="],
["\120" => "UA=="],
["\121" => "UQ=="],
["\122" => "Ug=="],
["\123" => "Uw=="],
["\124" => "VA=="],
["\125" => "VQ=="],
["\126" => "Vg=="],
["\127" => "Vw=="],
["\130" => "WA=="],
["\131" => "WQ=="],
["\132" => "Wg=="],
["\133" => "Ww=="],
["\134" => "XA=="],
["\135" => "XQ=="],
["\136" => "Xg=="],
["\137" => "Xw=="],
["\140" => "YA=="],
["\141" => "YQ=="],
["\142" => "Yg=="],
["\143" => "Yw=="],
["\144" => "ZA=="],
["\145" => "ZQ=="],
["\146" => "Zg=="],
["\147" => "Zw=="],
["\150" => "aA=="],
["\151" => "aQ=="],
["\152" => "ag=="],
["\153" => "aw=="],
["\154" => "bA=="],
["\155" => "bQ=="],
["\156" => "bg=="],
["\157" => "bw=="],
["\160" => "cA=="],
["\161" => "cQ=="],
["\162" => "cg=="],
["\163" => "cw=="],
["\164" => "dA=="],
["\165" => "dQ=="],
["\166" => "dg=="],
["\167" => "dw=="],
["\170" => "eA=="],
["\171" => "eQ=="],
["\172" => "eg=="],
["\173" => "ew=="],
["\174" => "fA=="],
["\175" => "fQ=="],
["\176" => "fg=="],
["\177" => "fw=="],
["\200" => "gA=="],
["\201" => "gQ=="],
["\202" => "gg=="],
["\203" => "gw=="],
["\204" => "hA=="],
["\205" => "hQ=="],
["\206" => "hg=="],
["\207" => "hw=="],
["\210" => "iA=="],
["\211" => "iQ=="],
["\212" => "ig=="],
["\213" => "iw=="],
["\214" => "jA=="],
["\215" => "jQ=="],
["\216" => "jg=="],
["\217" => "jw=="],
["\220" => "kA=="],
["\221" => "kQ=="],
["\222" => "kg=="],
["\223" => "kw=="],
["\224" => "lA=="],
["\225" => "lQ=="],
["\226" => "lg=="],
["\227" => "lw=="],
["\230" => "mA=="],
["\231" => "mQ=="],
["\232" => "mg=="],
["\233" => "mw=="],
["\234" => "nA=="],
["\235" => "nQ=="],
["\236" => "ng=="],
["\237" => "nw=="],
["\240" => "oA=="],
["\241" => "oQ=="],
["\242" => "og=="],
["\243" => "ow=="],
["\244" => "pA=="],
["\245" => "pQ=="],
["\246" => "pg=="],
["\247" => "pw=="],
["\250" => "qA=="],
["\251" => "qQ=="],
["\252" => "qg=="],
["\253" => "qw=="],
["\254" => "rA=="],
["\255" => "rQ=="],
["\256" => "rg=="],
["\257" => "rw=="],
["\260" => "sA=="],
["\261" => "sQ=="],
["\262" => "sg=="],
["\263" => "sw=="],
["\264" => "tA=="],
["\265" => "tQ=="],
["\266" => "tg=="],
["\267" => "tw=="],
["\270" => "uA=="],
["\271" => "uQ=="],
["\272" => "ug=="],
["\273" => "uw=="],
["\274" => "vA=="],
["\275" => "vQ=="],
["\276" => "vg=="],
["\277" => "vw=="],
["\300" => "wA=="],
["\301" => "wQ=="],
["\302" => "wg=="],
["\303" => "ww=="],
["\304" => "xA=="],
["\305" => "xQ=="],
["\306" => "xg=="],
["\307" => "xw=="],
["\310" => "yA=="],
["\311" => "yQ=="],
["\312" => "yg=="],
["\313" => "yw=="],
["\314" => "zA=="],
["\315" => "zQ=="],
["\316" => "zg=="],
["\317" => "zw=="],
["\320" => "0A=="],
["\321" => "0Q=="],
["\322" => "0g=="],
["\323" => "0w=="],
["\324" => "1A=="],
["\325" => "1Q=="],
["\326" => "1g=="],
["\327" => "1w=="],
["\330" => "2A=="],
["\331" => "2Q=="],
["\332" => "2g=="],
["\333" => "2w=="],
["\334" => "3A=="],
["\335" => "3Q=="],
["\336" => "3g=="],
["\337" => "3w=="],
["\340" => "4A=="],
["\341" => "4Q=="],
["\342" => "4g=="],
["\343" => "4w=="],
["\344" => "5A=="],
["\345" => "5Q=="],
["\346" => "5g=="],
["\347" => "5w=="],
["\350" => "6A=="],
["\351" => "6Q=="],
["\352" => "6g=="],
["\353" => "6w=="],
["\354" => "7A=="],
["\355" => "7Q=="],
["\356" => "7g=="],
["\357" => "7w=="],
["\360" => "8A=="],
["\361" => "8Q=="],
["\362" => "8g=="],
["\363" => "8w=="],
["\364" => "9A=="],
["\365" => "9Q=="],
["\366" => "9g=="],
["\367" => "9w=="],
["\370" => "+A=="],
["\371" => "+Q=="],
["\372" => "+g=="],
["\373" => "+w=="],
["\374" => "/A=="],
["\375" => "/Q=="],
["\376" => "/g=="],
["\377" => "/w=="],
["\000\377" => "AP8="],
["\377\000" => "/wA="],
["\000\000\000" => "AAAA"],
['' => ''],
[ASCII('a') => 'YQ=='],
[ASCII('aa') => 'YWE='],
[ASCII('aaa') => 'YWFh'],
[ASCII('aaa') => 'YWFh'],
[ASCII('aaa') => 'YWFh'],
[ASCII('aaa') => 'YWFh'],
# from HTTP spec
[ASCII('Aladdin:open sesame') => 'QWxhZGRpbjpvcGVuIHNlc2FtZQ=='],
[ASCII('a') x 100 => 'YWFh' x 33 . 'YQ=='],
[ASCII('Multipurpose Internet Mail Extensions: The Base64 Content-Transfer-Encoding is designed to represent sequences of octets in a form that is not humanly readable. ')
=> "TXVsdGlwdXJwb3NlIEludGVybmV0IE1haWwgRXh0ZW5zaW9uczogVGhlIEJhc2U2NCBDb250ZW50LVRyYW5zZmVyLUVuY29kaW5nIGlzIGRlc2lnbmVkIHRvIHJlcHJlc2VudCBzZXF1ZW5jZXMgb2Ygb2N0ZXRzIGluIGEgZm9ybSB0aGF0IGlzIG5vdCBodW1hbmx5IHJlYWRhYmxlLiA="],
);
for $test (@encode_tests) {
my($plain, $expected) = ($$test[0], $$test[1]);
my $encoded = encode_base64($plain, '');
if ($encoded ne $expected) {
print "test $testno ($plain): expected $expected, got $encoded\n";
print "not ";
}
my $decoded = decode_base64($encoded);
if ($decoded ne $plain) {
print "test $testno ($encoded): expected $plain, got $decoded\n";
print "not ";
}
print "ok $testno\n";
$testno++;
}
}
sub decodeTest
{
print "# decode test\n";
local $SIG{__WARN__} = sub { print $_[0] }; # avoid warnings on stderr
my @decode_tests = (
['YWE=' => ASCII('aa')],
[' YWE=' => ASCII('aa')],
['Y WE=' => ASCII('aa')],
['YWE= ' => ASCII('aa')],
["Y\nW\r\nE=" => ASCII('aa')],
# These will generate some warnings
['YWE=====' => ASCII('aa')], # extra padding
['YWE' => ASCII('aa')], # missing padding
['YWFh====' => ASCII('aaa')],
['YQ' => ASCII('a')],
['Y' => ''],
['x==' => ''],
['' => ''],
[undef() => ''],
);
for $test (@decode_tests) {
my($encoded, $expected) = ($$test[0], $$test[1]);
my $decoded = decode_base64($encoded);
if ($decoded ne $expected) {
die "test $testno ($encoded): expected $expected, got $decoded\n";
}
print "ok $testno\n";
$testno++;
}
}
More information about the dslinux-commit
mailing list