Add overflow check to EXPECT_NUMBER() used by sv_vcatpvfn().

sprintf() or printf() will now croak if any of the indexes and
widths specified in the format string are too large.

p4raw-id: //depot/perl@26339

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index e1f6795..5bc399f 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1939,6 +1939,12 @@ transparently promotes all numbers to a floating point representation
 internally--subject to loss of precision errors in subsequent
 operations.
 
+=item Integer overflow in format string for %s
+
+(F) The indexes and widths specified in the format string of printf()
+or sprintf() are too large.  The numbers must not overflow the size of
+integers for your architecture.
+
 =item Integer overflow in version
 
 (F) Some portion of a version initialization is too large for the

diff --git a/sv.c b/sv.c
index e0165d4..83d6ab1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -7634,8 +7634,13 @@ S_expect_number(pTHX_ char** pattern)
     case '1': case '2': case '3':
     case '4': case '5': case '6':
     case '7': case '8': case '9':
-       while (isDIGIT(**pattern))
-           var = var * 10 + (*(*pattern)++ - '0');
+       var = *(*pattern)++ - '0';
+       while (isDIGIT(**pattern)) {
+           I32 tmp = var * 10 + (*(*pattern)++ - '0');
+           if (tmp < var)
+               Perl_croak(aTHX_ "Integer overflow in format string for %s", (PL_op ? OP_NAME(PL_op) : "sv_vcatpvfn"));
+           var = tmp;
+       }
     }
     return var;
 }

diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 6cd9ec3..fcc2d30 100755 (executable)
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -432,5 +432,5 @@ __END__
 >%#b<          >0<     >0<
 >%#o<          >0<     >0<
 >%#x<          >0<     >0<
->%2918905856$v2d<      >''<    ><
->%*2918905856$v2d<     >''<    > UNINIT<
+>%2147483647$v2d<      >''<    ><
+>%*2147483647$v2d<     >''<    > UNINIT<

diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 6527a13..5c00b2a 100644 (file)
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 7 + 256;
+plan tests => 283;
 
 is(
     sprintf("%.40g ",0.01),
@@ -35,8 +35,15 @@ fresh_perl_is(
     q(%n should not be able to modify read-only constants),
 );
 
-# check %NNN$ for range bounds, especially negative 2's complement
+# check overflows
+for (int(~0/2+1), ~0, ~0 + 1, ~0 + 2, "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 {
@@ -47,9 +54,10 @@ fresh_perl_is(
            $bad++
        }
     };
-    my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
-       qw(a b c d);
-    is($result, "abcd", "only four valid values");
+
+    my $fmt = join('', map("%$_\$s%" . int(~0/2+1-$_) . '$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");
 }