t/uni/sprintf.t

   1 #!./perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = qw(../lib .);
   6     require "test.pl";
   7 }
   8
   9 plan tests => 25;
  10
  11 $a = "B\x{fc}f";
  12 $b = "G\x{100}r";
  13 $c = 0x200;
  14
  15 {
  16     my $s = sprintf "%s", $a;
  17     is($s, $a, "%s a");
  18 }
  19
  20 {
  21     my $s = sprintf "%s", $b;
  22     is($s, $b, "%s b");
  23 }
  24
  25 {
  26     my $s = sprintf "%s%s", $a, $b;
  27     is($s, $a.$b, "%s%s a b");
  28 }
  29
  30 {
  31     my $s = sprintf "%s%s", $b, $a;
  32     is($s, $b.$a, "%s%s b a");
  33 }
  34
  35 {
  36     my $s = sprintf "%s%s", $b, $b;
  37     is($s, $b.$b, "%s%s b b");
  38 }
  39
  40 {
  41     my $s = sprintf "%s$b", $a;
  42     is($s, $a.$b, "%sb a");
  43 }
  44
  45 {
  46     my $s = sprintf "$b%s", $a;
  47     is($s, $b.$a, "b%s a");
  48 }
  49
  50 {
  51     my $s = sprintf "%s$a", $b;
  52     is($s, $b.$a, "%sa b");
  53 }
  54
  55 {
  56     my $s = sprintf "$a%s", $b;
  57     is($s, $a.$b, "a%s b");
  58 }
  59
  60 {
  61     my $s = sprintf "$a%s", $a;
  62     is($s, $a.$a, "a%s a");
  63 }
  64
  65 {
  66     my $s = sprintf "$b%s", $b;
  67     is($s, $b.$b, "a%s b");
  68 }
  69
  70 {
  71     my $s = sprintf "%c", $c;
  72     is($s, chr($c), "%c c");
  73 }
  74
  75 {
  76     my $s = sprintf "%s%c", $a, $c;
  77     is($s, $a.chr($c), "%s%c a c");
  78 }
  79
  80 {
  81     my $s = sprintf "%c%s", $c, $a;
  82     is($s, chr($c).$a, "%c%s c a");
  83 }
  84
  85 {
  86     my $s = sprintf "%c$b", $c;
  87     is($s, chr($c).$b, "%cb c");
  88 }
  89
  90 {
  91     my $s = sprintf "%s%c$b", $a, $c;
  92     is($s, $a.chr($c).$b, "%s%cb a c");
  93 }
  94
  95 {
  96     my $s = sprintf "%c%s$b", $c, $a;
  97     is($s, chr($c).$a.$b, "%c%sb c a");
  98 }
  99
 100 {
 101     my $s = sprintf "$b%c", $c;
 102     is($s, $b.chr($c), "b%c c");
 103 }
 104
 105 {
 106     my $s = sprintf "$b%s%c", $a, $c;
 107     is($s, $b.$a.chr($c), "b%s%c a c");
 108 }
 109
 110 {
 111     my $s = sprintf "$b%c%s", $c, $a;
 112     is($s, $b.chr($c).$a, "b%c%s c a");
 113 }
 114
 115 {
 116     # 20010407.008 sprintf removes utf8-ness
 117     $a = sprintf "\x{1234}";
 118     is((sprintf "%x %d", unpack("U*", $a), length($a)),    "1234 1",
 119        '\x{1234}');
 120     $a = sprintf "%s", "\x{5678}";
 121     is((sprintf "%x %d", unpack("U*", $a), length($a)),    "5678 1",
 122        '%s \x{5678}');
 123     $a = sprintf "\x{1234}%s", "\x{5678}";
 124     is((sprintf "%x %x %d", unpack("U*", $a), length($a)), "1234 5678 2",
 125        '\x{1234}%s \x{5678}');
 126 }
 127
 128 {
 129     # check that utf8ness doesn't "accumulate"
 130
 131     my $w = "w\x{fc}";
 132     my $sprintf;
 133
 134     $sprintf = sprintf "%s%s", $w, "$w\x{100}";
 135     is(substr($sprintf,0,2), $w, "utf8 echo");
 136
 137     $sprintf = sprintf "%s%s", $w, "$w\x{100}";
 138     is(substr($sprintf,0,2), $w, "utf8 echo echo");
 139 }