[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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 {