1N/A#!./perl -w
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require './test.pl';
1N/A}
1N/A
1N/Aplan tests => 7 + 256;
1N/A
1N/Ais(
1N/A sprintf("%.40g ",0.01),
1N/A sprintf("%.40g", 0.01)." ",
1N/A q(the sprintf "%.<number>g" optimization)
1N/A);
1N/Ais(
1N/A sprintf("%.40f ",0.01),
1N/A sprintf("%.40f", 0.01)." ",
1N/A q(the sprintf "%.<number>f" optimization)
1N/A);
1N/A{
1N/A chop(my $utf8_format = "%-3s\x{100}");
1N/A is(
1N/A sprintf($utf8_format, "\xe4"),
1N/A "\xe4 ",
1N/A q(width calculation under utf8 upgrade)
1N/A );
1N/A}
1N/A
1N/A# Used to mangle PL_sv_undef
1N/Afresh_perl_is(
1N/A 'print sprintf "xxx%n\n"; print undef',
1N/A 'Modification of a read-only value attempted at - line 1.',
1N/A { switches => [ '-w' ] },
1N/A q(%n should not be able to modify read-only constants),
1N/A);
1N/A
1N/A# check %NNN$ for range bounds, especially negative 2's complement
1N/A
1N/A{
1N/A my ($warn, $bad) = (0,0);
1N/A local $SIG{__WARN__} = sub {
1N/A if ($_[0] =~ /uninitialized/) {
1N/A $warn++
1N/A }
1N/A else {
1N/A $bad++
1N/A }
1N/A };
1N/A my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
1N/A qw(a b c d);
1N/A is($result, "abcd", "only four valid values");
1N/A is($warn, 36, "expected warnings");
1N/A is($bad, 0, "unexpected warnings");
1N/A}
1N/A
1N/A{
1N/A foreach my $ord (0 .. 255) {
1N/A my $bad = 0;
1N/A local $SIG{__WARN__} = sub {
1N/A unless ($_[0] =~ /^Invalid conversion in sprintf/ ||
1N/A $_[0] =~ /^Use of uninitialized value in sprintf/) {
1N/A warn $_[0];
1N/A $bad++;
1N/A }
1N/A };
1N/A my $r = eval {sprintf '%v' . chr $ord};
1N/A is ($bad, 0, "pattern '%v' . chr $ord");
1N/A }
1N/A}