Stop prototype declaration from clobbering constants

$ perl -e 'use constant f=>3; sub f($); warn eval "&f"'
Runaway prototype at -e line 1.
Prototype mismatch:: none vs ($) at -e line 1.
Undefined subroutine &main::f called at (eval 1) line 1.
	...caught at -e line 1.
$ perl -e 'sub f (){3} sub f($); warn eval "&f"'
Prototype mismatch: sub main::f () vs ($) at -e line 1.
3 at -e line 1.

(The ‘Runaway prototype’ warning was removed in acfcf464b177, in which
I stated wrongly that the warning could only come about with stash
manipulation.  I suppose the warning was really warning me that the
implementation was broken, which it was until this commit.)

When constant refs in the symbol table were introduced in 5.10.0
(a bisect points to e040ff70dc), one code path in newATTRSUB--that
assumes that a stash entry that is not a GV is not a defined sub,
but either a forward declaration or no sub at all--was not updated to
account for this new way of storing constants.

diff --git a/op.c b/op.c
index 15c3c04..3e7f805 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7712,12 +7712,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                                 o ? (const GV *)cSVOPo->op_sv : NULL, ps,
                                 ps_len, ps_utf8);
        }
-       if (ps) {
+       if (!SvROK(gv)) {
+         if (ps) {
            sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
             if ( ps_utf8 ) SvUTF8_on(MUTABLE_SV(gv));
-        }
-       else
+          }
+         else
            sv_setiv(MUTABLE_SV(gv), -1);
+       }
 
        SvREFCNT_dec(PL_compcv);
        cv = PL_compcv = NULL;

diff --git a/t/op/sub.t b/t/op/sub.t
index 1861623..575fa17 100644 (file)
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 34 );
+plan( tests => 37 );
 
 sub empty_sub {}
 
@@ -229,3 +229,15 @@ fresh_perl_is(<<'EOS', "", { stderr => 1 },
 use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
 EOS
               "check special blocks are cleared on error");
+
+use constant { constant1 => 1, constant2 => 2 };
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w++ };
+    eval 'sub constant1; sub constant2($)';
+    is eval '&constant1', '1',
+      'stub re-declaration of constant with no prototype';
+    is eval '&constant2', '2',
+      'stub re-declaration of constant with wrong prototype';
+    is $w, 2, 'two warnings from the above';
+}