Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
attrs.t	5.1 KB	-r--r--r--	2014-12-27 11:49
bless.t	2.6 KB	-r--r--r--	2014-12-27 11:49
cache.t	1.05 KB	-r--r--r--	2014-12-27 11:49
caller.t	1.88 KB	-r--r--r--	2014-12-27 11:49
case.pl	3.14 KB	-r--r--r--	2014-12-27 11:49
chomp.t	1.9 KB	-r--r--r--	2014-12-27 11:49
chr.t	655 B	-r--r--r--	2014-12-27 11:49
class.t	2.18 KB	-r--r--r--	2014-12-27 11:49
eval.t	652 B	-r--r--r--	2014-12-27 11:49
fold.t	28.46 KB	-r--r--r--	2014-12-27 11:49
goto.t	836 B	-r--r--r--	2014-12-27 11:49
greek.t	4.15 KB	-r--r--r--	2014-12-27 11:49
gv.t	22.39 KB	-r--r--r--	2014-12-27 11:49
labels.t	1.66 KB	-r--r--r--	2014-12-27 11:49
latin2.t	5.19 KB	-r--r--r--	2014-12-27 11:49
lex_utf8.t	2.15 KB	-r--r--r--	2014-12-27 11:49
lower.t	274 B	-r--r--r--	2014-12-27 11:49
method.t	7.93 KB	-r--r--r--	2014-12-27 11:49
opcroak.t	1.1 KB	-r--r--r--	2014-12-27 11:49
overload.t	7.38 KB	-r--r--r--	2014-12-27 11:49
package.t	2.47 KB	-r--r--r--	2014-12-27 11:49
parser.t	5.6 KB	-r--r--r--	2014-12-27 11:49
readline.t	1.35 KB	-r--r--r--	2014-12-27 11:49
select.t	636 B	-r--r--r--	2014-12-27 11:49
sprintf.t	2.6 KB	-r--r--r--	2014-12-27 11:49
stash.t	9.66 KB	-r--r--r--	2014-12-27 11:49
tie.t	1.02 KB	-r--r--r--	2014-12-27 11:49
title.t	217 B	-r--r--r--	2014-12-27 11:49
tr_7jis.t	1.39 KB	-r--r--r--	2014-12-27 11:49
tr_eucjp.t	1.2 KB	-r--r--r--	2014-12-27 11:49
tr_sjis.t	1.21 KB	-r--r--r--	2014-12-27 11:49
tr_utf8.t	1.71 KB	-r--r--r--	2014-12-27 11:49
universal.t	3.57 KB	-r--r--r--	2014-12-27 11:49
upper.t	298 B	-r--r--r--	2014-12-27 11:49
variables.t	7.77 KB	-r--r--r--	2014-12-27 11:49
write.t	2.45 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./perl -w

BEGIN {
    chdir 't' if -d 't';
    @INC = qw(../lib .);
    require "test.pl";
}

plan tests => 52;

$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");
}

my @values =(chr 110, chr 255, chr 256);

foreach my $prefix (@values) {
    foreach my $vector (map {$_ . $_} @values) {

my $format = "$prefix%*vd";

foreach my $dot (@values) {
	    my $result = sprintf $format, $dot, $vector;
	    is (length $result, 8)
		or print "# ", join (',', map {ord $_} $prefix, $dot, $vector),
		  "\n";
	}
    }
}