From: Dave Mitchell <davem@fdisolutions.com>
Date: Thu, 1 Dec 2005 16:40:29 +0000 (+0000)
Subject: sprintf %NNN$ check for large values wrapping to negative
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=863811b26c8593d84b9f78cd2addb031ca7b315e;p=p5sagit%2Fp5-mst-13.2.git

sprintf %NNN$ check for large values wrapping to negative

p4raw-id: //depot/perl@26240
---

diff --git a/sv.c b/sv.c
index 35faa6a..cf30025 100644
--- a/sv.c
+++ b/sv.c
@@ -8359,9 +8359,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
 	if (vectorize)
 	    argsv = vecsv;
-	else if (!args)
-	    argsv = (efix ? efix <= svmax : svix < svmax) ?
-		    svargs[efix ? efix-1 : svix++] : &PL_sv_undef;
+	else if (!args) {
+	    I32 i = efix ? efix-1 : svix++;
+	    argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
+	}
 
 	switch (c = *q++) {
 
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index 079df93..d668e60 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }   
 
-plan tests => 4;
+plan tests => 7;
 
 is(
     sprintf("%.40g ",0.01),
@@ -33,4 +33,24 @@ fresh_perl_is(
     'Modification of a read-only value attempted at - line 1.',
     { switches => [ '-w' ] },
     q(%n should not be able to modify read-only constants),
-)
+);
+
+# check %NNN$ for range bounds, especially negative 2's complement
+
+{
+    my ($warn, $bad) = (0,0);
+    local $SIG{__WARN__} = sub {
+	if ($_[0] =~ /uninitialized/) {
+	    $warn++
+	}
+	else {
+	    $bad++
+	}
+    };
+    my $result = sprintf join('', map("%$_\$s%" . ~$_ . '$s', 1..20)),
+	qw(a b c d);
+    is($result, "abcd", "only four valid values");
+    is($warn, 36, "expected warnings");
+    is($bad,   0, "unexpected warnings");
+}
+