/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
- if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE) {
+ if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
cop_free((COP*)o);
}
*/
#ifdef USE_ITHREADS
if(PL_regex_pad) { /* We could be in destruction */
+ const IV offset = (cPMOPo)->op_pmoffset;
ReREFCNT_dec(PM_GETRE(cPMOPo));
- av_push((AV*) PL_regex_pad[0],(SV*) PL_regex_pad[(cPMOPo)->op_pmoffset]);
- SvREADONLY_off(PL_regex_pad[(cPMOPo)->op_pmoffset]);
- SvREPADTMP_on(PL_regex_pad[(cPMOPo)->op_pmoffset]);
- PM_SETRE_OFFSET(cPMOPo, (cPMOPo)->op_pmoffset);
+ PL_regex_pad[offset] = &PL_sv_undef;
+ sv_catpvn_nomg(PL_regex_pad[0], (const char *)&offset,
+ sizeof(offset));
}
#else
ReREFCNT_dec(PM_GETRE(cPMOPo));
}
if (o->op_type == OP_NEXTSTATE
- || o->op_type == OP_SETSTATE
|| o->op_type == OP_DBSTATE
|| (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
- || o->op_targ == OP_SETSTATE
|| o->op_targ == OP_DBSTATE)))
PL_curcop = (COP*)o; /* for warning below */
case OP_ANONLIST:
case OP_ANONHASH:
case OP_SORT:
- case OP_GREPWHILE:
case OP_REVERSE:
case OP_RANGE:
case OP_FLIP:
func_ops:
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
/* Otherwise it's "Useless use of grep iterator" */
- useless = (o->op_type == OP_GREPWHILE) ? "grep"
- : OP_DESC(o);
+ useless = OP_DESC(o);
break;
case OP_NOT:
Perl_fold_constants(pTHX_ register OP *o)
{
dVAR;
- register OP *curop;
+ register OP * VOL curop;
OP *newop;
VOL I32 type = o->op_type;
SV * VOL sv = NULL;
#ifdef USE_ITHREADS
- if (av_len((AV*) PL_regex_pad[0]) > -1) {
- SV * const repointer = av_pop((AV*)PL_regex_pad[0]);
- pmop->op_pmoffset = SvIV(repointer);
- SvREPADTMP_off(repointer);
- sv_setiv(repointer,0);
+ assert(SvPOK(PL_regex_pad[0]));
+ if (SvCUR(PL_regex_pad[0])) {
+ /* Pop off the "packed" IV from the end. */
+ SV *const repointer_list = PL_regex_pad[0];
+ const char *p = SvEND(repointer_list) - sizeof(IV);
+ const IV offset = *((IV*)p);
+
+ assert(SvCUR(repointer_list) % sizeof(IV) == 0);
+
+ SvEND_set(repointer_list, p);
+
+ pmop->op_pmoffset = offset;
+ /* This slot should be free, so assert this: */
+ assert(PL_regex_pad[offset] == &PL_sv_undef);
} else {
- SV * const repointer = newSViv(0);
- av_push(PL_regex_padav, SvREFCNT_inc_simple_NN(repointer));
+ SV * const repointer = &PL_sv_undef;
+ av_push(PL_regex_padav, repointer);
pmop->op_pmoffset = av_len(PL_regex_padav);
PL_regex_pad = AvARRAY(PL_regex_padav);
}
static const char no_list_state[] = "Initialization of state variables"
" in list context currently forbidden";
OP *curop;
+ bool maybe_common_vars = TRUE;
PL_modcount = 0;
/* Grandfathering $[ assignment here. Bletch.*/
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = (U8)(0 | (flags >> 8));
+ if ((left->op_type == OP_LIST
+ || (left->op_type == OP_NULL && left->op_targ == OP_LIST)))
+ {
+ OP* lop = ((LISTOP*)left)->op_first;
+ maybe_common_vars = FALSE;
+ while (lop) {
+ if (lop->op_type == OP_PADSV ||
+ lop->op_type == OP_PADAV ||
+ lop->op_type == OP_PADHV ||
+ lop->op_type == OP_PADANY) {
+ if (!(lop->op_private & OPpLVAL_INTRO))
+ maybe_common_vars = TRUE;
+
+ if (lop->op_private & OPpPAD_STATE) {
+ if (left->op_private & OPpLVAL_INTRO) {
+ /* Each variable in state($a, $b, $c) = ... */
+ }
+ else {
+ /* Each state variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ yyerror(no_list_state);
+ } else {
+ /* Each my variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ } else if (lop->op_type == OP_UNDEF ||
+ lop->op_type == OP_PUSHMARK) {
+ /* undef may be interesting in
+ (state $a, undef, state $c) */
+ } else {
+ /* Other ops in the list. */
+ maybe_common_vars = TRUE;
+ }
+ lop = lop->op_sibling;
+ }
+ }
+ else if ((left->op_private & OPpLVAL_INTRO)
+ && ( left->op_type == OP_PADSV
+ || left->op_type == OP_PADAV
+ || left->op_type == OP_PADHV
+ || left->op_type == OP_PADANY))
+ {
+ maybe_common_vars = FALSE;
+ if (left->op_private & OPpPAD_STATE) {
+ /* All single variable list context state assignments, hence
+ state ($a) = ...
+ (state $a) = ...
+ state @a = ...
+ state (@a) = ...
+ (state @a) = ...
+ state %a = ...
+ state (%a) = ...
+ (state %a) = ...
+ */
+ yyerror(no_list_state);
+ }
+ }
+
/* PL_generation sorcery:
* an assignment like ($a,$b) = ($c,$d) is easier than
* ($a,$b) = ($c,$a), since there is no need for temporary vars.
* to store these values, evil chicanery is done with SvUVX().
*/
- {
+ if (maybe_common_vars) {
OP *lastop = o;
PL_generation++;
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
o->op_private |= OPpASSIGN_COMMON;
}
- if ((left->op_type == OP_LIST
- || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) {
- OP* lop = ((LISTOP*)left)->op_first;
- while (lop) {
- if (lop->op_type == OP_PADSV ||
- lop->op_type == OP_PADAV ||
- lop->op_type == OP_PADHV ||
- lop->op_type == OP_PADANY) {
- if (lop->op_private & OPpPAD_STATE) {
- if (left->op_private & OPpLVAL_INTRO) {
- /* Each variable in state($a, $b, $c) = ... */
- }
- else {
- /* Each state variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- yyerror(no_list_state);
- } else {
- /* Each my variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- } else {
- /* Other ops in the list. undef may be interesting in
- (state $a, undef, state $c) */
- }
- lop = lop->op_sibling;
- }
- }
- else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE))
- == (OPpLVAL_INTRO | OPpPAD_STATE))
- && ( left->op_type == OP_PADSV
- || left->op_type == OP_PADAV
- || left->op_type == OP_PADHV
- || left->op_type == OP_PADANY))
- {
- /* All single variable list context state assignments, hence
- state ($a) = ...
- (state $a) = ...
- state @a = ...
- state (@a) = ...
- (state @a) = ...
- state %a = ...
- state (%a) = ...
- (state %a) = ...
- */
- yyerror(no_list_state);
- }
-
if (right && right->op_type == OP_SPLIT && !PL_madskills) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
o->op_opt = 1;
PL_op = o;
switch (o->op_type) {
- case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
PL_curcop = ((COP*)o); /* for warnings */
goto nothin;
case OP_NULL:
if (o->op_targ == OP_NEXTSTATE
- || o->op_targ == OP_DBSTATE
- || o->op_targ == OP_SETSTATE)
+ || o->op_targ == OP_DBSTATE)
{
PL_curcop = ((COP*)o);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff