use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 6;
use XS::APItest;
is($rrecord->[0], 'affe');
-# peep got called for each root op of the branch
-$::moo = $::moo = 0;
+# A deep-enough nesting of conditionals defeats the deferring mechanism
+# and triggers recursion. Note that this test is sensitive to the details
+# rpeep: the main thing it is testing is that rpeep is called more than
+# peep; the details are less important.
+
+my $code = q[my ($a,$b); $a =];
+$code .= qq{ \$b ? "foo$_" :} for (1..10);
+$code .= qq{ "foo11" };
XS::APItest::peep_enable;
-eval q[my $foo = $::moo ? q/x/ : q/y/];
+eval $code;
XS::APItest::peep_disable;
-is(scalar @{ $record }, 1);
-is(scalar @{ $rrecord }, 2);
-is($record->[0], 'y');
-is($rrecord->[0], 'x');
-is($rrecord->[1], 'y');
+is_deeply($record, [ "foo11" ]);
+is_deeply($rrecord, [ qw(foo1 foo2 foo3 foo4 foo5 foo6 foo11) ]);
return oleft;
}
+#define MAX_DEFERRED 4
+
+#define DEFER(o) \
+ if (defer_ix == (MAX_DEFERRED-1)) { \
+ CALL_RPEEP(defer_queue[defer_base]); \
+ defer_base = (defer_base + 1) % MAX_DEFERRED; \
+ defer_ix--; \
+ } \
+ defer_queue[(defer_base + ++defer_ix) % MAX_DEFERRED] = o;
+
/* A peephole optimizer. We visit the ops in the order they're to execute.
* See the comments at the top of this file for more details about when
* peep() is called */
{
dVAR;
register OP* oldop = NULL;
+ OP* defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
+ int defer_base = 0;
+ int defer_ix = -1;
if (!o || o->op_opt)
return;
ENTER;
SAVEOP();
SAVEVPTR(PL_curcop);
- for (; o; o = o->op_next) {
+ for (;; o = o->op_next) {
+ if (o && o->op_opt)
+ o = NULL;
+ while (!o) {
+ if (defer_ix < 0)
+ break;
+ o = defer_queue[(defer_base + defer_ix--) % MAX_DEFERRED];
+ oldop = NULL;
+ }
+ if (!o)
+ break;
+
#if defined(PERL_MAD) && defined(USE_ITHREADS)
MADPROP *mp = o->op_madprop;
while (mp) {
mp = mp->mad_next;
}
#endif
- if (o->op_opt)
- break;
/* By default, this op has now been optimised. A couple of cases below
clear this again. */
o->op_opt = 1;
sop = fop->op_sibling;
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
- CALL_RPEEP(cLOGOP->op_other);
+ DEFER(cLOGOP->op_other);
stitch_keys:
o->op_opt = 1;
case OP_ONCE:
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
- CALL_RPEEP(cLOGOP->op_other);
+ DEFER(cLOGOP->op_other);
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
- CALL_RPEEP(cLOOP->op_redoop);
while (cLOOP->op_nextop->op_type == OP_NULL)
cLOOP->op_nextop = cLOOP->op_nextop->op_next;
- CALL_RPEEP(cLOOP->op_nextop);
while (cLOOP->op_lastop->op_type == OP_NULL)
cLOOP->op_lastop = cLOOP->op_lastop->op_next;
- CALL_RPEEP(cLOOP->op_lastop);
+ /* a while(1) loop doesn't have an op_next that escapes the
+ * loop, so we have to explicitly follow the op_lastop to
+ * process the rest of the code */
+ DEFER(cLOOP->op_lastop);
break;
case OP_SUBST:
cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
cPMOP->op_pmstashstartu.op_pmreplstart
= cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
- CALL_RPEEP(cPMOP->op_pmstashstartu.op_pmreplstart);
+ DEFER(cPMOP->op_pmstashstartu.op_pmreplstart);
break;
case OP_EXEC:
use strict 'subs' ;
my @a = (A..Z);
EXPECT
-Bareword "Z" not allowed while "strict subs" in use at - line 4.
Bareword "A" not allowed while "strict subs" in use at - line 4.
+Bareword "Z" not allowed while "strict subs" in use at - line 4.
Execution of - aborted due to compilation errors.
########
use strict 'subs' ;
my $a = (B..Y);
EXPECT
-Bareword "Y" not allowed while "strict subs" in use at - line 4.
Bareword "B" not allowed while "strict subs" in use at - line 4.
+Bareword "Y" not allowed while "strict subs" in use at - line 4.
Execution of - aborted due to compilation errors.
########
skip_all_without_config('useithreads');
skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
- plan(24);
+ plan(25);
}
use strict;
EOI
+# make sure peephole optimiser doesn't recurse heavily.
+# (We run this inside a thread to get a small stack)
+
+{
+ # lots of constructs that have o->op_other etc
+ my $code = <<'EOF';
+ $r = $x || $y;
+ $x ||= $y;
+ $r = $x // $y;
+ $x //= $y;
+ $r = $x && $y;
+ $x &&= $y;
+ $r = $x ? $y : $z;
+ $r = $x ? "x" : $x ? "x" : $x ? "x" : $x ? "x" : $x ? "x" : $x ? "x"
+ : $x ? "x" : $x ? "x" : $x ? "x" : $x ? "x" : $x ? "x" : "y";
+ @a = map $x+1, @a;
+ @a = grep $x+1, @a;
+ $r = /$x/../$y/;
+ while (1) { $x = 0 };
+ while (0) { $x = 0 };
+ for ($x=0; $y; $z=0) { $r = 0 };
+ for (1) { $x = 0 };
+ { $x = 0 };
+ $x =~ s/a/$x + 1/e;
+EOF
+ $code = 'my ($r, $x,$y,$z,@a); return 5; ' . ($code x 5000);
+ my $res = threads->create(sub { eval $code})->join;
+ is($res, 5, "avoid peephole recursion");
+}
+
+
# [perl #78494] Pipes shared between threads block when closed
watchdog 10;
{