make "when" do implicit "next"

A "when" construct, upon reaching the end of its conditionally-executed
block, used to perform an implicit jump to the end of the enclosing
topicalizer, defined as either a "given" block or a "foreach" operating
on $_.  Change it to jump to the enclosing loop of any kind (which now
includes "given" blocks).

9 files changed, 53 insertions, 63 deletions

diff --git a/embed.fnc b/embed.fnc
index 82e8370a1d..4f685e8ee8 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2227,7 +2227,6 @@ sR	|OP*	|dofindlabel	|NN OP *o|NN const char *label|STRLEN len \
 s	|MAGIC *|doparseform	|NN SV *sv
 snR	|bool	|num_overflow	|NV value|I32 fldsize|I32 frcsize
 sR	|I32	|dopoptoeval	|I32 startingblock
-sR	|I32	|dopoptogivenfor|I32 startingblock
 sR	|I32	|dopoptolabel	|NN const char *label|STRLEN len|U32 flags
 sR	|I32	|dopoptoloop	|I32 startingblock
 sR	|I32	|dopoptosub_at	|NN const PERL_CONTEXT* cxstk|I32 startingblock
diff --git a/embed.h b/embed.h
index 5e82a0f832..603a0a26d5 100644
--- a/embed.h
+++ b/embed.h
@@ -1716,7 +1716,6 @@
 #define dofindlabel(a,b,c,d,e,f)	S_dofindlabel(aTHX_ a,b,c,d,e,f)
 #define doparseform(a)		S_doparseform(aTHX_ a)
 #define dopoptoeval(a)		S_dopoptoeval(aTHX_ a)
-#define dopoptogivenfor(a)	S_dopoptogivenfor(aTHX_ a)
 #define dopoptolabel(a,b,c)	S_dopoptolabel(aTHX_ a,b,c)
 #define dopoptoloop(a)		S_dopoptoloop(aTHX_ a)
 #define dopoptosub_at(a,b)	S_dopoptosub_at(aTHX_ a,b)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index a9a503e16d..005147536f 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1076,6 +1076,16 @@ usually double the curlies to get the same effect though, because the
 inner curlies will be considered a block that loops once.  See
 L<perlfunc/last>.
 
+=item Can't leave "when" outside a loop
+
+(F) Control reached the end of a C<when> block that isn't inside any
+loop (including a C<given> block).  An implicit C<next> occurs here,
+which requires a loop to jump to.  You probably wanted the C<when> to be
+inside a C<given> block.  Note that you won't get this error if the match
+controlling the C<when> fails, or if you use an explicit C<continue> to
+avoid reaching the end of the block.  But if you rely on not reaching the
+implicit C<next> then you probably didn't want C<when>, but rather C<if>.
+
 =item Can't linearize anonymous symbol table
 
 (F) Perl tried to calculate the method resolution order (MRO) of a
@@ -1536,13 +1546,6 @@ references can be unweakened.
 (F) You attempted to weaken something that was not a reference.  Only
 references can be weakened.
 
-=item Can't "when" outside a topicalizer
-
-(F) You have used a C<when> block that is neither inside a C<foreach>
-loop nor a C<given> block.  (Note that this error is issued on exit
-from the C<when> block, so you won't get the error if the match fails,
-or if you use an explicit C<continue>.)
-
 =item Can't x= to read-only value
 
 (F) You tried to repeat a constant value (often the undefined value)
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index d55bf2e6a7..c7375aa1f8 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -1318,9 +1318,8 @@ using an empty one, logically enough, so L<C<next>|/next LABEL> goes
 directly back to check the condition at the top of the loop.
 
 When there is no BLOCK, L<C<continue>|/continue BLOCK> is a function
