From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 22 Oct 2009 14:28:47 +0000 (+0100)
Subject: Tests for UTF-16 characters > 256, including those containing the octet 10.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=02512a66ad35b8ddc69cacdee9807210c5e13167;p=p5sagit%2Fp5-mst-13.2.git

Tests for UTF-16 characters > 256, including those containing the octet 10.
---

diff --git a/t/comp/utf.t b/t/comp/utf.t
index c1a3e82..69ede95 100644
--- a/t/comp/utf.t
+++ b/t/comp/utf.t
@@ -1,6 +1,6 @@
 #!./perl -w
 
-print "1..36\n";
+print "1..76\n";
 my $test = 0;
 
 my %templates = (
@@ -13,31 +13,44 @@ sub bytes_to_utf {
     my ($enc, $content, $do_bom) = @_;
     my $template = $templates{$enc};
     die "Unsupported encoding $enc" unless $template;
-    return pack "$template*", ($do_bom ? 0xFEFF : ()), unpack "C*", $content;
+    return pack "$template*", ($do_bom ? 0xFEFF : ()), unpack "U*", $content;
 }
 
 sub test {
-    my ($enc, $tag, $bom, $nl) = @_;
+    my ($enc, $write, $expect, $bom, $nl, $name) = @_;
     open my $fh, ">", "utf$$.pl" or die "utf.pl: $!";
     binmode $fh;
-    print $fh bytes_to_utf($enc, $tag . ($nl ? "\n" : ''), $bom);
+    print $fh bytes_to_utf($enc, $write . ($nl ? "\n" : ''), $bom);
     close $fh or die $!;
     my $got = do "./utf$$.pl";
     $test = $test + 1;
     if (!defined $got) {
-	print "not ok $test # $enc $tag $bom $nl; got undef\n";
-    } elsif ($got ne $tag) {
-	print "not ok $test # $enc $tag $bom $nl; got '$got'\n";
+	print "not ok $test # $enc $bom $nl $name; got undef\n";
+    } elsif ($got ne $expect) {
+	print "not ok $test # $enc $bom $nl $name; got '$got'\n";
     } else {
-	print "ok $test # $enc $tag $bom $nl\n";
+	print "ok $test # $enc $bom $nl $name\n";
     }
 }
 
 for my $bom (0, 1) {
     for my $enc (qw(utf16le utf16be utf8)) {
-	for my $value (123, 1234, 12345) {
-	    for my $nl (1, 0) {
-		test($enc, $value, $bom, $nl);
+	for my $nl (1, 0) {
+	    for my $value (123, 1234, 12345) {
+		test($enc, $value, $value, $bom, $nl, $value);
+	    }
+	    next if $enc eq 'utf8';
+	    # Arguably a bug that currently string literals from UTF-8 file
+	    # handles are not implicitly "use utf8", but don't FIXME that
+	    # right now, as here we're testing the input filter itself.
+
+	    for my $expect ("N", "\xFF", "\x{100}", "\x{010a}", "\x{0a23}",
+			   ) {
+		# A space so that the UTF-16 heuristc triggers - " '" gives two
+		# characters of ASCII.
+		my $write = " '$expect'";
+		my $name = 'chrs ' . join ', ', map {ord $_} split '', $expect;
+		test($enc, $write, $expect, $bom, $nl, $name);
 	    }
 	}
     }