Make sv_set[ps]v(cv...) set prototype

The SvPVX slot of a CV is used both for the prototype and for the sub
name passed to an XS AUTOLOAD sub.

It used to be that such AUTOLOADing would clobber the prototype.

Commit 8fa6a4095 made the two uses of SvPVX try to play along nicely
with each other, so the prototype comes after the sub name if both
need to be present.  It added the CvPROTO macro to account for that.

Some CPAN modules expect to be able to set the prototype with
sv_set[ps]v.  So this commit makes that work as expected, by turn-
ing off the flag that says the prototype comes after the auto-
loaded sub name.

Anyone using Scalar::Util::set_prototype to work around the proto-
type-clobbering bug can now continue to do so, without triggering
a new bug.

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index ff2b9bb..a83830a 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2155,6 +2155,21 @@ bool
 sv_setsv_cow_hashkey_notcore()
 
 void
+sv_set_deref(SV *sv, SV *sv2, int which)
+    CODE:
+    {
+       STRLEN len;
+       const char *pv = SvPV(sv2,len);
+       if (!SvROK(sv)) croak("Not a ref");
+       sv = SvRV(sv);
+       switch (which) {
+           case 0: sv_setsv(sv,sv2); break;
+           case 1: sv_setpv(sv,pv); break;
+           case 2: sv_setpvn(sv,pv,len); break;
+       }
+    }
+
+void
 rmagical_cast(sv, type)
     SV *sv;
     SV *type;

diff --git a/ext/XS-APItest/t/svsetsv.t b/ext/XS-APItest/t/svsetsv.t
index ea845e0..328bc77 100644 (file)
--- a/ext/XS-APItest/t/svsetsv.t
+++ b/ext/XS-APItest/t/svsetsv.t
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 6;
 
 BEGIN { use_ok('XS::APItest') };
 
@@ -12,3 +12,11 @@ ok(sv_setsv_cow_hashkey_core,
 
 ok(!sv_setsv_cow_hashkey_notcore,
    "Without PERL_CORE sv_setsv doesn't COW for shared hash key scalars");
+
+*AUTOLOAD = \&XS::APItest::AutoLoader::AUTOLOADp;
+foo(\1); sv_set_deref(\&AUTOLOAD, '$', 0);
+is prototype(\&AUTOLOAD), '$', 'sv_setsv(cv,...) sets prototype';
+foo(\1); sv_set_deref(\&AUTOLOAD, '$', 1);
+is prototype(\&AUTOLOAD), '$', 'sv_setpv(cv,...) sets prototype';
+foo(\1); sv_set_deref(\&AUTOLOAD, '$', 2);
+is prototype(\&AUTOLOAD), '$', 'sv_setpvn(cv,...) sets prototype';

diff --git a/sv.c b/sv.c
index bbe7ee6..59d8af5 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4118,6 +4118,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
             SvCUR_set(dstr, len);
            SvPOK_only(dstr);
            SvFLAGS(dstr) |= sflags & SVf_UTF8;
+           CvAUTOLOAD_off(dstr);
        } else {
            SvOK_off(dstr);
        }
@@ -4518,6 +4519,7 @@ Perl_sv_setpvn(pTHX_ register SV *const sv, register const char *const ptr, regi
     SvCUR_set(sv, len);
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
+    if (SvTYPE(sv) == SVt_PVCV) CvAUTOLOAD_off(sv);
 }
 
 /*
@@ -4567,6 +4569,7 @@ Perl_sv_setpv(pTHX_ register SV *const sv, register const char *const ptr)
     SvCUR_set(sv, len);
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
+    if (SvTYPE(sv) == SVt_PVCV) CvAUTOLOAD_off(sv);
 }
 
 /*