Start a new test category: uni. Much of t/op/pat

should probably be moved here, but holding on that
until Jeffrey finishes his big mktables rewrite.
Bits and pieces of op/split, op/pack, op/append,
op/join, could probably be moved to respective uni
tests, too.

p4raw-id: //depot/perl@14249

2 files changed, 185 insertions, 0 deletions

diff --git a/t/uni/fold.t b/t/uni/fold.t
new file mode 100644
index 0000000000..76e1639065
--- /dev/null
+++ b/t/uni/fold.t
@@ -0,0 +1,46 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Spec;
+
+my $CF = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
+					       "lib", "unicore"),
+			    "CaseFold.txt");
+
+if (open(CF, $CF)) {
+    my @CF;
+
+    while (<CF>) {
+        if (/^([0-9A-F]+); ([CFSI]); ((?:[0-9A-F]+)(?: [0-9A-F]+)*); \# (.+)/) {
+            next if $2 eq 'S'; # we are going for 'F'ull case folding
+	    push @CF, [$1, $2, $3, $4];
+	}
+    }
+
+    die qq[$0: failed to find casefoldings from "$CF"\n] unless @CF;
+
+    print "1..", scalar @CF, "\n";
+
+    my $i = 0;
+    for my $cf (@CF) {
+	my ($code, $status, $mapping, $name) = @$cf;
+	$i++;
+	my $a = pack("U0U*", hex $code);
+	my $b = pack("U0U*", map { hex } split " ", $mapping);
+	my $t0 = ":$a:" =~ /:$a:/    ? 1 : 0;
+	my $t1 = ":$a:" =~ /:$a:/i   ? 1 : 0;
+	my $t2 = ":$a:" =~ /:[$a]:/  ? 1 : 0;
+	my $t3 = ":$a:" =~ /:[$a]:/i ? 1 : 0;
+	my $t4 = ":$a:" =~ /:$b:/i   ? 1 : 0;
+	my $t5 = ":$a:" =~ /:[$b]:/i ? 1 : 0;
+	my $t6 = ":$b:" =~ /:$a:/i   ? 1 : 0;
+	my $t7 = ":$b:" =~ /:[$a]:/i ? 1 : 0;
+	print $t0 && $t1 && $t2 && $t3 && $t4 && $t5 && $t6 && $t7 ?
+	    "ok $i \# - $code - $name - $mapping - $status\n" :
+	    "not ok $i \# - $code - $name - $mapping - $status - $t0 $t1 $t2 $t3 $t4 $t5 $t6 $t7\n";
+    }
+} else {
+    die qq[$0: failed to open "$CF": $!\n];
+}
diff --git a/t/uni/sprintf.t b/t/uni/sprintf.t
new file mode 100644
index 0000000000..3c5f574b62
--- /dev/null
+++ b/t/uni/sprintf.t
@@ -0,0 +1,139 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib .);
+    require "test.pl";
+}
+
+plan tests => 25;
+
+$a = "B\x{fc}f";
+$b = "G\x{100}r";
+$c = 0x200;
+
+{
+    my $s = sprintf "%s", $a;
+    is($s, $a, "%s a");
+}
+
+{
+    my $s = sprintf "%s", $b;
+    is($s, $b, "%s b");
+}
+
+{
+    my $s = sprintf "%s%s", $a, $b;
+    is($s, $a.$b, "%s%s a b");
+}
+
+{
+    my $s = sprintf "%s%s", $b, $a;
+    is($s, $b.$a, "%s%s b a");
+}
+
+{
+    my $s = sprintf "%s%s", $b, $b;
+    is($s, $b.$b, "%s%s b b");
+}
+
+{
+    my $s = sprintf "%s$b", $a;
+    is($s, $a.$b, "%sb a");
+}
+
+{
+    my $s = sprintf "$b%s", $a;
+    is($s, $b.$a, "b%s a");
+}
+
+{
+    my $s = sprintf "%s$a", $b;
+    is($s, $b.$a, "%sa b");
+}
+
+{
+    my $s = sprintf "$a%s", $b;
+    is($s, $a.$b, "a%s b");
+}
+
+{
+    my $s = sprintf "$a%s", $a;
+    is($s, $a.$a, "a%s a");
+}
+
+{
+    my $s = sprintf "$b%s", $b;
+    is($s, $b.$b, "a%s b");
+}
+
+{
+    my $s = sprintf "%c", $c;
+    is($s, chr($c), "%c c");
+}
+
+{
+    my $s = sprintf "%s%c", $a, $c;
+    is($s, $a.chr($c), "%s%c a c");
+}
+
+{
+    my $s = sprintf "%c%s", $c, $a;
+    is($s, chr($c).$a, "%c%s c a");
+}
+
+{
+    my $s = sprintf "%c$b", $c;
+    is($s, chr($c).$b, "%cb c");
+}
+
+{
+    my $s = sprintf "%s%c$b", $a, $c;
+    is($s, $a.chr($c).$b, "%s%cb a c");
+}
+
+{
+    my $s = sprintf "%c%s$b", $c, $a;
+    is($s, chr($c).$a.$b, "%c%sb c a");
+}
+
+{
+    my $s = sprintf "$b%c", $c;
+    is($s, $b.chr($c), "b%c c");
+}
+
+{
+    my $s = sprintf "$b%s%c", $a, $c;
+    is($s, $b.$a.chr($c), "b%s%c a c");
+}
+
+{
+    my $s = sprintf "$b%c%s", $c, $a;
+    is($s, $b.chr($c).$a, "b%c%s c a");
+}
+
+{
+    # 20010407.008 sprintf removes utf8-ness
+    $a = sprintf "\x{1234}";
+    is((sprintf "%x %d", unpack("U*", $a), length($a)),    "1234 1",
+       '\x{1234}');
+    $a = sprintf "%s", "\x{5678}";
+    is((sprintf "%x %d", unpack("U*", $a), length($a)),    "5678 1",
+       '%s \x{5678}');
+    $a = sprintf "\x{1234}%s", "\x{5678}";
+    is((sprintf "%x %x %d", unpack("U*", $a), length($a)), "1234 5678 2",
+       '\x{1234}%s \x{5678}');
+}
+
+{
+    # check that utf8ness doesn't "accumulate"
+
+    my $w = "w\x{fc}";
+    my $sprintf;
+
+    $sprintf = sprintf "%s%s", $w, "$w\x{100}";
+    is(substr($sprintf,0,2), $w, "utf8 echo");
+
+    $sprintf = sprintf "%s%s", $w, "$w\x{100}";    
+    is(substr($sprintf,0,2), $w, "utf8 echo echo");
+}