Make prototype call FETCH before checking CORE:: prefix

$ perl5.16.0 -e '"CORE::length" =~ /(.*)/; warn prototype $1;'
Warning: something's wrong at -e line 1.
$ perl5.16.0 -e 'warn prototype "CORE::length"'
_ at -e line 1.

Since sv_2cv calls get-magic, the easiest solution is to copy the
argument if it is magical.

diff --git a/pp.c b/pp.c
index 8d2ee2a..0370caa 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -432,6 +432,7 @@ PP(pp_prototype)
     GV *gv;
     SV *ret = &PL_sv_undef;
 
+    if (SvGMAGICAL(TOPs)) SETs(sv_mortalcopy(TOPs));
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
        const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {

diff --git a/t/comp/proto.t b/t/comp/proto.t
index 8e9821f..d5e4d5b 100644 (file)
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -18,7 +18,7 @@ BEGIN {
 # strict
 use strict;
 
-print "1..179\n";
+print "1..180\n";
 
 my $i = 1;
 
@@ -409,7 +409,7 @@ print "ok ", $i++, "\n";
 print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$@';
 print "ok ", $i++, "\n";
 
-print "# CORE:Foo => ($p), \$@ => '$@'\nnot " 
+print "# CORE::Foo => ($p), \$@ => '$@'\nnot " 
     if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Can't find an opnumber/;
 print "ok ", $i++, "\n";
 
@@ -423,6 +423,12 @@ print "# CORE::\\x{100}: => ($p), \$@ => '$@'\nnot "
     if $@ !~ /^Can't find an opnumber for "\x{100}"/;
 print "ok ", $i++, "\n";
 
+"CORE::Foo" =~ /(.*)/;
+print "# \$1 containing CORE::Foo => ($p), \$@ => '$@'\nnot " 
+    if defined ($p = eval { prototype($1) or 1 })
+    or $@ !~ /^Can't find an opnumber/;
+print "ok ", $i++, " - \$1 containing CORE::Foo\n";
+
 # correctly note too-short parameter lists that don't end with '$',
 #  a possible regression.
 

diff --git a/t/echo3001 b/t/echo3001
new file mode 100644 (file)
index 0000000..841ea7f
--- /dev/null
+++ b/t/echo3001
@@ -0,0 +1 @@
+print "@ARGV\n"

diff --git a/t/utf67682.pl b/t/utf67682.pl
new file mode 100644 (file)
index 0000000..66777ee
Binary files /dev/null and b/t/utf67682.pl differ