This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #78194] Make grep/map copy pad tmps
authorFather Chrysostomos <sprout@cpan.org>
Thu, 20 Jun 2013 13:04:59 +0000 (06:04 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:47:59 +0000 (23:47 -0700)
before aliasing them to $_.

And make sure the copies go back on the stack for grep, since modi-
fying $_ in the grep block or expression is supposed to modify the
item returned.

pp_ctl.c
pp_hot.c
t/op/grep.t

index d611c4c..17121be 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -993,6 +993,10 @@ PP(pp_grepstart)
     SAVEVPTR(PL_curpm);
 
     src = PL_stack_base[*PL_markstack_ptr];
+    if (SvPADTMP(src) && !IS_PADGV(src)) {
+       src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+       PL_tmps_floor++;
+    }
     SvTEMP_off(src);
     if (PL_op->op_private & OPpGREP_LEX)
        PAD_SVl(PL_op->op_targ) = src;
@@ -1141,6 +1145,7 @@ PP(pp_mapwhile)
 
        /* set $_ to the new source item */
        src = PL_stack_base[PL_markstack_ptr[-1]];
+       if (SvPADTMP(src) && !IS_PADGV(src)) src = sv_mortalcopy(src);
        SvTEMP_off(src);
        if (PL_op->op_private & OPpGREP_LEX)
            PAD_SVl(PL_op->op_targ) = src;
index 914a9d7..2091818 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2553,6 +2553,10 @@ PP(pp_grepwhile)
        SAVEVPTR(PL_curpm);
 
        src = PL_stack_base[*PL_markstack_ptr];
+       if (SvPADTMP(src) && !IS_PADGV(src)) {
+           src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+           PL_tmps_floor++;
+       }
        SvTEMP_off(src);
        if (PL_op->op_private & OPpGREP_LEX)
            PAD_SVl(PL_op->op_targ) = src;
index d533aa8..d34686d 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan( tests => 64 );
+plan( tests => 66 );
 
 {
     my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
@@ -216,12 +216,10 @@ plan( tests => 64 );
 }
 
 # [perl #78194] grep/map aliasing op return values
-{ local $::TODO = ' ';
 grep is(\$_, \$_, '[perl #78194] \$_ == \$_ inside grep ..., "$x"'),
-     "${\''}";
+     "${\''}", "${\''}";
 map is(\$_, \$_, '[perl #78194] \$_ == \$_ inside map ..., "$x"'),
-     "${\''}";
-}
+     "${\''}", "${\''}";
 
 # [perl #92254] freeing $_ in gremap block
 {