Upgrade to Encode 1.30, from Dan Kogai.
[p5sagit/p5-mst-13.2.git] / ext / Encode / t / Unicode.t
index 75486ad..ea52f15 100644 (file)
@@ -1,33 +1,34 @@
 #
-# $Id: Unicode.t,v 1.2 2002/04/07 17:22:31 dankogai Exp dankogai $
+# $Id: Unicode.t,v 1.4 2002/04/08 02:35:48 dankogai Exp dankogai $
 #
 # This script is written entirely in ASCII, even though quoted literals
 # do include non-BMP unicode characters -- Are you happy, jhi?
 #
 
 BEGIN {
-     require Config; import Config;
-     if ($Config{'extensions'} !~ /\bEncode\b/) {
-       print "1..0 # Skip: Encode was not built\n";
-       exit 0;
-     }
+    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;
+#      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;
+#      print "1..0 # Skip: EBCDIC\n";
+#      exit 0;
 #    }
-     $| = 1;
+    $| = 1;
 }
 
 use strict;
 #use Test::More 'no_plan';
 use Test::More tests => 22;
 use Encode qw(encode decode);
+use Encode::Unicode; # to load BOM defs
 
 #
 # see
@@ -40,18 +41,18 @@ 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_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>);
+    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>);
+    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', Encode::Unicode::BOM_BE)  . $n_16be;
 my $n_16lb = pack('n', Encode::Unicode::BOM16LE) . $n_16le;
@@ -77,16 +78,20 @@ 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) };
+eval { decode('UCS-2BE', $n_16be, 1) }; 
 ok($@=~/^UCS-2BE:/, "decode UCS-2BE: exception");
-eval { decode('UCS-2LE', $n_16le, 1) };
+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) };
+eval { encode('UCS-2BE', $nasty, 1) }; 
 ok($@=~/^UCS-2BE:/, "encode UCS-2BE: exception");
-eval { encode('UCS-2LE', $nasty, 1) };
+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;