PADOFFSET off;
/* complain about "my $<special_var>" etc etc */
- if (!(PL_in_my == KEY_our ||
+ if (*name &&
+ !(PL_in_my == KEY_our ||
isALPHA(name[1]) ||
(USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
- (name[1] == '_' && (*name == '$' || (int)strlen(name) > 2))))
+ (name[1] == '_' && (*name == '$' || name[2]))))
{
+ /* name[2] is true if strlen(name) > 2 */
if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
/* 1999-02-27 mjd@plover.com */
char *p;
clear_pmop:
{
HV * const pmstash = PmopSTASH(cPMOPo);
- if (pmstash && SvREFCNT(pmstash)) {
+ if (pmstash && !SvIS_FREED(pmstash)) {
MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
if (mg) {
PMOP *pmop = (PMOP*) mg->mg_obj;
o->op_ppaddr = PL_ppaddr[OP_PREDEC];
break;
+ case OP_I_POSTINC:
+ o->op_type = OP_I_PREINC; /* pre-increment is faster */
+ o->op_ppaddr = PL_ppaddr[OP_I_PREINC];
+ break;
+
+ case OP_I_POSTDEC:
+ o->op_type = OP_I_PREDEC; /* pre-decrement is faster */
+ o->op_ppaddr = PL_ppaddr[OP_I_PREDEC];
+ break;
+
case OP_OR:
case OP_AND:
case OP_DOR:
}
OP *
-Perl_ref(pTHX_ OP *o, I32 type)
+Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
{
dVAR;
OP *kid;
case OP_COND_EXPR:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
- ref(kid, type);
+ doref(kid, type, set_op_ref);
break;
case OP_RV2SV:
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
- ref(cUNOPo->op_first, o->op_type);
+ doref(cUNOPo->op_first, o->op_type, set_op_ref);
/* FALL THROUGH */
case OP_PADSV:
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
case OP_RV2AV:
case OP_RV2HV:
- o->op_flags |= OPf_REF;
+ if (set_op_ref)
+ o->op_flags |= OPf_REF;
/* FALL THROUGH */
case OP_RV2GV:
if (type == OP_DEFINED)
o->op_flags |= OPf_SPECIAL; /* don't create GV */
- ref(cUNOPo->op_first, o->op_type);
+ doref(cUNOPo->op_first, o->op_type, set_op_ref);
break;
case OP_PADAV:
case OP_PADHV:
- o->op_flags |= OPf_REF;
+ if (set_op_ref)
+ o->op_flags |= OPf_REF;
break;
case OP_SCALAR:
case OP_NULL:
if (!(o->op_flags & OPf_KIDS))
break;
- ref(cBINOPo->op_first, type);
+ doref(cBINOPo->op_first, type, set_op_ref);
break;
case OP_AELEM:
case OP_HELEM:
- ref(cBINOPo->op_first, o->op_type);
+ doref(cBINOPo->op_first, o->op_type, set_op_ref);
if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
: type == OP_RV2HV ? OPpDEREF_HV
case OP_SCOPE:
case OP_LEAVE:
+ set_op_ref = FALSE;
+ /* FALL THROUGH */
case OP_ENTER:
case OP_LIST:
if (!(o->op_flags & OPf_KIDS))
break;
- ref(cLISTOPo->op_last, type);
+ doref(cLISTOPo->op_last, type, set_op_ref);
break;
default:
break;
o->op_type = OP_SCOPE;
o->op_ppaddr = PL_ppaddr[OP_SCOPE];
kid = ((LISTOP*)o)->op_first;
- if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+ if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
op_null(kid);
+
+ /* The following deals with things like 'do {1 for 1}' */
+ kid = kid->op_sibling;
+ if (kid &&
+ (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE))
+ op_null(kid);
+ }
}
else
o = newLISTOP(OP_SCOPE, 0, o, Nullop);
return o;
}
-/* XXX kept for BINCOMPAT only */
-void
-Perl_save_hints(pTHX)
-{
- Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
-}
-
int
Perl_block_start(pTHX_ int full)
{
/* XXX might want a ck_negate() for this */
cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
break;
- case OP_SPRINTF:
case OP_UCFIRST:
case OP_LCFIRST:
case OP_UC:
unop->op_type = (OPCODE)type;
unop->op_ppaddr = PL_ppaddr[type];
unop->op_first = first;
- unop->op_flags = flags | OPf_KIDS;
+ unop->op_flags = (U8)(flags | OPf_KIDS);
unop->op_private = (U8)(1 | (flags >> 8));
unop = (UNOP*) CHECKOP(type, unop);
if (unop->op_next)
binop->op_type = (OPCODE)type;
binop->op_ppaddr = PL_ppaddr[type];
binop->op_first = first;
- binop->op_flags = flags | OPf_KIDS;
+ binop->op_flags = (U8)(flags | OPf_KIDS);
if (!last) {
last = first;
binop->op_private = (U8)(1 | (flags >> 8));
j = rlen - 1;
else
cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
- tbl[0x100] = rlen - j;
+ tbl[0x100] = (short)(rlen - j);
for (i=0; i < (I32)rlen - j; i++)
tbl[0x101+i] = r[j+i];
}
/* Result of assignment is always 1 (or we'd be dead already) */
return newSVOP(OP_CONST, 0, newSViv(1));
}
- /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
- if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
- && right->op_type == OP_STUB
- && (left->op_private & OPpLVAL_INTRO))
- {
- op_free(right);
- left->op_flags &= ~(OPf_REF|OPf_SPECIAL);
- return left;
- }
curop = list(force_list(left));
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = (U8)(0 | (flags >> 8));
logop->op_type = (OPCODE)type;
logop->op_ppaddr = PL_ppaddr[type];
logop->op_first = first;
- logop->op_flags = flags | OPf_KIDS;
+ logop->op_flags = (U8)(flags | OPf_KIDS);
logop->op_other = LINKLIST(other);
logop->op_private = (U8)(1 | (flags >> 8));
logop->op_type = OP_COND_EXPR;
logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
logop->op_first = first;
- logop->op_flags = flags | OPf_KIDS;
+ logop->op_flags = (U8)(flags | OPf_KIDS);
logop->op_private = (U8)(1 | (flags >> 8));
logop->op_other = LINKLIST(trueop);
logop->op_next = LINKLIST(falseop);
SAVEFREESV(PL_compcv);
goto done;
}
- /* ahem, death to those who redefine active sort subs */
- if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
- Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
if (block) {
if (ckWARN(WARN_REDEFINE)
|| (CvCONST(cv)
const char *tname = (name ? name : aname);
if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(0,0);
- SV *tmpstr = sv_newmortal();
- GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
+ SV * const sv = NEWSV(0,0);
+ SV * const tmpstr = sv_newmortal();
+ GV * const db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
HV *hv;
Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld",
CvCONST_on(cv);
sv_setpvn((SV*)cv, "", 0); /* prototype is "" */
+#ifdef USE_ITHREADS
if (stash)
CopSTASH_free(PL_curcop);
-
+#endif
LEAVE;
return cv;
}
OP *
-Perl_oopsCV(pTHX_ OP *o)
-{
- Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
- /* STUB */
- PERL_UNUSED_ARG(o);
- NORETURN_FUNCTION_END;
-}
-
-OP *
Perl_newCVREF(pTHX_ I32 flags, OP *o)
{
return newUNOP(OP_RV2CV, flags, scalar(o));
return kid;
}
}
- /* optimise C<my $x = undef> to C<my $x> */
- if (kid->op_type == OP_UNDEF) {
- OP * const kkid = kid->op_sibling;
- if (kkid && kkid->op_type == OP_PADSV
- && (kkid->op_private & OPpLVAL_INTRO))
- {
- cLISTOPo->op_first = NULL;
- kid->op_sibling = NULL;
- op_free(o);
- op_free(kid);
- return kkid;
- }
- }
return o;
}
for (s = SvPVX(sv); *s; s++) {
if (*s == ':' && s[1] == ':') {
+ const STRLEN len = strlen(s+2)+1;
*s = '/';
- Move(s+2, s+1, strlen(s+2)+1, char);
+ Move(s+2, s+1, len, char);
SvCUR_set(sv, SvCUR(sv) - 1);
}
}
return o;
}
-#if 0
-OP *
-Perl_ck_retarget(pTHX_ OP *o)
-{
- Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
- /* STUB */
- return o;
-}
-#endif
-
OP *
Perl_ck_select(pTHX_ OP *o)
{