[perl #124004] Fix stack bug with foreach(@empty)

The context gets recorded on the context stack when a loop is entered.
That context is then used at loop exit when handling the stack.

In the case of foreach, the context applied to the stack was taken
from the enteriter op.  But the enteriter op was always getting list
context applied.  That meant that foreach(@empty_array){} in scalar
context would push nothing on to the stack, causing a subsequent stack
read to look one item too far to the left, either reading the wrong
thing, or causing a stack underflow (even a crash).  The clearest bug
resulting from it:

$ ./miniperl -le 'push @_, 1, 2, 3, scalar do { for(@x){} } + 1, 4, 5, 6; print "@_"'
1 2 4 4 5 6

instead of 1 2 3 1 4 5 6.

We do need to apply list context to make sure the items iterated over
are evaluated in list context.  But we need to apply it *only* to
those (expr in newFOROP), not the the outer enteriter op.  That op’s
context should be left unset here, so that the calling context will be
applied to it.

This bug goes back at least to perl 5.000.

2 files changed, 12 insertions, 12 deletions

diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t
index 66d2a8ad1e..4f194270ba 100644
--- a/ext/B/t/f_map.t
+++ b/ext/B/t/f_map.t
@@ -165,7 +165,7 @@ checkOptree(note   => q{},
 # c  <1> rv2av[t6] sKRM/1
 # d  <#> gv[*_] s
 # e  <1> rv2gv sKRM/1
-# f  <{> enteriter(next->q last->t redo->g) lKS/DEF
+# f  <{> enteriter(next->q last->t redo->g) KS/DEF
 # r  <0> iter s
 # s  <|> and(other->g) K/1
 # g      <;> nextstate(main 475 (eval 10):1) v:{
@@ -198,7 +198,7 @@ EOT_EOT
 # c  <1> rv2av[t3] sKRM/1
 # d  <$> gv(*_) s
 # e  <1> rv2gv sKRM/1
-# f  <{> enteriter(next->q last->t redo->g) lKS/DEF
+# f  <{> enteriter(next->q last->t redo->g) KS/DEF
 # r  <0> iter s
 # s  <|> and(other->g) K/1
 # g      <;> nextstate(main 559 (eval 15):1) v:{
diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index 9a1127841d..d259bf91a0 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -240,7 +240,7 @@ checkOptree ( name	=> '-exec sub { foreach (1..10) {print "foo $_"} }',
 # 3  <$> const[IV 1] s
 # 4  <$> const[IV 10] s
 # 5  <#> gv[*_] s
-# 6  <{> enteriter(next->d last->g redo->7) lKS/DEF
+# 6  <{> enteriter(next->d last->g redo->7) KS/DEF
 # e  <0> iter s
 # f  <|> and(other->7) K/1
 # 7      <;> nextstate(main 442 optree.t:158) v:>,<,%
@@ -259,7 +259,7 @@ EOT_EOT
 # 3  <$> const(IV 1) s
 # 4  <$> const(IV 10) s
 # 5  <$> gv(*_) s
-# 6  <{> enteriter(next->d last->g redo->7) lKS/DEF
+# 6  <{> enteriter(next->d last->g redo->7) KS/DEF
 # e  <0> iter s
 # f  <|> and(other->7) K/1
 # 7      <;> nextstate(main 443 optree_samples.t:182) v:>,<,%
@@ -283,7 +283,7 @@ checkOptree ( name	=> '-basic sub { print "foo $_" foreach (1..10) }',
 # -     <@> lineseq KP ->g
 # 1        <;> nextstate(main 445 optree.t:167) v:>,<,% ->2
 # f        <2> leaveloop K/2 ->g
-# 6           <{> enteriter(next->c last->f redo->7) lKS/DEF ->d
+# 6           <{> enteriter(next->c last->f redo->7) KS/DEF ->d
 # -              <0> ex-pushmark s ->2
 # -              <1> ex-list lK ->5
 # 2                 <0> pushmark s ->3
@@ -308,7 +308,7 @@ EOT_EOT
 # -     <@> lineseq KP ->g
 # 1        <;> nextstate(main 446 optree_samples.t:192) v:>,<,% ->2
 # f        <2> leaveloop K/2 ->g
-# 6           <{> enteriter(next->c last->f redo->7) lKS/DEF ->d
+# 6           <{> enteriter(next->c last->f redo->7) KS/DEF ->d
 # -              <0> ex-pushmark s ->2
 # -              <1> ex-list lK ->5
 # 2                 <0> pushmark s ->3
@@ -341,7 +341,7 @@ checkOptree ( name	=> '-exec -e foreach (1..10) {print qq{foo $_}}',
 # 4  <$> const[IV 1] s
 # 5  <$> const[IV 10] s
 # 6  <#> gv[*_] s
-# 7  <{> enteriter(next->e last->h redo->8) lKS/DEF
+# 7  <{> enteriter(next->e last->h redo->8) vKS/DEF
 # f  <0> iter s
 # g  <|> and(other->8) vK/1
 # 8      <;> nextstate(main 1 -e:1) v:>,<,%
@@ -361,7 +361,7 @@ EOT_EOT
 # 4  <$> const(IV 1) s
 # 5  <$> const(IV 10) s
 # 6  <$> gv(*_) s
-# 7  <{> enteriter(next->e last->h redo->8) lKS/DEF
+# 7  <{> enteriter(next->e last->h redo->8) vKS/DEF
 # f  <0> iter s
 # g  <|> and(other->8) vK/1
 # 8      <;> nextstate(main 1 -e:1) v:>,<,%
@@ -386,7 +386,7 @@ checkOptree ( name	=> '-exec sub { print "foo $_" foreach (1..10) }',
 # 3  <$> const[IV 1] s
 # 4  <$> const[IV 10] s
 # 5  <#> gv[*_] s
-# 6  <{> enteriter(next->c last->f redo->7) lKS/DEF
+# 6  <{> enteriter(next->c last->f redo->7) KS/DEF
 # d  <0> iter s
 # e  <|> and(other->7) K/1
 # 7      <0> pushmark s
@@ -404,7 +404,7 @@ EOT_EOT
 # 3  <$> const(IV 1) s
 # 4  <$> const(IV 10) s
 # 5  <$> gv(*_) s
-# 6  <{> enteriter(next->c last->f redo->7) lKS/DEF
+# 6  <{> enteriter(next->c last->f redo->7) KS/DEF
 # d  <0> iter s
 # e  <|> and(other->7) K/1
 # 7      <0> pushmark s
@@ -530,7 +530,7 @@ checkOptree ( name	=> '%h=(); for $_(@a){$h{getkey($_)} = $_}',
 # a  <1> rv2av[t6] sKRM/1
 # b  <#> gv[*_] s
 # c  <1> rv2gv sKRM/1
-# d  <{> enteriter(next->o last->r redo->e) lKS/DEF
+# d  <{> enteriter(next->o last->r redo->e) KS/DEF
 # p  <0> iter s
 # q  <|> and(other->e) K/1
 # e      <;> nextstate(main 505 (eval 24):1) v:{
@@ -561,7 +561,7 @@ EOT_EOT
 # a  <1> rv2av[t3] sKRM/1
 # b  <$> gv(*_) s
 # c  <1> rv2gv sKRM/1
-# d  <{> enteriter(next->o last->r redo->e) lKS/DEF
+# d  <{> enteriter(next->o last->r redo->e) KS/DEF
 # p  <0> iter s
 # q  <|> and(other->e) K/1
 # e      <;> nextstate(main 505 (eval 24):1) v:{