-that exits the current C<when> block, avoiding the jump
-to the end of the enclosing topicalizer that implicitly happens when
-execution reaches the end of such a block.
+that exits the current C<when> block, avoiding the implicit C<next>
+that happens when execution reaches the end of such a block.
 In Perl 5.14 and earlier, this form of
 L<C<continue>|/continue BLOCK> was only available when the
 L<C<"switch"> feature|feature/The 'switch' feature> was enabled.  See
diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod
index 9febd729a4..06338303db 100644
--- a/pod/perlsyn.pod
+++ b/pod/perlsyn.pod
@@ -218,7 +218,7 @@ declaration, or a declaration that implies it.  It behaves like the full
 C<when> statement with block, described in L</"Switch Statements"> below.
 It executes the statement only if the I<EXPR> is true.  If the statement
 executes, control then implicitly jumps to the end of the dynamically
-enclosing C<foreach> or C<given> block.
+enclosing loop (usually a C<given> block).
 
 =head2 Compound Statements
 X<statement, compound> X<block> X<bracket, curly> X<curly bracket> X<brace>
@@ -589,8 +589,8 @@ The BLOCK construct can be used to emulate case structures.
         $nothing = 1;
     }
 
-You'll also find that C<foreach> loop used to create a topicalizer
-and a switch:
+You'll also find the C<foreach> loop used to establish a topic for
+a switch:
 
     SWITCH:
     for ($var) {
@@ -642,17 +642,12 @@ exactly one item to iterate over.
 A C<given> construct even counts as a one-iteration loop for the purposes
 of loop control, so the C<redo> operator can be used to restart its block,
 and C<next> or C<last> can be used to exit the block early.
-Either a C<given> or a C<foreach>
-construct serves as a I<topicalizer>: C<when> can only
-be used in the dynamic scope of a topicalizer.
 
 C<when> evaluates its argument as a truth value.  If the argument
 was false then it does not execute its block, and proceeds to the
 following statement.  If the argument was true, it executes the block,
-then implicitly jumps to the end of the closest dynamically enclosing
-topicalizer.  (In the case of a C<foreach> topicalizer, this jump
-behaves as a C<next>, moving on to the next iteration, not a C<last>,
-which would exit the loop.)
+then implicitly performs a C<next>, jumping to the end of the closest
+dynamically enclosing C<given> block or other kind of loop.
 
 Putting this together, the code in the previous section could be
 rewritten as
@@ -678,8 +673,8 @@ less punctuation as
 
 You can use the C<continue> keyword to exit a C<when>
 block, proceeding to the following statement.  This is most commonly
-done last thing inside the block, to override the implicit jump to the
-end of the topicalizer.  For example
+done last thing inside the block, to override the implicit C<next>.
+For example
 
     given($foo) {
         when (/x/) { say '$foo contains an x'; continue }
diff --git a/pp_ctl.c b/pp_ctl.c
index 37ffb0edb9..9e21fde1fb 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1482,36 +1482,6 @@ S_dopoptoloop(pTHX_ I32 startingblock)
     return i;
 }
 
-/* find the next GIVEN or FOR (with implicit $_) loop context block */
-
-STATIC I32
-S_dopoptogivenfor(pTHX_ I32 startingblock)
-{
-    I32 i;
-    for (i = startingblock; i >= 0; i--) {
-	const PERL_CONTEXT *cx = &cxstack[i];
-	switch (CxTYPE(cx)) {
-	default:
-	    continue;
-	case CXt_LOOP_GIVEN:
-	    DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found given at cx=%ld)\n", (long)i));
-	    return i;
-	case CXt_LOOP_PLAIN:
-            assert(!(cx->cx_type & CXp_FOR_DEF));
-	    break;
-	case CXt_LOOP_LAZYIV:
-	case CXt_LOOP_LAZYSV:
-	case CXt_LOOP_LIST:
-	case CXt_LOOP_ARY:
-            if (cx->cx_type & CXp_FOR_DEF) {
-		DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found foreach at cx=%ld)\n", (long)i));
-		return i;
-	    }
-	}
-    }
-    return i;
-}
-
 STATIC I32
 S_dopoptowhen(pTHX_ I32 startingblock)
 {
@@ -4683,9 +4653,9 @@ PP(pp_leavewhen)
     assert(CxTYPE(cx) == CXt_WHEN);
     gimme = cx->blk_gimme;
 
-    cxix = dopoptogivenfor(cxstack_ix);
+    cxix = dopoptoloop(cxstack_ix);
     if (cxix < 0)
-	DIE(aTHX_ "Can't \"when\" outside a topicalizer");
+	DIE(aTHX_ "Can't leave \"when\" outside a loop");
 
     oldsp = PL_stack_base + cx->blk_oldsp;
     if (gimme == G_VOID)
@@ -4693,18 +4663,19 @@ PP(pp_leavewhen)
     else
         leave_adjust_stacks(oldsp, oldsp, gimme, 1);
 
-    /* pop the WHEN, BLOCK and anything else before the GIVEN/FOR */
+    /* pop the WHEN, BLOCK and anything else before the loop */
     assert(cxix < cxstack_ix);
     dounwind(cxix);
 
     cx = &cxstack[cxix];
 
-    if (CxFOREACH(cx)) {
+    if (CxTYPE(cx) != CXt_LOOP_GIVEN) {
         /* emulate pp_next. Note that any stack(s) cleanup will be
          * done by the pp_unstack which op_nextop should point to */
         cx = CX_CUR();
 	cx_topblock(cx);
 	PL_curcop = cx->blk_oldcop;
+	PERL_ASYNC_CHECK();
 	return cx->blk_loop.my_op->op_nextop;
     }
     else {
diff --git a/proto.h b/proto.h
index d87aaa77fc..7234a18b07 100644
--- a/proto.h
+++ b/proto.h
@@ -4898,9 +4898,6 @@ STATIC MAGIC *	S_doparseform(pTHX_ SV *sv);
 STATIC I32	S_dopoptoeval(pTHX_ I32 startingblock)
 			__attribute__warn_unused_result__;
 
-STATIC I32	S_dopoptogivenfor(pTHX_ I32 startingblock)
-			__attribute__warn_unused_result__;
-
 STATIC I32	S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_DOPOPTOLABEL	\
diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
index fb81c0a931..09332551ef 100644
--- a/t/lib/croak/pp_ctl
+++ b/t/lib/croak/pp_ctl
@@ -10,4 +10,4 @@ Can't find label foo at - line 3.
 use 5.01; no warnings 'experimental::smartmatch';
 when(!defined){}
 EXPECT
-Can't "when" outside a topicalizer at - line 2.
+Can't leave "when" outside a loop at - line 2.
diff --git a/t/op/when.t b/t/op/when.t
index 62f0bcd14d..2721b7623d 100644
--- a/t/op/when.t
+++ b/t/op/when.t
@@ -10,7 +10,7 @@ use strict;
 use warnings;
 no warnings 'experimental::smartmatch';
 
-plan tests => 39;
+plan tests => 42;
 
 foreach(3) {
     CORE::when(3) {
@@ -177,4 +177,31 @@ foreach(3) {
     pass;
 }
 
+foreach my $z (3) {
+    when(1) { pass; }
+    fail;
+}
+
+my @a = qw(x y z);
+my $act = "";
+while(@a) {
+    $act .= "[a@{[0+@a]}]";
+    when(shift(@a) eq "y") {
+	$act .= "[b]";
+    }
+    $act .= "[c]";
+}
+is $act, "[a3][c][a2][b][a1][c]";
+
+$act = "";
+{
+    $act .= "[a]";
+    when(0) { $act .= "[b]"; }
+    $act .= "[c]";
+    when(1) { $act .= "[d]"; }
+    $act .= "[e]";
+    when(1) { $act .= "[f]"; }
+}
+is $act, "[a][c][d]";
+
 1;