This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Copy PADTMPS passed to XSUBs
authorFather Chrysostomos <sprout@cpan.org>
Tue, 13 Aug 2013 20:10:15 +0000 (13:10 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 13 Aug 2013 20:42:41 +0000 (13:42 -0700)
This resolves the last remaining issue in ticket #78194, that
newRV is supposedly buggy because it doesn’t copy its referent.
The full implications of the PADTMP are not explained anywhere in
the API docs, and even XSUBs shouldn’t have to worry about special
handling.  (E.g., what if they do SvREFCNT_dec(SvRV(sv)); SvRV(sv)=...?)

So the real solution here is not to let XSUBs see them.

MANIFEST
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/subcall.t [new file with mode: 0644]
pp_hot.c

index 8192ff6..e37d10c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3924,6 +3924,7 @@ ext/XS-APItest/t/stmtasexpr.t     test recursive descent statement parsing
 ext/XS-APItest/t/stmtsasexpr.t test recursive descent statement-sequence parsing
 ext/XS-APItest/t/stuff_modify_bug.t    test for eval side-effecting source string
 ext/XS-APItest/t/stuff_svcur_bug.t     test for a bug in lex_stuff_pvn
+ext/XS-APItest/t/subcall.t     Test XSUB calls
 ext/XS-APItest/t/sviscow.t     Test SvIsCOW
 ext/XS-APItest/t/svpeek.t      XS::APItest extension
 ext/XS-APItest/t/svpv_magic.t  Test behaviour of SvPVbyte/utf8 & get magic
index 8eaabdb..2db7b4f 100644 (file)
@@ -3459,6 +3459,9 @@ sv_mortalcopy(SV *sv)
     OUTPUT:
        RETVAL
 
+SV *
+newRV(SV *sv)
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
diff --git a/ext/XS-APItest/t/subcall.t b/ext/XS-APItest/t/subcall.t
new file mode 100644 (file)
index 0000000..a0b51bc
--- /dev/null
@@ -0,0 +1,9 @@
+#!perl
+
+# Test handling of XSUBs in pp_entersub
+
+use Test::More tests => 1;
+use XS::APItest;
+
+$ref = XS::APItest::newRV($_+1);
+is \$$ref, $ref, 'XSUBs do not get to see PADTMPs';
index 3adeb1e..b08643f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2727,6 +2727,15 @@ try_autoload:
                PUTBACK ;               
            }
        }
+       else {
+           SV **mark = PL_stack_base + markix;
+           I32 items = SP - mark;
+           while (items--) {
+               mark++;
+               if (*mark && SvPADTMP(*mark) && !IS_PADGV(*mark))
+                   *mark = sv_mortalcopy(*mark);
+           }
+       }
        /* We assume first XSUB in &DB::sub is the called one. */
        if (PL_curcopdb) {
            SAVEVPTR(PL_curcop);