Change 14249 by jhi@alpha on 2002/01/13 19:55:10
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.
Affected files ...
.... //depot/perl/MANIFEST#707 edit
.... //depot/perl/t/TEST#71 edit
.... //depot/perl/t/harness#26 edit
.... //depot/perl/t/op/unifold.t#2 delete
.... //depot/perl/t/op/unisprintf.t#3 delete
.... //depot/perl/t/uni/fold.t#1 add
.... //depot/perl/t/uni/sprintf.t#1 add
Differences ...
==== //depot/perl/MANIFEST#707 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Sun Jan 13 13:00:06 2002
+++ perl/MANIFEST Sun Jan 13 13:00:06 2002
@@ -2333,8 +2333,6 @@
t/op/time.t See if time functions work
t/op/tr.t See if tr works
t/op/undef.t See if undef works
-t/op/unifold.t See if Unicode folding works
-t/op/unisprintf.t See if Unicode sprintf works
t/op/universal.t See if UNIVERSAL class works
t/op/unshift.t See if unshift works
t/op/utf8decode.t See if UTF-8 decoding works
@@ -2395,6 +2393,8 @@
t/TEST The regression tester
t/test.pl Simple testing library
t/TestInit.pm Preamble library for core tests
+t/uni/fold.t See if Unicode folding works
+t/uni/sprintf.t See if Unicode sprintf works
taint.c Tainting code
thrdvar.h Per-thread variables
thread.h Threading header
==== //depot/perl/t/TEST#71 (xtext) ====
Index: perl/t/TEST
--- perl/t/TEST.~1~ Sun Jan 13 13:00:06 2002
+++ perl/t/TEST Sun Jan 13 13:00:06 2002
@@ -72,7 +72,7 @@
}
unless (@ARGV) {
- foreach my $dir (qw(base comp cmd run io op)) {
+ foreach my $dir (qw(base comp cmd run io op uni)) {
_find_tests($dir);
}
_find_tests("lib") unless $core;
==== //depot/perl/t/harness#26 (text) ====
Index: perl/t/harness
--- perl/t/harness.~1~ Sun Jan 13 13:00:06 2002
+++ perl/t/harness Sun Jan 13 13:00:06 2002
@@ -50,6 +50,7 @@
push @tests, <run/*.t>;
push @tests, <io/*.t>;
push @tests, <op/*.t>;
+ push @tests, <uni/*.t>;
push @tests, <lib/*.t>;
use File::Spec;
my $updir = File::Spec->updir;
==== //depot/perl/t/uni/fold.t#1 (text) ====
Index: perl/t/uni/fold.t
--- perl/t/uni/fold.t.~1~ Sun Jan 13 13:00:06 2002
+++ perl/t/uni/fold.t Sun Jan 13 13:00:06 2002
@@ -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];
+}
==== //depot/perl/t/uni/sprintf.t#1 (text) ====
Index: perl/t/uni/sprintf.t
--- perl/t/uni/sprintf.t.~1~ Sun Jan 13 13:00:06 2002
+++ perl/t/uni/sprintf.t Sun Jan 13 13:00:06 2002
@@ -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");
+}
End of Patch.
