From: hv@crypt.org <hv@crypt.org>
Date: Sun, 6 Dec 2009 21:24:39 +0000 (+0100)
Subject: [perl #71000] Wrong variable name in warning
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7baa4690;p=p5sagit%2Fp5-mst-13.2.git

[perl #71000] Wrong variable name in warning

Add a new warning "Missing argument in %s"
---

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 42fe77e..a031b24 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2425,6 +2425,11 @@ ended earlier on the current line.
 (W syntax) An underscore (underbar) in a numeric constant did not
 separate two digits.
 
+=item Missing argument in %s
+
+(W uninitialized) A printf-type format required more arguments than were
+supplied.
+
 =item Missing argument to -%c
 
 (F) The argument to the indicated command line switch must follow
diff --git a/sv.c b/sv.c
index 95ad106..3151679 100644
--- a/sv.c
+++ b/sv.c
@@ -9161,6 +9161,22 @@ Perl_sv_vsetpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
     sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
 }
 
+
+/*
+ * Warn of missing argument to sprintf, and then return a defined value
+ * to avoid inappropriate "use of uninit" warnings [perl #71000].
+ */
+#define WARN_MISSING WARN_UNINITIALIZED /* Not sure we want a new category */
+STATIC SV*
+S_vcatpvfn_missing_argument(pTHX_) {
+    if (ckWARN(WARN_MISSING)) {
+	Perl_warner(aTHX_ packWARN(WARN_MISSING), "Missing argument in %s",
+		PL_op ? OP_DESC(PL_op) : "sv_vcatpvfn()");
+    }
+    return &PL_sv_no;
+}
+
+
 STATIC I32
 S_expect_number(pTHX_ char **const pattern)
 {
@@ -9526,9 +9542,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 		    vecsv = va_arg(*args, SV*);
 		else if (evix) {
 		    vecsv = (evix > 0 && evix <= svmax)
-			? svargs[evix-1] : &PL_sv_undef;
+			? svargs[evix-1] : S_vcatpvfn_missing_argument();
 		} else {
-		    vecsv = svix < svmax ? svargs[svix++] : &PL_sv_undef;
+		    vecsv = svix < svmax
+			? svargs[svix++] : S_vcatpvfn_missing_argument();
 		}
 		dotstr = SvPV_const(vecsv, dotstrlen);
 		/* Keep the DO_UTF8 test *after* the SvPV call, else things go
@@ -9675,10 +9692,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
 	if (!vectorize && !args) {
 	    if (efix) {
 		const I32 i = efix-1;
-		argsv = (i >= 0 && i < svmax) ? svargs[i] : &PL_sv_undef;
+		argsv = (i >= 0 && i < svmax)
+		    ? svargs[i] : S_vcatpvfn_missing_argument();
 	    } else {
 		argsv = (svix >= 0 && svix < svmax)
-		    ? svargs[svix++] : &PL_sv_undef;
+		    ? svargs[svix++] : S_vcatpvfn_missing_argument();
 	    }
 	}
 
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index ba77e64..a127143 100644
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -60,6 +60,8 @@ $SIG{__WARN__} = sub {
 	$w = ' INVALID';
     } elsif ($_[0] =~ /^Use of uninitialized value/) {
 	$w = ' UNINIT';
+    } elsif ($_[0] =~ /^Missing argument/) {
+	$w = ' MISSING';
     } else {
 	warn @_;
     }
@@ -618,7 +620,7 @@ __END__
 >%3$d %d %d<	>[12, 34, 56]<	>56 12 34<
 >%2$*3$d %d<	>[12, 34, 3]<	> 34 12<
 >%*3$2$d %d<	>[12, 34, 3]<	>%*3$2$d 12 INVALID<
->%2$d<		>12<	>0 UNINIT<
+>%2$d<		>12<	>0 MISSING<
 >%0$d<		>12<	>%0$d INVALID<
 >%1$$d<		>12<	>%1$$d INVALID<
 >%1$1$d<	>12<	>%1$1$d INVALID<
@@ -685,4 +687,4 @@ __END__
 >%#o<		>0<	>0<
 >%#x<		>0<	>0<
 >%2147483647$v2d<	>''<	><
->%*2147483647$v2d<	>''<	> UNINIT<
+>%*2147483647$v2d<	>''<	> MISSING<
diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t
index ed26c54..e81b59e 100644
--- a/t/op/sprintf2.t
+++ b/t/op/sprintf2.t
@@ -41,9 +41,9 @@ for my $i (1, 3, 5, 10) {
 }
 
 # Used to mangle PL_sv_undef
-fresh_perl_is(
+fresh_perl_like(
     'print sprintf "xxx%n\n"; print undef',
-    'Modification of a read-only value attempted at - line 1.',
+    'Modification of a read-only value attempted at - line 1\.',
     { switches => [ '-w' ] },
     q(%n should not be able to modify read-only constants),
 );
@@ -60,7 +60,7 @@ for (int(~0/2+1), ~0, "9999999999999999999") {
 {
     my ($warn, $bad) = (0,0);
     local $SIG{__WARN__} = sub {
-	if ($_[0] =~ /uninitialized/) {
+	if ($_[0] =~ /missing argument/i) {
 	    $warn++
 	}
 	else {