From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Fri, 22 Feb 2002 23:01:07 +0000 (+0100)
Subject: Re: Prototype checking on assignment of coderef to typeglob
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fb24441d6a82db2d4953db0f33fb07df71b278dd;p=p5sagit%2Fp5-mst-13.2.git

Re: Prototype checking on assignment of coderef to typeglob
   Message-Id: <20020222230107.A15069@rafael>

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

diff --git a/sv.c b/sv.c
index 217df87..89c6e20 100644
--- a/sv.c
+++ b/sv.c
@@ -3752,8 +3752,9 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
  					GvENAME((GV*)dstr));
  				}
 			    }
-			    cv_ckproto(cv, (GV*)dstr,
-				       SvPOK(sref) ? SvPVX(sref) : Nullch);
+			    if (!intro)
+				cv_ckproto(cv, (GV*)dstr,
+					SvPOK(sref) ? SvPVX(sref) : Nullch);
 			}
 			GvCV(dstr) = (CV*)sref;
 			GvCVGEN(dstr) = 0; /* Switch off cacheness. */
diff --git a/t/op/gv.t b/t/op/gv.t
index 9380735..9ce1135 100755
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use warnings;
 
-print "1..44\n";
+print "1..47\n";
 
 # type coersion on assignment
 $foo = 'foo';
@@ -193,5 +193,20 @@ print $j[0] == 1 ? "ok 43\n" : "not ok 43\n";
     print $g;
 }
 
+{
+    my $w = '';
+    $SIG{__WARN__} = sub { $w = $_[0] };
+    sub abc1 ();
+    local *abc1 = sub { };
+    print $w eq '' ? "ok 45\n" : "not ok 45\n# $w";
+    sub abc2 ();
+    local *abc2;
+    *abc2 = sub { };
+    print $w eq '' ? "ok 46\n" : "not ok 46\n# $w";
+    sub abc3 ();
+    *abc3 = sub { };
+    print $w =~ /Prototype mismatch/ ? "ok 47\n" : "not ok 47\n# $w";
+}
+
 __END__
 ok 44