In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/0d42e778cfa0ef9c7315b82e62a6c9fe0cb1cec5?hp=47d3b731f074752fe0862ffdf333cfd3935f793a>
- Log -----------------------------------------------------------------
commit 0d42e778cfa0ef9c7315b82e62a6c9fe0cb1cec5
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Oct 16 17:44:56 2014 -0700
[perl #122995] Hang with while(1) in a sub-list
It was hanging at compile time in some cases, e.g.:
sub foo { () = ($a, my $b, ($c, do { while(1) {} })) }
The optimisation added in 5.20 to turn list+pushmark into null ops
when they are in list context (effectively making ($a,($b,$c)) equiva-
lent to ($a,$b,$c) with regard to which ops are executed) followed
op_next pointers to find the last op that was a kid of the sublist.
You canât just follow op_next pointers like that, because it will loop
at compile time on infinite loops like while (1){}.
In this case, the last kid was being found in order to elide the erst-
while list op from the op_next chain, but that is not necessary, since
later OP_NULL handling takes care of it anyway.
M op.c
M t/op/list.t
commit 0298c7603f0a7ee6e46fc9ebc8283c40ee2f6ad4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Oct 16 16:18:59 2014 -0700
Improve void varop optimisation
After eliding the varop, the optimisation added in 5afbd733 repro-
cesses the previous op if it is a nextstate op. But it was doing this
by setting the current op to the one before the nextstate, so that the
o=o->op_next in the loop header would cause it to reprocess the next-
state in the next iteration. So, if that nextstate op were at the
beginning of a subroutine, the optimisation would be skipped, and this
would still execute two nextstate ops in a row:
sub foo {
our($a, $b);
die;
}
So, instead, just use âgotoâ to reprocess the op, and we can do it
even if there is no op before the nextstate.
M lib/B/Deparse.t
M op.c
M t/op/opt.t
-----------------------------------------------------------------------
Summary of changes:
lib/B/Deparse.t | 2 +-
op.c | 17 +++++------------
t/op/list.t | 4 ++++
t/op/opt.t | 9 ++++++++-
4 files changed, 18 insertions(+), 14 deletions(-)
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 52e0084..7a0c4d9 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -1470,9 +1470,9 @@ my($m7, undef, $m8) = (1, 2, 3);
($m7, undef, $m8) = (1, 2, 3);
####
# 'our/local' works with padrange op
-no strict;
our($z, @z);
our $o1;
+no strict;
local $o11;
$o1 = 1;
local $o1 = 1;
diff --git a/op.c b/op.c
index 9fd1d09..0501187 100644
--- a/op.c
+++ b/op.c
@@ -11658,19 +11658,11 @@ S_inplace_aassign(pTHX_ OP *o) {
STATIC void
S_null_listop_in_list_context(pTHX_ OP *o)
{
- OP *kid;
-
PERL_ARGS_ASSERT_NULL_LISTOP_IN_LIST_CONTEXT;
/* This is an OP_LIST in list (or void) context. That means we
* can ditch the OP_LIST and the OP_PUSHMARK within. */
- kid = cLISTOPo->op_first;
- /* Find the end of the chain of OPs executed within the OP_LIST. */
- while (kid->op_next != o)
- kid = kid->op_next;
-
- kid->op_next = o->op_next; /* patch list out of exec chain */
op_null(cUNOPo->op_first); /* NULL the pushmark */
op_null(o); /* NULL the list */
}
@@ -11709,6 +11701,7 @@ Perl_rpeep(pTHX_ OP *o)
break;
}
+ redo:
/* By default, this op has now been optimised. A couple of cases below
clear this again. */
o->op_opt = 1;
@@ -12238,12 +12231,12 @@ Perl_rpeep(pTHX_ OP *o)
oldop->op_next = o->op_next->op_next;
/* Reprocess the previous op if it is a nextstate, to
allow double-nextstate optimisation. */
- if (oldop->op_type == OP_NEXTSTATE && oldoldop
- && oldoldop->op_next == oldop) {
+ if (oldop->op_type == OP_NEXTSTATE) {
oldop->op_opt = 0;
- o = oldop = oldoldop;
+ o = oldop;
+ oldop = oldoldop;
oldoldop = NULL;
- continue;
+ goto redo;
}
o = oldop;
}
diff --git a/t/op/list.t b/t/op/list.t
index d14873f..3f42e6d 100644
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -190,3 +190,7 @@ sub {
)
}
->(("${\''}")[0,0]);
+
+# [perl #122995] Hang when compiling while(1) in a sub-list
+# No ok() or is() necessary.
+sub foo { () = ($a, my $b, ($c, do { while(1) {} })) }
diff --git a/t/op/opt.t b/t/op/opt.t
index aa73fd7..50eff6d 100644
--- a/t/op/opt.t
+++ b/t/op/opt.t
@@ -9,7 +9,7 @@ BEGIN {
@INC = '../lib';
}
-plan 20;
+plan 21;
use B qw 'svref_2object OPpASSIGN_COMMON';
@@ -62,6 +62,13 @@ is svref_2object(sub { 0;0;0;0;0;0;time
})->START->next->name, 'time',
'multiple nextstates become one';
+# rv2[ahs]v in void context
+
+is svref_2object(sub { our($foo,@fit,%far); our $bar; our($a,$b); time })
+ ->START->next->name, 'time',
+ 'rv2[ahs]v in void context';
+
+
# split to array
for(['@pkgary' , '@_' ],
--
Perl5 Master Repository
