xref: /openbsd/gnu/usr.bin/perl/t/uni/sprintf.t (revision 09467b48) 
1#!./perl -w
2
3BEGIN {
4    chdir 't' if -d 't';
5    require "./test.pl";
6    set_up_inc(qw(../lib .));
7}
8
9plan tests => 52;
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 (#6769) 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}
140
141my @values =(chr 110, chr 255, chr 256);
142
143foreach 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}
156