This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #78194] Make sub calls copy pad tmps
authorFather Chrysostomos <sprout@cpan.org>
Thu, 20 Jun 2013 21:32:15 +0000 (14:32 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:00 +0000 (23:48 -0700)
before aliasing them to elements of @_.

ext/Devel-Peek/t/Peek.t
pp_hot.c
t/op/sub.t
t/op/tie.t

index 5019fb1..625e98b 100644 (file)
@@ -153,7 +153,8 @@ my $type = do_test('result of addition',
         $c + $d,
 'SV = ([NI])V\\($ADDR\\) at $ADDR
   REFCNT = 1
-  FLAGS = \\(PADTMP,\1OK,p\1OK\\)
+  FLAGS = \\(PADTMP,\1OK,p\1OK\\)              # $] < 5.019002
+  FLAGS = \\(\1OK,p\1OK\\)                     # $] >=5.019002
   \1V = 456');
 
 ($d = "789") += 0.1;
index 2091818..ef539d1 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2702,7 +2702,6 @@ PP(pp_entersub)
     }
 
     ENTER;
-    SAVETMPS;
 
   retry:
     if (CvCLONE(cv) && ! CvCLONED(cv))
@@ -2802,12 +2801,18 @@ try_autoload:
            Copy(MARK,AvARRAY(av),items,SV*);
            AvFILLp(av) = items - 1;
        
+           MARK = AvARRAY(av);
            while (items--) {
                if (*MARK)
+               {
+                   if (SvPADTMP(*MARK) && !IS_PADGV(*MARK))
+                       *MARK = sv_mortalcopy(*MARK);
                    SvTEMP_off(*MARK);
+               }
                MARK++;
            }
        }
+       SAVETMPS;
        if ((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO &&
            !CvLVALUE(cv))
            DIE(aTHX_ "Can't modify non-lvalue subroutine call");
@@ -2823,6 +2828,7 @@ try_autoload:
     else {
        I32 markix = TOPMARK;
 
+       SAVETMPS;
        PUTBACK;
 
        if (((PL_op->op_private
index 2835f05..b4d9f37 100644 (file)
@@ -108,8 +108,8 @@ require Config;
 $::TODO = "not fixed yet" if $Config::Config{useithreads};
 is "@scratch", "main road road main",
    'recursive calls do not share shared-hash-key TARGs';
+undef $::TODO;
 
-$::TODO = "not fixed yet";
 # [perl #78194] @_ aliasing op return values
 sub { is \$_[0], \$_[0],
         '[perl #78194] \$_[0] == \$_[0] when @_ aliases "$x"' }
@@ -119,6 +119,7 @@ sub { is \$_[0], \$_[0],
 sub not_constant () {        42 }
 sub not_constantr() { return 42 }
 eval { ${\not_constant}++ };
+$::TODO = "not fixed yet";
 is $@, "", 'sub (){42} returns a mutable value';
 undef $::TODO;
 eval { ${\not_constantr}++ };
index 7074c55..e78fd5e 100644 (file)
@@ -1370,7 +1370,7 @@ no
 no
 ########
 
-# TODO [perl #78194] Passing op return values to tie constructors
+# [perl #78194] Passing op return values to tie constructors
 sub TIEARRAY{
     print \$_[1] == \$_[1] ? "ok\n" : "not ok\n";
 };