Commit | Line | Data |
49551dd0 |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = qw(../lib .); |
6 | require "test.pl"; |
7 | } |
8 | |
640283f5 |
9 | plan tests => 52; |
49551dd0 |
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 | } |
5b781b5b |
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 | } |
640283f5 |
140 | |
141 | my @values =(chr 110, chr 255, chr 256); |
142 | |
143 | foreach my $prefix (@values) { |
144 | foreach my $vector (map {$_ . $_} @values) { |
145 | |
146 | my $format = "$prefix%*vd"; |
147 | |
148 | foreach my $dot (@values) { |
149 | my $result = sprintf $format, $dot, $vector; |
150 | is (length $result, 8) |
151 | or print "# ", join (',', map {ord $_} $prefix, $dot, $vector), |
152 | "\n"; |
153 | } |
154 | } |
155 | } |