X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=b8f363cb3a46de8e7f6f8b62578af04b62ea08bf;hb=e92c4225b24535b7128dd90f6a3e01d0abc79a1d;hp=2784a54bd38974fba3d4c2138280eebf6105ff52;hpb=e125f273e351a19a92b69d6244af55abbbf0a26d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 2784a54..b8f363c 100644 --- a/op.c +++ b/op.c @@ -39,6 +39,7 @@ static I32 list_assignment _((OP *op)); static OP *bad_type _((I32 n, char *t, char *name, OP *kid)); static OP *modkids _((OP *op, I32 type)); static OP *no_fh_allowed _((OP *op)); +static bool scalar_mod_type _((OP *op, I32 type)); static OP *scalarboolean _((OP *op)); static OP *too_few_arguments _((OP *op, char* name)); static OP *too_many_arguments _((OP *op, char* name)); @@ -47,11 +48,11 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); static char* -CvNAME(cv) -CV* cv; +gv_ename(gv) +GV* gv; { SV* tmpsv = sv_newmortal(); - gv_efullname3(tmpsv, CvGV(cv), Nullch); + gv_efullname3(tmpsv, gv, Nullch); return SvPV(tmpsv,na); } @@ -59,9 +60,8 @@ static OP * no_fh_allowed(op) OP *op; { - sprintf(tokenbuf,"Missing comma after first argument to %s function", - op_desc[op->op_type]); - yyerror(tokenbuf); + yyerror(form("Missing comma after first argument to %s function", + op_desc[op->op_type])); return op; } @@ -70,8 +70,7 @@ too_few_arguments(op, name) OP* op; char* name; { - sprintf(tokenbuf,"Not enough arguments for %s", name); - yyerror(tokenbuf); + yyerror(form("Not enough arguments for %s", name)); return op; } @@ -80,8 +79,7 @@ too_many_arguments(op, name) OP *op; char* name; { - sprintf(tokenbuf,"Too many arguments for %s", name); - yyerror(tokenbuf); + yyerror(form("Too many arguments for %s", name)); return op; } @@ -92,9 +90,8 @@ char *t; char *name; OP *kid; { - sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", - (int) n, name, t, op_desc[kid->op_type]); - yyerror(tokenbuf); + yyerror(form("Type of arg %d to %s must be %s (not %s)", + (int)n, name, t, op_desc[kid->op_type])); return op; } @@ -104,8 +101,7 @@ OP *op; { int type = op->op_type; if (type != OP_AELEM && type != OP_HELEM) { - sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]); - yyerror(tokenbuf); + yyerror(form("Can't use subscript on %s", op_desc[type])); if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) warn("(Did you mean $ or @ instead of %c?)\n", type == OP_ENTERSUB ? '&' : '%'); @@ -122,8 +118,11 @@ char *name; SV *sv; if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) { - if (!isPRINT(name[1])) - sprintf(name+1, "^%c", toCTRL(name[1])); /* XXX tokenbuf, really */ + if (!isPRINT(name[1])) { + name[3] = '\0'; + name[2] = toCTRL(name[1]); + name[1] = '^'; + } croak("Can't use global %s in \"my\"",name); } if (AvFILL(comppad_name) >= 0) { @@ -219,7 +218,11 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) { /* "It's closures all the way down." */ CvCLONE_on(compcv); - if (cv != startcv) { + if (cv == startcv) { + if (CvANON(compcv)) + oldsv = Nullsv; /* no need to keep ref */ + } + else { CV *bcv; for (bcv = startcv; bcv && bcv != cv && !CvCLONE(bcv); @@ -293,6 +296,7 @@ pad_findmy(name) char *name; { I32 off; + I32 pendoff = 0; SV *sv; SV **svp = AvARRAY(comppad_name); U32 seq = cop_seqmax; @@ -301,18 +305,25 @@ char *name; for (off = AvFILL(comppad_name); off > 0; off--) { if ((sv = svp[off]) && sv != &sv_undef && - seq <= SvIVX(sv) && - seq > I_32(SvNVX(sv)) && + (!SvIVX(sv) || + (seq <= SvIVX(sv) && + seq > I_32(SvNVX(sv)))) && strEQ(SvPVX(sv), name)) { - return (PADOFFSET)off; + if (SvIVX(sv)) + return (PADOFFSET)off; + pendoff = off; /* this pending def. will override import */ } } /* See if it's in a nested scope */ off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix); - if (off) + if (off) { + /* If there is a pending local definition, this new alias must die */ + if (pendoff) + SvIVX(AvARRAY(comppad_name)[off]) = seq; return off; + } return 0; } @@ -595,12 +606,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags &= ~OPf_LIST; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR; switch (op->op_type) { case OP_REPEAT: @@ -631,8 +641,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - scalar(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + scalar(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + scalar(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: case OP_LIST: @@ -656,12 +674,12 @@ OP *op; char* useless = 0; SV* sv; - if (!op || error_count) - return op; - if (op->op_flags & OPf_LIST) + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= OPf_KNOW; + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_VOID; switch (op->op_type) { default: @@ -791,37 +809,41 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_NULL: if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE) curcop = ((COP*)op); /* for warning below */ if (op->op_flags & OPf_STACKED) break; + /* FALL THROUGH */ case OP_ENTERTRY: case OP_ENTER: case OP_SCALAR: if (!(op->op_flags & OPf_KIDS)) break; + /* FALL THROUGH */ case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: case OP_LEAVELOOP: - op->op_private |= OPpLEAVE_VOID; case OP_LINESEQ: case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_ENTEREVAL: + scalarkids(op); + break; + case OP_REQUIRE: + /* all requires must return a boolean value */ + op->op_flags &= ~OPf_WANT; + return scalar(op); case OP_SPLIT: if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { if (!kPMOP->op_pmreplroot) deprecate("implicit split to @_"); } break; - case OP_KEYS: - case OP_VALUES: - case OP_DELETE: - op->op_private |= OPpLEAVE_VOID; - break; } if (useless && dowarn) warn("Useless use of %s in void context", useless); @@ -847,11 +869,11 @@ OP *op; OP *kid; /* assumes no premature commitment */ - if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN - || error_count) + if (!op || (op->op_flags & OPf_WANT) || error_count + || op->op_type == OP_RETURN) return op; - op->op_flags |= (OPf_KNOW | OPf_LIST); + op->op_flags = (op->op_flags & ~OPf_WANT) | OPf_WANT_LIST; switch (op->op_type) { case OP_FLOP: @@ -879,8 +901,16 @@ OP *op; break; case OP_LEAVE: case OP_LEAVETRY: - list(cLISTOP->op_first); - /* FALL THROUGH */ + kid = cLISTOP->op_first; + list(kid); + while (kid = kid->op_sibling) { + if (kid->op_sibling) + scalarvoid(kid); + else + list(kid); + } + curcop = &compiling; + break; case OP_SCOPE: case OP_LINESEQ: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) { @@ -891,6 +921,10 @@ OP *op; } curcop = &compiling; break; + case OP_REQUIRE: + /* all requires must return a boolean value */ + op->op_flags &= ~OPf_WANT; + return scalar(op); } return op; } @@ -950,6 +984,9 @@ I32 type; return op; switch (op->op_type) { + case OP_UNDEF: + modcount++; + return op; case OP_CONST: if (!(op->op_private & (OPpCONST_ARYBASE))) goto nomod; @@ -985,10 +1022,9 @@ I32 type; /* grep, foreach, subcalls, refgen */ if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) break; - sprintf(tokenbuf, "Can't modify %s in %s", - op_desc[op->op_type], - type ? op_desc[type] : "local"); - yyerror(tokenbuf); + yyerror(form("Can't modify %s in %s", + op_desc[op->op_type], + type ? op_desc[type] : "local")); return op; case OP_PREINC: @@ -1023,12 +1059,16 @@ I32 type; case OP_RV2AV: case OP_RV2HV: + if (!type && cUNOP->op_first->op_type != OP_GV) + croak("Can't localize through a reference"); if (type == OP_REFGEN && op->op_flags & OPf_PARENS) { modcount = 10000; return op; /* Treat \(@foo) like ordinary list. */ } /* FALL THROUGH */ case OP_RV2GV: + if (scalar_mod_type(op, type)) + goto nomod; ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_AASSIGN: @@ -1042,10 +1082,9 @@ I32 type; break; case OP_RV2SV: if (!type && cUNOP->op_first->op_type != OP_GV) - croak("Can't localize a reference"); + croak("Can't localize through a reference"); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ - case OP_UNDEF: case OP_GV: case OP_AV2ARYLEN: case OP_SASSIGN: @@ -1058,6 +1097,8 @@ I32 type; modcount = 10000; if (type == OP_REFGEN && op->op_flags & OPf_PARENS) return op; /* Treat \(@foo) like ordinary list. */ + if (scalar_mod_type(op, type)) + goto nomod; /* FALL THROUGH */ case OP_PADSV: modcount++; @@ -1086,6 +1127,9 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); + if (type == OP_ENTERSUB && + !(op->op_private & (OPpLVAL_INTRO | OPpDEREF))) + op->op_private |= OPpLVAL_DEFER; modcount++; break; @@ -1122,6 +1166,52 @@ I32 type; return op; } +static bool +scalar_mod_type(op, type) +OP *op; +I32 type; +{ + switch (type) { + case OP_SASSIGN: + if (op->op_type == OP_RV2GV) + return FALSE; + /* FALL THROUGH */ + case OP_PREINC: + case OP_PREDEC: + case OP_POSTINC: + case OP_POSTDEC: + case OP_I_PREINC: + case OP_I_PREDEC: + case OP_I_POSTINC: + case OP_I_POSTDEC: + case OP_POW: + case OP_MULTIPLY: + case OP_DIVIDE: + case OP_MODULO: + case OP_REPEAT: + case OP_ADD: + case OP_SUBTRACT: + case OP_I_MULTIPLY: + case OP_I_DIVIDE: + case OP_I_MODULO: + case OP_I_ADD: + case OP_I_SUBTRACT: + case OP_LEFT_SHIFT: + case OP_RIGHT_SHIFT: + case OP_BIT_AND: + case OP_BIT_XOR: + case OP_BIT_OR: + case OP_CONCAT: + case OP_SUBST: + case OP_TRANS: + case OP_ANDASSIGN: /* may work later */ + case OP_ORASSIGN: /* may work later */ + return TRUE; + default: + return FALSE; + } +} + OP * refkids(op, type) OP *op; @@ -1238,8 +1328,7 @@ OP *op; type != OP_PADHV && type != OP_PUSHMARK) { - sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]); - yyerror(tokenbuf); + yyerror(form("Can't declare %s in my", op_desc[op->op_type])); return op; } op->op_flags |= OPf_MOD; @@ -1464,6 +1553,16 @@ register OP *o; if (!(opargs[type] & OA_FOLDCONST)) goto nope; + switch (type) { + case OP_SPRINTF: + case OP_UCFIRST: + case OP_LCFIRST: + case OP_UC: + case OP_LC: + if (o->op_private & OPpLOCALE) + goto nope; + } + if (error_count) goto nope; /* Don't try to run w/ errors */ @@ -1568,7 +1667,7 @@ OP* op; if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); else - op->op_flags &= ~(OPf_KNOW|OPf_LIST); + op->op_flags &= ~OPf_WANT; if (!(opargs[type] & OA_MARK)) null(cLISTOP->op_first); @@ -1922,6 +2021,7 @@ OP *repl; if (op->op_type == OP_TRANS) return pmtrans(op, expr, repl); + hints |= HINT_BLOCK_SCOPE; pm = (PMOP*)op; if (expr->op_type == OP_CONST) { @@ -2335,7 +2435,7 @@ OP *right; tmpop->op_sibling = Nullop; /* don't free split */ right->op_next = tmpop->op_next; /* fix starting loc */ op_free(op); /* blow off assign */ - right->op_flags &= ~(OPf_KNOW|OPf_LIST); + right->op_flags &= ~OPf_WANT; /* "I don't know and I don't care." */ return right; } @@ -2510,16 +2610,20 @@ OP* other; break; case OP_SASSIGN: - if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB) + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) warnop = k1->op_type; break; } if (warnop) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; - warn("Value of %s construct can be \"0\"; test with defined()", - op_desc[warnop]); - curcop->cop_line = oldline; + warn("Value of %s%s can be \"0\"; test with defined()", + op_desc[warnop], + ((warnop == OP_READLINE || warnop == OP_GLOB) + ? " construct" : "() operator")); + curcop->cop_line = oldline; } } @@ -2847,6 +2951,7 @@ CV *cv; CvROOT(cv) = Nullop; LEAVE; } + SvPOK_off((SV*)cv); /* forget prototype */ CvFLAGS(cv) = 0; SvREFCNT_dec(CvGV(cv)); CvGV(cv) = Nullgv; @@ -2858,8 +2963,16 @@ CV *cv; I32 i = AvFILL(CvPADLIST(cv)); while (i >= 0) { SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); - if (svp) - SvREFCNT_dec(*svp); + SV* sv = svp ? *svp : Nullsv; + if (!sv) + continue; + if (sv == (SV*)comppad_name) + comppad_name = Nullav; + else if (sv == (SV*)comppad) { + comppad = Nullav; + curpad = Null(SV**); + } + SvREFCNT_dec(sv); } SvREFCNT_dec((SV*)CvPADLIST(cv)); } @@ -2935,6 +3048,7 @@ CV* outside; ENTER; SAVESPTR(curpad); SAVESPTR(comppad); + SAVESPTR(comppad_name); SAVESPTR(compcv); cv = compcv = (CV*)NEWSV(1104,0); @@ -2951,11 +3065,18 @@ CV* outside; if (outside) CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside); + if (SvPOK(proto)) + sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto)); + + comppad_name = newAV(); + for (ix = fname; ix >= 0; ix--) + av_store(comppad_name, ix, SvREFCNT_inc(pname[ix])); + comppad = newAV(); comppadlist = newAV(); AvREAL_off(comppadlist); - av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name)); + av_store(comppadlist, 0, (SV*)comppad_name); av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(cv) = comppadlist; av_fill(comppad, AvFILL(protopad)); @@ -3040,27 +3161,65 @@ CV* proto; return cv_clone2(proto, CvOUTSIDE(proto)); } +void +cv_ckproto(cv, gv, p) +CV* cv; +GV* gv; +char* p; +{ + if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) { + SV* msg = sv_newmortal(); + SV* name = Nullsv; + + if (gv) + gv_efullname3(name = sv_newmortal(), gv, Nullch); + sv_setpv(msg, "Prototype mismatch:"); + if (name) + sv_catpvf(msg, " sub %_", name); + if (SvPOK(cv)) + sv_catpvf(msg, " (%s)", SvPVX(cv)); + sv_catpv(msg, " vs "); + if (p) + sv_catpvf(msg, "(%s)", p); + else + sv_catpv(msg, "none"); + warn("%_", msg); + } +} + SV * cv_const_sv(cv) -CV *cv; +CV* cv; { OP *o; - SV *sv = Nullsv; + SV *sv; - if(cv && SvPOK(cv) && !SvCUR(cv)) { - for (o = CvSTART(cv); o; o = o->op_next) { - OPCODE type = o->op_type; - - if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) - continue; - if (type == OP_LEAVESUB || type == OP_RETURN) - break; - if (type != OP_CONST || sv) - return Nullsv; + if (!cv || !SvPOK(cv) || SvCUR(cv)) + return Nullsv; + sv = Nullsv; + for (o = CvSTART(cv); o; o = o->op_next) { + OPCODE type = o->op_type; + + if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) + continue; + if (type == OP_LEAVESUB || type == OP_RETURN) + break; + if (sv) + return Nullsv; + if (type == OP_CONST) sv = ((SVOP*)o)->op_sv; + else if (type == OP_PADSV) { + AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]); + sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv; + if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) + return Nullsv; } + else + return Nullsv; } + if (sv) + SvREADONLY_on(sv); return sv; } @@ -3073,43 +3232,40 @@ OP *block; { char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); + char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; register CV *cv; - AV *av; I32 ix; if (op) SAVEFREEOP(op); - if (cv = (name ? GvCV(gv) : Nullcv)) { - if (GvCVGEN(gv)) { - /* just a cached method */ - SvREFCNT_dec(cv); - cv = 0; - } - else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { - /* already defined (or promised) */ - - SV* const_sv = cv_const_sv(cv); - char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; - - if((!proto != !SvPOK(cv)) || (p && strNE(SvPV((SV*)cv,na), p))) { - warn("Prototype mismatch: (%s) vs (%s)", - SvPOK(cv) ? SvPV((SV*)cv,na) : "none", - p ? p : "none"); - } + if (proto) + SAVEFREEOP(proto); + + if (!name || GvCVGEN(gv)) + cv = Nullcv; + else if (cv = GvCV(gv)) { + cv_ckproto(cv, gv, ps); + /* already defined (or promised)? */ + if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { + SV* const_sv; if (!block) { /* just a "sub foo;" when &foo is already defined */ SAVEFREESV(compcv); goto done; } + /* ahem, death to those who redefine active sort subs */ + if (curstack == sortstack && sortcop == CvSTART(cv)) + croak("Can't redefine active sort subroutine %s", name); + const_sv = cv_const_sv(cv); if (const_sv || dowarn) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; warn(const_sv ? "Constant subroutine %s redefined" - : "Subroutine %s redefined",name); + : "Subroutine %s redefined", name); curcop->cop_line = oldline; } SvREFCNT_dec(cv); - cv = 0; + cv = Nullcv; } } if (cv) { /* must reuse cv if autoloaded */ @@ -3135,15 +3291,27 @@ OP *block; CvFILEGV(cv) = curcop->cop_filegv; CvSTASH(cv) = curstash; - if (proto) { - char *p = SvPVx(((SVOP*)proto)->op_sv, na); - sv_setpv((SV*)cv, p); - op_free(proto); - } + if (ps) + sv_setpv((SV*)cv, ps); if (error_count) { op_free(block); block = Nullop; + if (name) { + char *s = strrchr(name, ':'); + s = s ? s+1 : name; + if (strEQ(s, "BEGIN")) { + char *not_safe = + "BEGIN not safe after errors--compilation aborted"; + if (in_eval & 4) + croak(not_safe); + else { + /* force display of errors found but not reported */ + sv_catpv(GvSV(errgv), not_safe); + croak("%s", SvPVx(GvSV(errgv), na)); + } + } + } } if (!block) { copline = NOLINE; @@ -3151,18 +3319,44 @@ OP *block; return cv; } - av = newAV(); /* Will be @_ */ - av_extend(av, 0); - av_store(comppad, 0, (SV*)av); - AvFLAGS(av) = AVf_REIFY; + if (AvFILL(comppad_name) < AvFILL(comppad)) + av_store(comppad_name, AvFILL(comppad), Nullsv); - for (ix = AvFILL(comppad); ix > 0; ix--) { - if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix])) - SvPADTMP_on(curpad[ix]); + if (CvCLONE(cv)) { + SV **namep = AvARRAY(comppad_name); + for (ix = AvFILL(comppad); ix > 0; ix--) { + SV *namesv; + + if (SvIMMORTAL(curpad[ix])) + continue; + /* + * The only things that a clonable function needs in its + * pad are references to outer lexicals and anonymous subs. + * The rest are created anew during cloning. + */ + if (!((namesv = namep[ix]) != Nullsv && + namesv != &sv_undef && + (SvFAKE(namesv) || + *SvPVX(namesv) == '&'))) + { + SvREFCNT_dec(curpad[ix]); + curpad[ix] = Nullsv; + } + } } + else { + AV *av = newAV(); /* Will be @_ */ + av_extend(av, 0); + av_store(comppad, 0, (SV*)av); + AvFLAGS(av) = AVf_REIFY; - if (AvFILL(comppad_name) < AvFILL(comppad)) - av_store(comppad_name, AvFILL(comppad), Nullsv); + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (SvIMMORTAL(curpad[ix])) + continue; + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } + } CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); @@ -3173,18 +3367,15 @@ OP *block; char *s; if (perldb && curstash != debstash) { - SV *sv; + SV *sv = NEWSV(0,0); SV *tmpstr = sv_newmortal(); static GV *db_postponed; CV *cv; HV *hv; - sprintf(buf, "%s:%ld", - SvPVX(GvSV(curcop->cop_filegv)), (long)subline); - sv = newSVpv(buf,0); - sv_catpv(sv,"-"); - sprintf(buf,"%ld",(long)curcop->cop_line); - sv_catpv(sv,buf); + sv_setpvf(sv, "%_:%ld-%ld", + GvSV(curcop->cop_filegv), + (long)subline, (long)curcop->cop_line); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); if (!db_postponed) { @@ -3205,7 +3396,7 @@ OP *block; s++; else s = name; - if (strEQ(s, "BEGIN") && !error_count) { + if (strEQ(s, "BEGIN")) { I32 oldscope = scopestack_ix; ENTER; SAVESPTR(compiling.cop_filegv); @@ -3219,7 +3410,7 @@ OP *block; DEBUG_x( dump_sub(gv) ); av_push(beginav, (SV *)cv); GvCV(gv) = 0; - calllist(oldscope, beginav); + call_list(oldscope, beginav); curcop = &compiling; LEAVE; @@ -3924,8 +4115,14 @@ OP *op; GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV); if (gv && GvIMPORTED_CV(gv)) { + static int glob_index; + + append_elem(OP_GLOB, op, + newSVOP(OP_CONST, 0, newSViv(glob_index++))); op->op_type = OP_LIST; op->op_ppaddr = ppaddr[OP_LIST]; + ((LISTOP*)op)->op_first->op_type = OP_PUSHMARK; + ((LISTOP*)op)->op_first->op_ppaddr = ppaddr[OP_PUSHMARK]; op = newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, op, scalar(newUNOP(OP_RV2CV, 0, @@ -4100,8 +4297,7 @@ OP * ck_match(op) OP *op; { - cPMOP->op_pmflags |= PMf_RUNTIME; - cPMOP->op_pmpermflags |= PMf_RUNTIME; + op->op_private |= OPpRUNTIME; return op; } @@ -4312,6 +4508,7 @@ OP *op; OP *cvop; char *proto = 0; CV *cv = 0; + GV *namegv = 0; int optional = 0; I32 arg = 0; @@ -4323,8 +4520,10 @@ OP *op; tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV) { cv = GvCVu(tmpop->op_sv); - if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) - proto = SvPV((SV*)cv,na); + if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER)) { + namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv); + proto = SvPV((SV*)cv, na); + } } } op->op_private |= (hints & HINT_STRICT_REFS); @@ -4334,7 +4533,7 @@ OP *op; if (proto) { switch (*proto) { case '\0': - return too_many_arguments(op, CvNAME(cv)); + return too_many_arguments(op, gv_ename(namegv)); case ';': optional = 1; proto++; @@ -4353,7 +4552,7 @@ OP *op; proto++; arg++; if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF) - bad_type(arg, "block", CvNAME(cv), o); + bad_type(arg, "block", gv_ename(namegv), o); break; case '*': proto++; @@ -4374,23 +4573,23 @@ OP *op; switch (*proto++) { case '*': if (o->op_type != OP_RV2GV) - bad_type(arg, "symbol", CvNAME(cv), o); + bad_type(arg, "symbol", gv_ename(namegv), o); goto wrapref; case '&': if (o->op_type != OP_RV2CV) - bad_type(arg, "sub", CvNAME(cv), o); + bad_type(arg, "sub", gv_ename(namegv), o); goto wrapref; case '$': if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV) - bad_type(arg, "scalar", CvNAME(cv), o); + bad_type(arg, "scalar", gv_ename(namegv), o); goto wrapref; case '@': if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV) - bad_type(arg, "array", CvNAME(cv), o); + bad_type(arg, "array", gv_ename(namegv), o); goto wrapref; case '%': if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV) - bad_type(arg, "hash", CvNAME(cv), o); + bad_type(arg, "hash", gv_ename(namegv), o); wrapref: { OP* kid = o; @@ -4409,16 +4608,17 @@ OP *op; default: oops: croak("Malformed prototype for %s: %s", - CvNAME(cv),SvPV((SV*)cv,na)); + gv_ename(namegv), SvPV((SV*)cv, na)); } } else list(o); + mod(o, OP_ENTERSUB); prev = o; o = o->op_sibling; } if (proto && !optional && *proto == '$') - return too_few_arguments(op, CvNAME(cv)); + return too_few_arguments(op, gv_ename(namegv)); return op; } @@ -4484,9 +4684,9 @@ register OP* o; o->op_seq = op_seqmax++; break; case OP_STUB: - if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) { o->op_seq = op_seqmax++; - break; /* Scalar stub must produce undef. List stub is noop */ + break; /* Scalar stub must produce undef. List stub is noop */ } goto nothin; case OP_NULL: @@ -4520,7 +4720,8 @@ register OP* o; if (pop->op_type == OP_CONST && (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) && + !(pop->op_next->op_private & + (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) && (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) <= 255 && i >= 0)