Missing files.

p4raw-id: //depot/perl@15782

diff --git a/MANIFEST b/MANIFEST
index 71d7166..fe6b030 100644 (file)
--- 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 (file)
--- 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 (file)
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 (file)
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__
+
+