[perl #74764] Forbid ‘goto’ jumping into ‘given’

It does not make sense to jump into a ‘given’ any more than it makes
sense to jump into ‘foreach’, which has long been forbidden, since
there is no value to turn into a topic.  Up till now this construct
has always crashed.

5 files changed, 31 insertions, 3 deletions

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 21c855a0c8..5cf9d5e3fc 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -212,7 +212,10 @@ and New Warnings
 
 =item *
 
-XXX L<message|perldiag/"message">
+L<Can't "goto" into a "given" block|perldiag/"Can't E<quot>gotoE<quot> into a E<quot>givenE<quot> block">
+
+(F) A "goto" statement was executed to jump into the middle of a C<given>
+block.  You can't get there from here.  See L<perlfunc/goto>.
 
 =back
 
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 77726f54a1..d18baa8a39 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1031,6 +1031,11 @@ pipe, Perl can't retrieve its name for later use.
 (P) An error peculiar to VMS.  Perl asked $GETSYI how big you want your
 mailbox buffers to be, and didn't get an answer.
 
+=item Can't "goto" into a "given" block
+
+(F) A "goto" statement was executed to jump into the middle of a C<given>
+block.  You can't get there from here.  See L<perlfunc/goto>.
+
 =item Can't "goto" into the middle of a foreach loop
 
 (F) A "goto" statement was executed to jump into the middle of a foreach
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 32f0e64f2c..8e3a9079b5 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3400,7 +3400,8 @@ assignment.
 Use of C<goto LABEL> or C<goto EXPR> to jump into a construct is
 deprecated and will issue a warning.  Even then, it may not be used to
 go into any construct that requires initialization, such as a
-subroutine or a C<foreach> loop.  It also can't be used to go into a
+subroutine, a C<foreach> loop, or a C<given>
+block.  It also can't be used to go into a
 construct that is optimized away.
 
 The C<goto &NAME> form is quite different from the other forms of
diff --git a/pp_ctl.c b/pp_ctl.c
index f5ae9e3b96..9ff2abecd3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2658,7 +2658,8 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
 	o->op_type == OP_SCOPE ||
 	o->op_type == OP_LEAVELOOP ||
 	o->op_type == OP_LEAVESUB ||
-	o->op_type == OP_LEAVETRY)
+	o->op_type == OP_LEAVETRY ||
+	o->op_type == OP_LEAVEGIVEN)
     {
 	*ops++ = cUNOPo->op_first;
 	if (ops >= oplimit)
@@ -2718,6 +2719,9 @@ S_check_op_type(pTHX_ OP * const o)
     if (o->op_type == OP_ENTERITER)
         Perl_croak(aTHX_
                   "Can't \"goto\" into the middle of a foreach loop");
+    if (o->op_type == OP_ENTERGIVEN)
+        Perl_croak(aTHX_
+                  "Can't \"goto\" into a \"given\" block");
 }
 
 /* also used for: pp_dump() */
diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
index 42319ff2e8..2943bf7551 100644
--- a/t/lib/croak/pp_ctl
+++ b/t/lib/croak/pp_ctl
@@ -6,6 +6,21 @@ foreach(1){f:}
 EXPECT
 Can't "goto" into the middle of a foreach loop at - line 3.
 ########
+# NAME goto into given
+no warnings 'deprecated';
+goto f;
+CORE::given(1){f:}
+EXPECT
+given is experimental at - line 3.
+Can't "goto" into a "given" block at - line 3.
+########
+# NAME goto from given topic expression
+no warnings 'deprecated';
+CORE::given(goto f){f:}
+EXPECT
+given is experimental at - line 2.
+Can't "goto" into a "given" block at - line 2.
+########
 # NAME dump with computed label
 no warnings 'deprecated';
 my $label = "foo";