Change 14837 by ams@lustre on 2002/02/22 21:07:02
Subject: [PATCH] Re: Prototype checking on assignment of coderef to typeglob
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Fri, 22 Feb 2002 23:01:07 +0100
Message-Id: <20020222230107.A15069@rafael>
Affected files ...
.... //depot/perl/sv.c#516 edit
.... //depot/perl/t/op/gv.t#21 edit
Differences ...
==== //depot/perl/sv.c#516 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Fri Feb 22 14:15:05 2002
+++ perl/sv.c Fri Feb 22 14:15:05 2002
@@ -3752,8 +3752,9 @@
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. */
==== //depot/perl/t/op/gv.t#21 (xtext) ====
Index: perl/t/op/gv.t
--- perl/t/op/gv.t.~1~ Fri Feb 22 14:15:05 2002
+++ perl/t/op/gv.t Fri Feb 22 14:15:05 2002
@@ -11,7 +11,7 @@
use warnings;
-print "1..44\n";
+print "1..47\n";
# type coersion on assignment
$foo = 'foo';
@@ -193,5 +193,20 @@
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
End of Patch.
