From: Jarkko Hietaniemi Date: Sun, 7 Apr 2002 15:53:35 +0000 (+0000) Subject: Missing files. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=26b787bb859e0d99eff7715146ff02fbe5a2fca5;p=p5sagit%2Fp5-mst-13.2.git Missing files. p4raw-id: //depot/perl@15782 --- diff --git a/MANIFEST b/MANIFEST index 71d7166..fe6b030 100644 --- a/MANIFEST +++ b/MANIFEST @@ -247,9 +247,11 @@ ext/Encode/t/Encode.t Encode extension test ext/Encode/t/JP.t Encode extension test ext/Encode/t/KR.t Encode extension test ext/Encode/t/TW.t Encode extension test +ext/Encode/t/Unicode.t Encode extension test ext/Encode/t/encoding.t encoding extension test ext/Encode/t/gb2312.euc test data ext/Encode/t/gb2312.ref test data +ext/Encode/t/grow.t Encode extension test ext/Encode/t/jisx0208.euc test data ext/Encode/t/jisx0208.ref test data ext/Encode/t/jisx0212.euc test data diff --git a/ext/Encode/MANIFEST b/ext/Encode/MANIFEST index aeebb8b..d45f8e6 100644 --- a/ext/Encode/MANIFEST +++ b/ext/Encode/MANIFEST @@ -49,9 +49,11 @@ t/Encode.t Encode extension test t/JP.t Encode extension test t/KR.t Encode extension test t/TW.t Encode extension test +t/Unicode.t Encode extension test t/encoding.t encoding extension test t/gb2312.euc test data t/gb2312.ref test data +t/grow.t Encode extension test t/jisx0208.euc test data t/jisx0208.ref test data t/jisx0212.euc test data diff --git a/ext/Encode/t/Unicode.t b/ext/Encode/t/Unicode.t new file mode 100644 index 0000000..0e93c83 --- /dev/null +++ b/ext/Encode/t/Unicode.t @@ -0,0 +1,190 @@ +# +# $Id: jperl.t,v 1.20 2002/04/04 19:50:52 dankogai Exp $ +# +# This script is written in euc-jp + +BEGIN { + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } +# should work without perlio +# unless (find PerlIO::Layer 'perlio') { +# print "1..0 # Skip: PerlIO was not built\n"; +# exit 0; +# } +# should work on EBCDIC +# if (ord("A") == 193) { +# print "1..0 # Skip: EBCDIC\n"; +# exit 0; +# } + $| = 1; +} + +use strict; +#use Test::More 'no_plan'; +use Test::More tests => 22; +use Encode qw(encode decode); +use Encode::utflib; + +# +# see +# http://www.unicode.org/unicode/reports/tr19/ +# + +my $nasty = "\x{004D}\x{0061}\x{1abcd}"; +my $fallback = "\x{004D}\x{0061}\x{fffd}"; + +#hi: (0x1abcd - 0x10000) / 0x400 + 0xD800 = 0xd82a +#lo: (0x1abcd - 0x10000) % 0x400 + 0xDC00 = 0xdfcd + +my $n_16be = + pack("C*", map {hex($_)} qw<00 4D 00 61 d8 2a df cd>); +my $n_16le = + pack("C*", map {hex($_)} qw<4D 00 61 00 2a d8 cd df>); +my $f_16be = + pack("C*", map {hex($_)} qw<00 4D 00 61 ff fd>); +my $f_16le = + pack("C*", map {hex($_)} qw<4D 00 61 00 fd ff>); +my $n_32be = + pack("C*", map {hex($_)} qw<00 00 00 4D 00 00 00 61 00 01 ab cd>); +my $n_32le = + pack("C*", map {hex($_)} qw<4D 00 00 00 61 00 00 00 cd ab 01 00>); + +my $n_16bb = pack('n', BOM_BE) . $n_16be; +my $n_16lb = pack('n', BOM16LE) . $n_16le; +my $n_32bb = pack('N', BOM_BE ) . $n_32be; +my $n_32lb = pack('N', BOM32LE) . $n_32le; + +is($n_16be, encode('UTF-16BE', $nasty), qq{encode UTF-16BE}); +is($n_16le, encode('UTF-16LE', $nasty), qq{encode UTF-16LE}); +is($n_32be, encode('UTF-32BE', $nasty), qq{encode UTF-32BE}); +is($n_32le, encode('UTF-32LE', $nasty), qq{encode UTF-16LE}); + +is($nasty, decode('UTF-16BE', $n_16be), qq{decode UTF-16BE}); +is($nasty, decode('UTF-16LE', $n_16le), qq{decode UTF-16LE}); +is($nasty, decode('UTF-32BE', $n_32be), qq{decode UTF-32BE}); +is($nasty, decode('UTF-32LE', $n_32le), qq{decode UTF-32LE}); + +is($n_16bb, encode('UTF-16', $nasty), qq{encode UTF-16}); +is($n_32bb, encode('UTF-32', $nasty), qq{encode UTF-32}); +is($nasty, decode('UTF-16', $n_16bb), qq{decode UTF-16, bom=be}); +is($nasty, decode('UTF-16', $n_16lb), qq{decode UTF-16, bom=le}); +is($nasty, decode('UTF-32', $n_32bb), qq{decode UTF-32, bom=be}); +is($nasty, decode('UTF-32', $n_32lb), qq{decode UTF-32, bom=le}); + +is(decode('UCS-2BE', $n_16be), $fallback, "decode UCS-2BE: fallback"); +is(decode('UCS-2LE', $n_16le), $fallback, "decode UCS-2LE: fallback"); +eval { decode('UCS-2BE', $n_16be, 1) }; +ok($@=~/^UCS-2BE:/, "decode UCS-2BE: exception"); +eval { decode('UCS-2LE', $n_16le, 1) }; +ok($@=~/^UCS-2LE:/, "decode UCS-2LE: exception"); +is(encode('UCS-2BE', $nasty), $f_16be, "encode UCS-2BE: fallback"); +is(encode('UCS-2LE', $nasty), $f_16le, "encode UCS-2LE: fallback"); +eval { encode('UCS-2BE', $nasty, 1) }; +ok($@=~/^UCS-2BE:/, "encode UCS-2BE: exception"); +eval { encode('UCS-2LE', $nasty, 1) }; +ok($@=~/^UCS-2LE:/, "encode UCS-2LE: exception"); + +1; +__END__ + +use Devel::Peek; +my $foo = decode('UTF-16BE', $n_16be); +Dump $n_16be; Dump $foo; +# +# $Id: jperl.t,v 1.20 2002/04/04 19:50:52 dankogai Exp $ +# +# This script is written in euc-jp + +BEGIN { + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } +# should work without perlio +# unless (find PerlIO::Layer 'perlio') { +# print "1..0 # Skip: PerlIO was not built\n"; +# exit 0; +# } +# should work on EBCDIC +# if (ord("A") == 193) { +# print "1..0 # Skip: EBCDIC\n"; +# exit 0; +# } + $| = 1; +} + +use strict; +#use Test::More 'no_plan'; +use Test::More tests => 22; +use Encode qw(encode decode); +use Encode::utflib; + +# +# see +# http://www.unicode.org/unicode/reports/tr19/ +# + +my $nasty = "\x{004D}\x{0061}\x{1abcd}"; +my $fallback = "\x{004D}\x{0061}\x{fffd}"; + +#hi: (0x1abcd - 0x10000) / 0x400 + 0xD800 = 0xd82a +#lo: (0x1abcd - 0x10000) % 0x400 + 0xDC00 = 0xdfcd + +my $n_16be = + pack("C*", map {hex($_)} qw<00 4D 00 61 d8 2a df cd>); +my $n_16le = + pack("C*", map {hex($_)} qw<4D 00 61 00 2a d8 cd df>); +my $f_16be = + pack("C*", map {hex($_)} qw<00 4D 00 61 ff fd>); +my $f_16le = + pack("C*", map {hex($_)} qw<4D 00 61 00 fd ff>); +my $n_32be = + pack("C*", map {hex($_)} qw<00 00 00 4D 00 00 00 61 00 01 ab cd>); +my $n_32le = + pack("C*", map {hex($_)} qw<4D 00 00 00 61 00 00 00 cd ab 01 00>); + +my $n_16bb = pack('n', BOM_BE) . $n_16be; +my $n_16lb = pack('n', BOM16LE) . $n_16le; +my $n_32bb = pack('N', BOM_BE ) . $n_32be; +my $n_32lb = pack('N', BOM32LE) . $n_32le; + +is($n_16be, encode('UTF-16BE', $nasty), qq{encode UTF-16BE}); +is($n_16le, encode('UTF-16LE', $nasty), qq{encode UTF-16LE}); +is($n_32be, encode('UTF-32BE', $nasty), qq{encode UTF-32BE}); +is($n_32le, encode('UTF-32LE', $nasty), qq{encode UTF-16LE}); + +is($nasty, decode('UTF-16BE', $n_16be), qq{decode UTF-16BE}); +is($nasty, decode('UTF-16LE', $n_16le), qq{decode UTF-16LE}); +is($nasty, decode('UTF-32BE', $n_32be), qq{decode UTF-32BE}); +is($nasty, decode('UTF-32LE', $n_32le), qq{decode UTF-32LE}); + +is($n_16bb, encode('UTF-16', $nasty), qq{encode UTF-16}); +is($n_32bb, encode('UTF-32', $nasty), qq{encode UTF-32}); +is($nasty, decode('UTF-16', $n_16bb), qq{decode UTF-16, bom=be}); +is($nasty, decode('UTF-16', $n_16lb), qq{decode UTF-16, bom=le}); +is($nasty, decode('UTF-32', $n_32bb), qq{decode UTF-32, bom=be}); +is($nasty, decode('UTF-32', $n_32lb), qq{decode UTF-32, bom=le}); + +is(decode('UCS-2BE', $n_16be), $fallback, "decode UCS-2BE: fallback"); +is(decode('UCS-2LE', $n_16le), $fallback, "decode UCS-2LE: fallback"); +eval { decode('UCS-2BE', $n_16be, 1) }; +ok($@=~/^UCS-2BE:/, "decode UCS-2BE: exception"); +eval { decode('UCS-2LE', $n_16le, 1) }; +ok($@=~/^UCS-2LE:/, "decode UCS-2LE: exception"); +is(encode('UCS-2BE', $nasty), $f_16be, "encode UCS-2BE: fallback"); +is(encode('UCS-2LE', $nasty), $f_16le, "encode UCS-2LE: fallback"); +eval { encode('UCS-2BE', $nasty, 1) }; +ok($@=~/^UCS-2BE:/, "encode UCS-2BE: exception"); +eval { encode('UCS-2LE', $nasty, 1) }; +ok($@=~/^UCS-2LE:/, "encode UCS-2LE: exception"); + +1; +__END__ + +use Devel::Peek; +my $foo = decode('UTF-16BE', $n_16be); +Dump $n_16be; Dump $foo; diff --git a/ext/Encode/t/grow.t b/ext/Encode/t/grow.t new file mode 100644 index 0000000..8cf2f03 --- /dev/null +++ b/ext/Encode/t/grow.t @@ -0,0 +1,78 @@ +#!../perl +our $POWER; +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } + $POWER = 12; # up to 1 MB. You may adjust the figure here +} + +use strict; +use Encode; + +my $seed = ""; +for my $i (0x00..0xff){ + my $c = chr($i); + $seed .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; +} + +use Test::More tests => $POWER*2; +my $octs = $seed; +use bytes (); +for my $i (1..$POWER){ + $octs .= $octs; + my $len = bytes::length($octs); + my $utf8 = Encode::decode('latin1', $octs); + ok(1, "decode $len bytes"); + is($octs, + Encode::encode('latin1', $utf8), + "encode $len bytes"); +} +__END__ + + +#!../perl +our $POWER; +BEGIN { + if ($ENV{'PERL_CORE'}){ + chdir 't'; + unshift @INC, '../lib'; + } + require Config; import Config; + if ($Config{'extensions'} !~ /\bEncode\b/) { + print "1..0 # Skip: Encode was not built\n"; + exit 0; + } + $POWER = 12; # up to 1 MB. You may adjust the figure here +} + +use strict; +use Encode; + +my $seed = ""; +for my $i (0x00..0xff){ + my $c = chr($i); + $seed .= ($c =~ /^\p{IsPrint}/o) ? $c : " "; +} + +use Test::More tests => $POWER*2; +my $octs = $seed; +use bytes (); +for my $i (1..$POWER){ + $octs .= $octs; + my $len = bytes::length($octs); + my $utf8 = Encode::decode('latin1', $octs); + ok(1, "decode $len bytes"); + is($octs, + Encode::encode('latin1', $utf8), + "encode $len bytes"); +} +__END__ + +