Commit | Line | Data |
---|---|---|
1d917b39 RGS |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9911cee9 | 9 | plan tests => 1292; |
1d917b39 RGS |
10 | |
11 | is( | |
12 | sprintf("%.40g ",0.01), | |
13 | sprintf("%.40g", 0.01)." ", | |
14 | q(the sprintf "%.<number>g" optimization) | |
15 | ); | |
16 | is( | |
17 | sprintf("%.40f ",0.01), | |
18 | sprintf("%.40f", 0.01)." ", | |
19 | q(the sprintf "%.<number>f" optimization) | |
20 | ); | |
cc61b222 TS |
21 | |
22 | # cases of $i > 1 are against [perl #39126] | |
23 | for my $i (1, 5, 10, 20, 50, 100) { | |
24 | chop(my $utf8_format = "%-*s\x{100}"); | |
25 | my $string = "\xB4"x$i; # latin1 ACUTE or ebcdic COPYRIGHT | |
26 | my $expect = $string." "x$i; # followed by 2*$i spaces | |
27 | is(sprintf($utf8_format, 3*$i, $string), $expect, | |
28 | "width calculation under utf8 upgrade, length=$i"); | |
6c94ec8b | 29 | } |
fc7325bb | 30 | |
59b61096 AV |
31 | # check simultaneous width & precision with wide characters |
32 | for my $i (1, 3, 5, 10) { | |
33 | my $string = "\x{0410}"x($i+10); # cyrillic capital A | |
34 | my $expect = "\x{0410}"x$i; # cut down to exactly $i characters | |
35 | my $format = "%$i.${i}s"; | |
36 | is(sprintf($format, $string), $expect, | |
37 | "width & precision interplay with utf8 strings, length=$i"); | |
38 | } | |
39 | ||
fc7325bb GA |
40 | # Used to mangle PL_sv_undef |
41 | fresh_perl_is( | |
42 | 'print sprintf "xxx%n\n"; print undef', | |
43 | 'Modification of a read-only value attempted at - line 1.', | |
44 | { switches => [ '-w' ] }, | |
45 | q(%n should not be able to modify read-only constants), | |
863811b2 DM |
46 | ); |
47 | ||
2fba7546 | 48 | # check overflows |
45e52d63 | 49 | for (int(~0/2+1), ~0, "9999999999999999999") { |
2fba7546 GA |
50 | is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d"); |
51 | like($@, qr/^Integer overflow in format string for sprintf /, "overflow in sprintf"); | |
52 | is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d"); | |
53 | like($@, qr/^Integer overflow in format string for prtf /, "overflow in printf"); | |
54 | } | |
863811b2 | 55 | |
2fba7546 | 56 | # check %NNN$ for range bounds |
863811b2 DM |
57 | { |
58 | my ($warn, $bad) = (0,0); | |
59 | local $SIG{__WARN__} = sub { | |
60 | if ($_[0] =~ /uninitialized/) { | |
61 | $warn++ | |
62 | } | |
63 | else { | |
64 | $bad++ | |
65 | } | |
66 | }; | |
2fba7546 | 67 | |
45e52d63 | 68 | my $fmt = join('', map("%$_\$s%" . ((1 << 31)-$_) . '$s', 1..20)); |
2fba7546 GA |
69 | my $result = sprintf $fmt, qw(a b c d); |
70 | is($result, "abcd", "only four valid values in $fmt"); | |
863811b2 DM |
71 | is($warn, 36, "expected warnings"); |
72 | is($bad, 0, "unexpected warnings"); | |
73 | } | |
74 | ||
343ef749 NC |
75 | { |
76 | foreach my $ord (0 .. 255) { | |
77 | my $bad = 0; | |
78 | local $SIG{__WARN__} = sub { | |
79 | if ($_[0] !~ /^Invalid conversion in sprintf/) { | |
80 | warn $_[0]; | |
81 | $bad++; | |
82 | } | |
83 | }; | |
84 | my $r = eval {sprintf '%v' . chr $ord}; | |
85 | is ($bad, 0, "pattern '%v' . chr $ord"); | |
86 | } | |
87 | } | |
9911cee9 TS |
88 | |
89 | sub mysprintf_int_flags { | |
90 | my ($fmt, $num) = @_; | |
91 | die "wrong format $fmt" if $fmt !~ /^%([-+ 0]+)([1-9][0-9]*)d\z/; | |
92 | my $flag = $1; | |
93 | my $width = $2; | |
94 | my $sign = $num < 0 ? '-' : | |
95 | $flag =~ /\+/ ? '+' : | |
96 | $flag =~ /\ / ? ' ' : | |
97 | ''; | |
98 | my $abs = abs($num); | |
99 | my $padlen = $width - length($sign.$abs); | |
100 | return | |
101 | $flag =~ /0/ && $flag !~ /-/ # do zero padding | |
102 | ? $sign . '0' x $padlen . $abs | |
103 | : $flag =~ /-/ # left or right | |
104 | ? $sign . $abs . ' ' x $padlen | |
105 | : ' ' x $padlen . $sign . $abs; | |
106 | } | |
107 | ||
108 | # Whole tests for "%4d" with 2 to 4 flags; | |
109 | # total counts: 3 * (4**2 + 4**3 + 4**4) == 1008 | |
110 | ||
111 | my @flags = ("-", "+", " ", "0"); | |
112 | for my $num (0, -1, 1) { | |
113 | for my $f1 (@flags) { | |
114 | for my $f2 (@flags) { | |
115 | for my $f3 ('', @flags) { # '' for doubled flags | |
116 | my $flag = $f1.$f2.$f3; | |
117 | my $width = 4; | |
118 | my $fmt = '%'."${flag}${width}d"; | |
119 | my $result = sprintf($fmt, $num); | |
120 | my $expect = mysprintf_int_flags($fmt, $num); | |
121 | is($result, $expect, qq/sprintf("$fmt",$num)/); | |
122 | ||
123 | next if $f3 eq ''; | |
124 | ||
125 | for my $f4 (@flags) { # quadrupled flags | |
126 | my $flag = $f1.$f2.$f3.$f4; | |
127 | my $fmt = '%'."${flag}${width}d"; | |
128 | my $result = sprintf($fmt, $num); | |
129 | my $expect = mysprintf_int_flags($fmt, $num); | |
130 | is($result, $expect, qq/sprintf("$fmt",$num)/); | |
131 | } | |
132 | } | |
133 | } | |
134 | } | |
135 | } | |
136 |