From: Jarkko Hietaniemi Date: Fri, 11 Jan 2002 23:53:05 +0000 (+0000) Subject: Add a new test for is-sprintf-preserving Unicodeness: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=49551dd0a9997016c8e69fe5b2b44d63001e2508;p=p5sagit%2Fp5-mst-13.2.git Add a new test for is-sprintf-preserving Unicodeness: #14194 and an old one from kill_perl.t (I could have used sprintf.t, but it's format was quite fixed, and I didn't feel like breaking the format) p4raw-id: //depot/perl@14198 --- diff --git a/MANIFEST b/MANIFEST index 5d4fa34..2f6223d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2332,6 +2332,7 @@ 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 diff --git a/t/op/unisprintf.t b/t/op/unisprintf.t new file mode 100644 index 0000000..5c9bbb0 --- /dev/null +++ b/t/op/unisprintf.t @@ -0,0 +1,126 @@ +#!./perl -w + +BEGIN { + chdir 't' if -d 't'; + @INC = qw(../lib .); + require "test.pl"; +} + +plan tests => 23; + +$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}'); +} diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t index 9d3a641..b0f0947 100644 --- a/t/run/kill_perl.t +++ b/t/run/kill_perl.t @@ -707,17 +707,6 @@ sub DESTROY { EXPECT Bar=ARRAY(0x...) ######## -# 20010407.008 sprintf removes utf8-ness -$a = sprintf "\x{1234}"; -printf "%x %d\n", unpack("U*", $a), length($a); -$a = sprintf "%s", "\x{5678}"; -printf "%x %d\n", unpack("U*", $a), length($a); -$a = sprintf "\x{1234}%s", "\x{5678}"; -printf "%x %x %d\n", unpack("U*", $a), length($a); -EXPECT -1234 1 -5678 1 -1234 5678 2 ######## found by Markov chain stress testing eval "a.b.c.d.e.f;sub" EXPECT