This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5db: add tests for v command
[perl5.git] / t / uni / sprintf.t
CommitLineData
49551dd0
JH
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
1ae3d757 5 require "./test.pl";
624c42e2 6 set_up_inc(qw(../lib .));
49551dd0
JH
7}
8
640283f5 9plan tests => 52;
49551dd0
JH
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{
ee95e30c 116 # 20010407.008 (#6769) sprintf removes utf8-ness
49551dd0
JH
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
JH
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
NC
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}