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
1 #!./perl -w
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require "./test.pl";
6     set_up_inc(qw(../lib .));
7 }
8
9 plan 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
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 }