Commit | Line | Data |
1d917b39 |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | } |
8 | |
cc61b222 |
9 | plan tests => 280; |
1d917b39 |
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 |
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 | |
31 | # Used to mangle PL_sv_undef |
32 | fresh_perl_is( |
33 | 'print sprintf "xxx%n\n"; print undef', |
34 | 'Modification of a read-only value attempted at - line 1.', |
35 | { switches => [ '-w' ] }, |
36 | q(%n should not be able to modify read-only constants), |
863811b2 |
37 | ); |
38 | |
2fba7546 |
39 | # check overflows |
45e52d63 |
40 | for (int(~0/2+1), ~0, "9999999999999999999") { |
2fba7546 |
41 | is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d"); |
42 | like($@, qr/^Integer overflow in format string for sprintf /, "overflow in sprintf"); |
43 | is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d"); |
44 | like($@, qr/^Integer overflow in format string for prtf /, "overflow in printf"); |
45 | } |
863811b2 |
46 | |
2fba7546 |
47 | # check %NNN$ for range bounds |
863811b2 |
48 | { |
49 | my ($warn, $bad) = (0,0); |
50 | local $SIG{__WARN__} = sub { |
51 | if ($_[0] =~ /uninitialized/) { |
52 | $warn++ |
53 | } |
54 | else { |
55 | $bad++ |
56 | } |
57 | }; |
2fba7546 |
58 | |
45e52d63 |
59 | my $fmt = join('', map("%$_\$s%" . ((1 << 31)-$_) . '$s', 1..20)); |
2fba7546 |
60 | my $result = sprintf $fmt, qw(a b c d); |
61 | is($result, "abcd", "only four valid values in $fmt"); |
863811b2 |
62 | is($warn, 36, "expected warnings"); |
63 | is($bad, 0, "unexpected warnings"); |
64 | } |
65 | |
343ef749 |
66 | { |
67 | foreach my $ord (0 .. 255) { |
68 | my $bad = 0; |
69 | local $SIG{__WARN__} = sub { |
70 | if ($_[0] !~ /^Invalid conversion in sprintf/) { |
71 | warn $_[0]; |
72 | $bad++; |
73 | } |
74 | }; |
75 | my $r = eval {sprintf '%v' . chr $ord}; |
76 | is ($bad, 0, "pattern '%v' . chr $ord"); |
77 | } |
78 | } |