#!./perl -w BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; } plan tests => 275; is( sprintf("%.40g ",0.01), sprintf("%.40g", 0.01)." ", q(the sprintf "%.g" optimization) ); is( sprintf("%.40f ",0.01), sprintf("%.40f", 0.01)." ", q(the sprintf "%.f" optimization) ); { chop(my $utf8_format = "%-3s\x{100}"); is( sprintf($utf8_format, "\xe4"), "\xe4 ", q(width calculation under utf8 upgrade) ); } # Used to mangle PL_sv_undef fresh_perl_is( 'print sprintf "xxx%n\n"; print undef', 'Modification of a read-only value attempted at - line 1.', { switches => [ '-w' ] }, q(%n should not be able to modify read-only constants), ); # check overflows for (int(~0/2+1), ~0, "9999999999999999999") { is(eval {sprintf "%${_}d", 0}, undef, "no sprintf result expected %${_}d"); like($@, qr/^Integer overflow in format string for sprintf /, "overflow in sprintf"); is(eval {printf "%${_}d\n", 0}, undef, "no printf result expected %${_}d"); like($@, qr/^Integer overflow in format string for prtf /, "overflow in printf"); } # check %NNN$ for range bounds { my ($warn, $bad) = (0,0); local $SIG{__WARN__} = sub { if ($_[0] =~ /uninitialized/) { $warn++ } else { $bad++ } }; my $fmt = join('', map("%$_\$s%" . ((1 << 31)-$_) . '$s', 1..20)); my $result = sprintf $fmt, qw(a b c d); is($result, "abcd", "only four valid values in $fmt"); is($warn, 36, "expected warnings"); is($bad, 0, "unexpected warnings"); } { foreach my $ord (0 .. 255) { my $bad = 0; local $SIG{__WARN__} = sub { if ($_[0] !~ /^Invalid conversion in sprintf/) { warn $_[0]; $bad++; } }; my $r = eval {sprintf '%v' . chr $ord}; is ($bad, 0, "pattern '%v' . chr $ord"); } }