require './test.pl';
}
-plan tests => 2;
+plan tests => 275;
is(
sprintf("%.40g ",0.01),
sprintf("%.40f", 0.01)." ",
q(the sprintf "%.<number>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");
+ }
+}