diff options
Diffstat (limited to 'ext/Encode/t/Unicode.t')
| -rw-r--r-- | ext/Encode/t/Unicode.t | 55 |
1 files changed, 30 insertions, 25 deletions
diff --git a/ext/Encode/t/Unicode.t b/ext/Encode/t/Unicode.t index 75486ad5b8..ea52f15312 100644 --- a/ext/Encode/t/Unicode.t +++ b/ext/Encode/t/Unicode.t @@ -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; |