break;
case OP_KEYS:
+ case OP_RKEYS:
if (type != OP_SASSIGN)
goto nomod;
goto lvalue_func;
PL_op = curop = LINKLIST(o);
o->op_next = 0;
CALL_PEEP(curop);
- pp_pushmark();
+ Perl_pp_pushmark(aTHX);
CALLRUNOPS(aTHX);
PL_op = curop;
assert (!(curop->op_flags & OPf_SPECIAL));
assert(curop->op_type == OP_RANGE);
- pp_anonlist();
+ Perl_pp_anonlist(aTHX);
PL_tmps_floor = oldtmps_floor;
o->op_type = OP_RV2AV;
U8 range_mark = UTF_TO_NATIVE(0xff);
sv_catpvn(transv, (char *)&range_mark, 1);
}
- t = uvuni_to_utf8_flags(tmpbuf, 0x7fffffff,
- UNICODE_ALLOW_SUPER);
+ t = uvuni_to_utf8(tmpbuf, 0x7fffffff);
sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
t = (const U8*)SvPVX_const(transv);
tlen = SvCUR(transv);
if (PL_hints & HINT_RE_TAINT)
pmop->op_pmflags |= PMf_RETAINT;
if (PL_hints & HINT_LOCALE) {
- pmop->op_pmflags |= PMf_LOCALE;
+ set_regex_charset(&(pmop->op_pmflags), REGEX_LOCALE_CHARSET);
}
else if ((! (PL_hints & HINT_BYTES)) && (PL_hints & HINT_UNI_8_BIT)) {
- pmop->op_pmflags |= RXf_PMf_UNICODE;
+ set_regex_charset(&(pmop->op_pmflags), REGEX_UNICODE_CHARSET);
}
if (PL_hints & HINT_RE_FLAGS) {
SV *reflags = Perl_refcounted_he_fetch_pvn(aTHX_
);
if (reflags && SvOK(reflags)) pmop->op_pmflags |= SvIV(reflags);
reflags = Perl_refcounted_he_fetch_pvn(aTHX_
- PL_compiling.cop_hints_hash, STR_WITH_LEN("reflags_dul"), 0, 0
+ PL_compiling.cop_hints_hash, STR_WITH_LEN("reflags_charset"), 0, 0
);
if (reflags && SvOK(reflags)) {
- pmop->op_pmflags &= ~(RXf_PMf_LOCALE|RXf_PMf_UNICODE);
- pmop->op_pmflags |= SvIV(reflags);
+ set_regex_charset(&(pmop->op_pmflags), (regex_charset)SvIV(reflags));
}
}
if (expr->op_type == OP_CONST) {
SV *pat = ((SVOP*)expr)->op_sv;
- U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
+ U32 pm_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
if (o->op_flags & OPf_SPECIAL)
pm_flags |= RXf_SPLIT;
PL_parser->copline = NOLINE;
PL_parser->expect = XSTATE;
PL_cop_seqmax++; /* Purely for B::*'s benefit */
+ if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+ PL_cop_seqmax++;
#ifdef PERL_MAD
if (!PL_madskills) {
ENTER;
SAVEVPTR(PL_curcop);
- lex_start(NULL, NULL, 0);
+ lex_start(NULL, NULL, LEX_START_SAME_FILTER);
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
LEAVE;
* cv && CvCONST(cv)
*
* We have just cloned an anon prototype that was marked as a const
- * candidiate. Try to grab the current value, and in the case of
+ * candidate. Try to grab the current value, and in the case of
* PADSV, ignore it if it has multiple references. Return the value.
*/
CvISXSUB_on(cv);
}
else {
- GvCV(gv) = NULL;
+ GvCV_set(gv, NULL);
cv = newCONSTSUB(NULL, name, const_sv);
}
mro_method_changed_in( /* sub Foo::Bar () { 123 } */
else {
cv = PL_compcv;
if (name) {
- GvCV(gv) = cv;
+ GvCV_set(gv, cv);
if (PL_madskills) {
if (strEQ(name, "import")) {
PL_formfeed = MUTABLE_SV(cv);
DEBUG_x( dump_sub(gv) );
Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
- GvCV(gv) = 0; /* cv has been hijacked */
+ GvCV_set(gv,0); /* cv has been hijacked */
call_list(oldscope, PL_beginav);
PL_curcop = &PL_compiling;
} else
return;
DEBUG_x( dump_sub(gv) );
- GvCV(gv) = 0; /* cv has been hijacked */
+ GvCV_set(gv,0); /* cv has been hijacked */
}
}
else {
cv = MUTABLE_CV(newSV_type(SVt_PVCV));
if (name) {
- GvCV(gv) = cv;
+ GvCV_set(gv,cv);
GvCVGEN(gv) = 0;
mro_method_changed_in(GvSTASH(gv)); /* newXS */
}
kid->op_sibling = sibl;
*tokid = kid;
}
- else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
+ else if (kid->op_type == OP_CONST
+ && ( !SvROK(cSVOPx_sv(kid))
+ || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV )
+ )
bad_type(numargs, "array", PL_op_desc[type], kid);
- op_lvalue(kid, type);
+ /* Defer checks to run-time if we have a scalar arg */
+ if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
+ op_lvalue(kid, type);
+ else scalar(kid);
break;
case OA_HVREF:
if (kid->op_type == OP_CONST &&
o = ck_fun(o);
if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
- op_append_elem(OP_GLOB, o, newDEFSVOP());
+ op_append_elem(OP_GLOB, o, newDEFSVOP()); /* glob() => glob($_) */
if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV))
&& GvCVu(gv) && GvIMPORTED_CV(gv)))
newSVpvs("File::Glob"), NULL, NULL, NULL);
if((glob_gv = gv_fetchpvs("File::Glob::csh_glob", 0, SVt_PVCV))) {
gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV);
- GvCV(gv) = GvCV(glob_gv);
+ GvCV_set(gv, GvCV(glob_gv));
SvREFCNT_inc_void(MUTABLE_SV(GvCV(gv)));
GvIMPORTED_CV_on(gv);
}
}
#endif /* PERL_EXTERNAL_GLOB */
+ assert(!(o->op_flags & OPf_SPECIAL));
if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
+ /* convert
+ * glob
+ * \ null - const(wildcard)
+ * into
+ * null
+ * \ enter
+ * \ list
+ * \ mark - glob - rv2cv
+ * | \ gv(CORE::GLOBAL::glob)
+ * |
+ * \ null - const(wildcard) - const(ix)
+ */
+ o->op_flags |= OPf_SPECIAL;
+ o->op_targ = pad_alloc(OP_GLOB, SVs_PADTMP);
op_append_elem(OP_GLOB, o,
newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
- o->op_type = OP_LIST;
- o->op_ppaddr = PL_ppaddr[OP_LIST];
- cLISTOPo->op_first->op_type = OP_PUSHMARK;
- cLISTOPo->op_first->op_ppaddr = PL_ppaddr[OP_PUSHMARK];
- cLISTOPo->op_first->op_targ = 0;
+ o = newLISTOP(OP_LIST, 0, o, NULL);
o = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, o,
scalar(newUNOP(OP_RV2CV, 0,
newGVOP(OP_GV, 0, gv)))));
o = newUNOP(OP_NULL, 0, ck_subr(o));
- o->op_targ = OP_GLOB; /* hint at what it used to be */
+ o->op_targ = OP_GLOB; /* hint at what it used to be: eg in newWHILEOP */
return o;
}
gv = newGVgen("main");
other->op_targ = target;
/* Because we change the type of the op here, we will skip the
- assinment binop->op_last = binop->op_first->op_sibling; at the
+ assignment binop->op_last = binop->op_first->op_sibling; at the
end of Perl_newBINOP(). So need to do it here. */
cBINOPo->op_last = cBINOPo->op_first->op_sibling;
return newUNOP(type, 0, scalar(argop));
#endif
}
- return scalar(modkids(ck_push(o), type));
+ return scalar(ck_fun(o));
}
OP *
}
OP *
-Perl_ck_push(pTHX_ OP *o)
-{
- dVAR;
- OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL;
- OP *cursor = NULL;
- OP *proxy = NULL;
-
- PERL_ARGS_ASSERT_CK_PUSH;
-
- /* If 1st kid is pushmark (e.g. push, unshift, splice), we need 2nd kid */
- if (kid) {
- cursor = kid->op_type == OP_PUSHMARK ? kid->op_sibling : kid;
- }
-
- /* If not array or array deref, wrap it with an array deref.
- * For OP_CONST, we only wrap arrayrefs */
- if (cursor) {
- if ( ( cursor->op_type != OP_PADAV
- && cursor->op_type != OP_RV2AV
- && cursor->op_type != OP_CONST
- )
- ||
- ( cursor->op_type == OP_CONST
- && SvROK(cSVOPx_sv(cursor))
- && SvTYPE(SvRV(cSVOPx_sv(cursor))) == SVt_PVAV
- )
- ) {
- proxy = newAVREF(cursor);
- if ( cursor == kid ) {
- cLISTOPx(o)->op_first = proxy;
- }
- else {
- cLISTOPx(kid)->op_sibling = proxy;
- }
- cLISTOPx(proxy)->op_sibling = cLISTOPx(cursor)->op_sibling;
- cLISTOPx(cursor)->op_sibling = NULL;
- }
- }
- return ck_fun(o);
-}
-
-OP *
Perl_ck_each(pTHX_ OP *o)
{
dVAR;
CHANGE_TYPE(o, array_type);
break;
case OP_CONST:
- if (kid->op_private == OPpCONST_BARE)
- /* we let ck_fun treat as hash */
+ if (kid->op_private == OPpCONST_BARE
+ || !SvROK(cSVOPx_sv(kid))
+ || ( SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV
+ && SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVHV )
+ )
+ /* we let ck_fun handle it */
break;
default:
CHANGE_TYPE(o, ref_type);
+ scalar(kid);
}
}
/* if treating as a reference, defer additional checks to runtime */
https://perl5.git.perl.org / perl5.git / blobdiff