Front page | perl.perl5.porters |
Postings from April 2012
Re: perl 5.14.2 bug?
Thread Previous
|
Thread Next
From:
Nicholas Clark
Date:
April 14, 2012 07:05
Subject:
Re: perl 5.14.2 bug?
Message ID:
20120414140542.GG9069@plum.flirble.org
On Wed, Apr 04, 2012 at 04:00:46PM +0100, Nicholas Clark wrote:
> On Wed, Apr 04, 2012 at 03:45:28PM +0100, Nicholas Clark wrote:
>
>
> > which looks plausible. I'd guess the question is which of the
> > C<PERL_ASYNC_CHECK();>s that that commit added isn't actually safe, and
> > why not. My hunch is that some pattern match variable in the interpreter
>
> I'm now not quite sure it's as binary as that.
I've pushed the appended commit to a smoke-me branch. It fixes the panic
testcase for me. I *think* that it's the correct fix. If it is good, it
should also be considered for inclusion in 5.14.3
Nicholas Clark
commit a155d3f9f6244e11e535e96a11fb038d44b8b1aa
Author: Nicholas Clark <nick@ccl4.org>
Date: Sat Apr 14 15:51:33 2012 +0200
Remove PERL_ASYNC_CHECK() from Perl_leave_scope().
PERL_ASYNC_CHECK() was added to Perl_leave_scope() as part of commit
f410a2119920dd04, which moved signal dispatch from the runloop to control
flop ops, to mitigate nearly all of the speed cost of safe signals.
The assumption was that scope exit was a safe place to dispatch signals.
However, this is not true, as parts of the regex engine call leave_scope(),
the regex engine stores some state in per-interpreter variables, and code
called within signal handlers can change these values.
Hence remove the call to PERL_ASYNC_CHECK() from Perl_leave_scope(), and add
it explicitly in the various OPs which were relying on their call to
leave_scope() to dispatch any pending signals. Also add a PERL_ASYNC_CHECK()
to the exit of the runloop, which ensures signals still dispatch from
S_sortcv() and S_sortcv_stacked(), as well as addressing one of the concerns
in the commit message of f410a2119920dd04:
Subtle bugs might remain - there might be constructions that enter the
runloop (where signals used to be dispatched) but don't contain any
PERL_ASYNC_CHECK() calls themselves.
Finally, move the PERL_ASYNC_CHECK(); added by that commit to pp_goto to
the end of the function, to be consistent with the positioning of all other
PERL_ASYNC_CHECK() calls - at the beginning or end of OP functions, hence
just before the return to or just after the call from the runloop, and hence
effectively at the same point as the previous location of PERL_ASYNC_CHECK()
in the runloop.
diff --git a/dump.c b/dump.c
index b238ee0..d770a65 100644
--- a/dump.c
+++ b/dump.c
@@ -2118,6 +2118,7 @@ Perl_runops_debug(pTHX)
}
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
+ PERL_ASYNC_CHECK();
TAINT_NOT;
return 0;
diff --git a/pp_ctl.c b/pp_ctl.c
index 8f4c103..9c2f105 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -377,6 +377,7 @@ PP(pp_substcont)
TAINT_NOT;
LEAVE_SCOPE(cx->sb_oldsave);
POPSUBST(cx);
+ PERL_ASYNC_CHECK();
RETURNOP(pm->op_next);
/* NOTREACHED */
}
@@ -2721,6 +2722,7 @@ PP(pp_next)
if (PL_scopestack_ix < inner)
leave_scope(PL_scopestack[PL_scopestack_ix]);
PL_curcop = cx->blk_oldcop;
+ PERL_ASYNC_CHECK();
return (cx)->blk_loop.my_op->op_nextop;
}
@@ -2763,6 +2765,7 @@ PP(pp_redo)
LEAVE_SCOPE(oldsave);
FREETMPS;
PL_curcop = cx->blk_oldcop;
+ PERL_ASYNC_CHECK();
return redo_op;
}
@@ -2967,6 +2970,7 @@ PP(pp_goto)
PUTBACK;
(void)(*CvXSUB(cv))(aTHX_ cv);
LEAVE;
+ PERL_ASYNC_CHECK();
return retop;
}
else {
@@ -3038,6 +3042,7 @@ PP(pp_goto)
}
}
}
+ PERL_ASYNC_CHECK();
RETURNOP(CvSTART(cv));
}
}
@@ -3058,8 +3063,6 @@ PP(pp_goto)
label_len = strlen(label);
}
- PERL_ASYNC_CHECK();
-
if (label && *label) {
OP *gotoprobe = NULL;
bool leaving_eval = FALSE;
@@ -3198,6 +3201,7 @@ PP(pp_goto)
PL_do_undump = FALSE;
}
+ PERL_ASYNC_CHECK();
RETURNOP(retop);
}
@@ -5117,10 +5121,13 @@ PP(pp_leavewhen)
leave_scope(PL_scopestack[PL_scopestack_ix]);
PL_curcop = cx->blk_oldcop;
+ PERL_ASYNC_CHECK();
return cx->blk_loop.my_op->op_nextop;
}
- else
+ else {
+ PERL_ASYNC_CHECK();
RETURNOP(cx->blk_givwhen.leave_op);
+ }
}
PP(pp_continue)
diff --git a/run.c b/run.c
index 7c1d0aa..774852d 100644
--- a/run.c
+++ b/run.c
@@ -40,6 +40,7 @@ Perl_runops_standard(pTHX)
register OP *op = PL_op;
while ((PL_op = op = op->op_ppaddr(aTHX))) {
}
+ PERL_ASYNC_CHECK();
TAINT_NOT;
return 0;
diff --git a/scope.c b/scope.c
index 1bf79e0..c74594a 100644
--- a/scope.c
+++ b/scope.c
@@ -1166,8 +1166,6 @@ Perl_leave_scope(pTHX_ I32 base)
}
PL_tainted = was;
-
- PERL_ASYNC_CHECK();
}
void
Thread Previous
|
Thread Next