1#!./perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9plan tests => 7 + 256; 10 11is( 12 sprintf("%.40g ",0.01), 13 sprintf("%.40g", 0.01)." ", 14 q(the sprintf "%.<number>g" optimization) 15); 16is( 17 sprintf("%.40f ",0.01), 18 sprintf("%.40f", 0.01)." ", 19 q(the sprintf "%.<number>f" optimization) 20); 21{ 22 chop(my $utf8_format = "%-3s\x{100}"); 23 is( 24 sprintf($utf8_format, "\xe4"), 25 "\xe4 ", 26 q(width calculation under utf8 upgrade) 27 ); 28} 29 30# Used to mangle PL_sv_undef 31fresh_perl_is( 32 'print sprintf "xxx%n\n"; print undef', 33 'Modification of a read-only value attempted at - line 1.', 34 { switches => [ '-w' ] }, 35 q(%n should not be able to modify read-only constants), 36); 37 38# check %NNN$ for range bounds, especially negative 2's complement 39 40{ 41 my ($warn, $bad) = (0,0); 42 local $SIG{__WARN__} = sub { 43 if ($_[0] =~ /uninitialized/) { 44 $warn++ 45 } 46 else { 47 $bad++ 48 } 49 }; 50 my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)), 51 qw(a b c d); 52 is($result, "abcd", "only four valid values"); 53 is($warn, 36, "expected warnings"); 54 is($bad, 0, "unexpected warnings"); 55} 56 57{ 58 foreach my $ord (0 .. 255) { 59 my $bad = 0; 60 local $SIG{__WARN__} = sub { 61 unless ($_[0] =~ /^Invalid conversion in sprintf/ || 62 $_[0] =~ /^Use of uninitialized value in sprintf/) { 63 warn $_[0]; 64 $bad++; 65 } 66 }; 67 my $r = eval {sprintf '%v' . chr $ord}; 68 is ($bad, 0, "pattern '%v' . chr $ord"); 69 } 70} 71