another case of enabling binmode() where it should not be: if the

[p5sagit/p5-mst-13.2.git] / ext / Encode / t / Unicode.t

diff --git a/ext/Encode/t/Unicode.t b/ext/Encode/t/Unicode.t
index 6436c57..bc15aaf 100644 (file)
--- a/ext/Encode/t/Unicode.t
+++ b/ext/Encode/t/Unicode.t
@@ -1,32 +1,24 @@
 #
-# $Id: Unicode.t,v 1.6 2002/04/12 20:23:05 dankogai Exp dankogai $
+# $Id: Unicode.t,v 1.8 2002/04/16 23:35:00 dankogai Exp $
 #
 # This script is written entirely in ASCII, even though quoted literals
 # do include non-BMP unicode characters -- Are you happy, jhi?
 #
 
+our $ON_EBCDIC;
 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;
-#    }
+    $ON_EBCDIC = (ord("A") == 193) || $ARGV[0];
     $| = 1;
 }
 
 use strict;
 #use Test::More 'no_plan';
-use Test::More tests => 22;
+use Test::More tests => 30;
 use Encode qw(encode decode);
 
 #
@@ -81,15 +73,37 @@ 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 (index($@,'UCS-2BE:'), 0, "decode UCS-2BE: exception");
+eval { decode('UCS-2LE', $n_16le, 1) };
+is (index($@,'UCS-2LE:'), 0, "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");
+is(index($@, 'UCS-2BE'), 0, "encode UCS-2BE: exception");
 eval { encode('UCS-2LE', $nasty, 1) }; 
-ok($@=~/^UCS-2LE:/, "encode UCS-2LE: exception");
+is(index($@, 'UCS-2LE'), 0, "encode UCS-2LE: exception");
+
+#
+# SvGROW test for (en|de)code_xs
+#
+SKIP: {
+    skip "Not on EBCDIC", 8 if $ON_EBCDIC;
+    my $utf8 = '';
+    for my $j (0,0x10){
+       for my $i (0..0xffff){
+           $j == 0 and (0xD800 <= $i && $i <= 0xDFFF) and next;
+           $utf8 .= ord($j+$i);
+       }
+       my $len = length($utf8);
+       for my $major ('UTF-16', 'UTF-32'){
+           for my $minor ('BE', 'LE'){
+               my $enc = $major.$minor;
+               is(decode($enc, encode($enc, $utf8)), $utf8, "$enc RT ($len)");
+           }
+       }
+    }
+};
+
 
 1;
 __END__