[perl #78194] Make foreach copy pad tmps

before aliasing them to $_.

This caused one to-do test in sub.t to pass, but the bug it is testing
for has not been fixed, so I added another one.  I didn’t remove the
to-do test that started passing, because it is still a good test to
have (the only test we have for interactions betwen foreach, shared
hash keys, and recursion).

diff --git a/pp_hot.c b/pp_hot.c
index ef539d1..f3ed6d5 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2022,8 +2022,12 @@ PP(pp_iter)
                 *itersvp = NULL;
                 Perl_croak(aTHX_ "Use of freed value in iteration");
             }
-            SvTEMP_off(sv);
-            SvREFCNT_inc_simple_void_NN(sv);
+            if (SvPADTMP(sv) && !IS_PADGV(sv))
+                sv = newSVsv(sv);
+            else {
+                SvTEMP_off(sv);
+                SvREFCNT_inc_simple_void_NN(sv);
+            }
         }
         else
             sv = &PL_sv_undef;

diff --git a/t/cmd/for.t b/t/cmd/for.t
index e187f7f..f53cecc 100644 (file)
--- a/t/cmd/for.t
+++ b/t/cmd/for.t
@@ -99,5 +99,5 @@ print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n";
 for ("${\''}") {
     print "not " unless \$_ == \$_;
     print 'ok 15 - [perl \#78194] \$_ == \$_ inside for("$x"){...}',
-          " # TODO \n";
+          "\n";
 }

diff --git a/t/op/sub.t b/t/op/sub.t
index b4d9f37..a160d46 100644 (file)
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 20 );
+plan( tests => 21 );
 
 sub empty_sub {}
 
@@ -105,9 +105,22 @@ sub a {
 }
 a(__PACKAGE__);
 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';
+
+# Another test for the same bug, that does not rely on foreach.  It depends
+# on ref returning a shared hash key TARG.
+undef @scratch;
+sub b {
+    my ($pack, $depth) = @_;
+    my $o = bless[], $pack;
+    $pack++;
+    push @scratch, (ref $o, $depth||b($pack,$depth+1))[0];
+}
+b('n',0);
+$::TODO = "not fixed yet" if $Config::Config{useithreads};
+is "@scratch", "o n", 
+   'recursive calls do not share shared-hash-key TARGs (2)';
 undef $::TODO;
 
 # [perl #78194] @_ aliasing op return values