In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/a01f4640266aacbed7ecc9df01890abb555c69b2?hp=436908e565f0e613465123e7cb08fa54487c3b8f>
- Log -----------------------------------------------------------------
commit a01f4640266aacbed7ecc9df01890abb555c69b2
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 07:07:07 2017 -0800
[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.
commit e7afb05e35570e271ae017d47b64dd5aad3e2009
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Dec 6 13:55:26 2017 -0800
Explicitly test goto-into-foreach
It is already tested in t/op/goto.t, but only as part of an existing
test to see which of multiple identical labels gets chosen.
commit b537774295099f6b543a9e2b7375f72593328389
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Dec 6 13:44:32 2017 -0800
pp_ctl.c: Move goto-into-foreach error
Put it in a static function, instead of repeating the code. This way I
can add more conditions to that code in subsequent commits.
-----------------------------------------------------------------------
Summary of changes:
pod/perldelta.pod | 5 ++++-
pod/perldiag.pod | 5 +++++
pod/perlfunc.pod | 3 ++-
pp_ctl.c | 25 ++++++++++++++++++-------
t/lib/croak/pp_ctl | 22 ++++++++++++++++++++++
5 files changed, 51 insertions(+), 9 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 4026d4d579..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)
@@ -2709,6 +2710,20 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN
len, U32 flags, OP **opstac
}
+static void
+S_check_op_type(pTHX_ OP * const o)
+{
+ /* Eventually we may want to stack the needed arguments
+ * for each op. For now, we punt on the hard ones. */
+ /* XXX This comment seems to me like wishful thinking. --sprout */
+ 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() */
PP(pp_goto)
@@ -3050,8 +3065,7 @@ PP(pp_goto)
if (leaving_eval && *enterops && enterops[1]) {
I32 i;
for (i = 1; enterops[i]; i++)
- if (enterops[i]->op_type == OP_ENTERITER)
- DIE(aTHX_ "Can't \"goto\" into the middle of a foreach
loop");
+ S_check_op_type(aTHX_ enterops[i]);
}
if (*enterops && enterops[1]) {
@@ -3077,10 +3091,7 @@ PP(pp_goto)
ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
for (; enterops[ix]; ix++) {
PL_op = enterops[ix];
- /* Eventually we may want to stack the needed arguments
- * for each op. For now, we punt on the hard ones. */
- if (PL_op->op_type == OP_ENTERITER)
- DIE(aTHX_ "Can't \"goto\" into the middle of a foreach
loop");
+ S_check_op_type(aTHX_ PL_op);
PL_op->op_ppaddr(aTHX);
}
PL_op = oldop;
diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
index ec664138e0..2943bf7551 100644
--- a/t/lib/croak/pp_ctl
+++ b/t/lib/croak/pp_ctl
@@ -1,4 +1,26 @@
__END__
+# NAME goto into foreach
+no warnings 'deprecated';
+goto f;
+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";
--
Perl5 Master Repository
