X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/65269a95bf2e18461f4efd8a5e0ad5bb7d043a5e..4b88f2805a1717a959eb17ecb3e8968e25f54d02:/op.c diff --git a/op.c b/op.c index 5e3dd3c..504fae9 100644 --- a/op.c +++ b/op.c @@ -1,3 +1,4 @@ +#line 2 "op.c" /* op.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, @@ -57,7 +58,7 @@ context is, either upward in the syntax tree, or either forward or backward in the execution order. (The bottom-up parser builds that part of the execution order it knows about, but if you follow the "next" links around, you'll find it's actually a closed loop through the -top level node. +top level node.) Whenever the bottom-up parser gets to a node that supplies context to its components, it invokes that portion of the top-down pass that applies @@ -103,6 +104,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes. #include "keywords.h" #define CALL_PEEP(o) CALL_FPTR(PL_peepp)(aTHX_ o) +#define CALL_OPFREEHOOK(o) if (PL_opfreehook) CALL_FPTR(PL_opfreehook)(aTHX_ o) #if defined(PL_OP_SLAB_ALLOC) @@ -399,14 +401,6 @@ Perl_allocmy(pTHX_ const char *const name) /* check for duplicate declaration */ pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash)); - if (PL_parser->in_my_stash && *name != '$') { - yyerror(Perl_form(aTHX_ - "Can't declare class for non-scalar %s in \"%s\"", - name, - is_our ? "our" - : PL_parser->in_my == KEY_state ? "state" : "my")); - } - /* allocate a spare slot and store the name in that slot */ off = pad_add_name(name, @@ -490,6 +484,11 @@ Perl_op_free(pTHX_ OP *o) } } + /* Call the op_free hook if it has been set. Do it now so that it's called + * at the right time for refcounted ops, but still before all of the kids + * are freed. */ + CALL_OPFREEHOOK(o); + if (o->op_flags & OPf_KIDS) { register OP *kid, *nextkid; for (kid = cUNOPo->op_first; kid; kid = nextkid) { @@ -785,8 +784,8 @@ Perl_op_refcnt_unlock(pTHX) #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) -OP * -Perl_linklist(pTHX_ OP *o) +static OP * +S_linklist(pTHX_ OP *o) { OP *first; @@ -817,8 +816,8 @@ Perl_linklist(pTHX_ OP *o) return o->op_next; } -OP * -Perl_scalarkids(pTHX_ OP *o) +static OP * +S_scalarkids(pTHX_ OP *o) { if (o && o->op_flags & OPf_KIDS) { OP *kid; @@ -874,12 +873,8 @@ Perl_scalar(pTHX_ OP *o) for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) scalar(kid); break; - case OP_SPLIT: - if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplrootu.op_pmreplroot) - deprecate_old("implicit split to @_"); - } /* FALL THROUGH */ + case OP_SPLIT: case OP_MATCH: case OP_QR: case OP_SUBST: @@ -914,8 +909,7 @@ Perl_scalar(pTHX_ OP *o) PL_curcop = &PL_compiling; break; case OP_SORT: - if (ckWARN(WARN_VOID)) - Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context"); + Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of sort in scalar context"); break; } return o; @@ -1193,20 +1187,14 @@ Perl_scalarvoid(pTHX_ OP *o) /* FALL THROUGH */ case OP_SCALAR: return scalar(o); - case OP_SPLIT: - if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplrootu.op_pmreplroot) - deprecate_old("implicit split to @_"); - } - break; } - if (useless && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless); + if (useless) + Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless); return o; } -OP * -Perl_listkids(pTHX_ OP *o) +static OP * +S_listkids(pTHX_ OP *o) { if (o && o->op_flags & OPf_KIDS) { OP *kid; @@ -1293,8 +1281,8 @@ Perl_list(pTHX_ OP *o) return o; } -OP * -Perl_scalarseq(pTHX_ OP *o) +static OP * +S_scalarseq(pTHX_ OP *o) { dVAR; if (o) { @@ -1553,12 +1541,17 @@ Perl_mod(pTHX_ OP *o, I32 type) case OP_DBSTATE: PL_modcount = RETURN_UNLIMITED_NUMBER; break; + case OP_AV2ARYLEN: + PL_hints |= HINT_BLOCK_SCOPE; + if (type == OP_LEAVESUBLV) + o->op_private |= OPpMAYBE_LVSUB; + PL_modcount++; + break; case OP_RV2SV: ref(cUNOPo->op_first, o->op_type); localize = 1; /* FALL THROUGH */ case OP_GV: - case OP_AV2ARYLEN: PL_hints |= HINT_BLOCK_SCOPE; case OP_SASSIGN: case OP_ANDASSIGN: @@ -1679,10 +1672,8 @@ Perl_mod(pTHX_ OP *o, I32 type) case 0: break; case -1: - if (ckWARN(WARN_SYNTAX)) { - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Useless localization of %s", OP_DESC(o)); - } + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Useless localization of %s", OP_DESC(o)); } } else if (type != OP_GREPSTART && type != OP_ENTERSUB @@ -1766,8 +1757,8 @@ S_is_handle_constructor(const OP *o, I32 numargs) } } -OP * -Perl_refkids(pTHX_ OP *o, I32 type) +static OP * +S_refkids(pTHX_ OP *o, I32 type) { if (o && o->op_flags & OPf_KIDS) { OP *kid; @@ -2152,14 +2143,6 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs) } OP * -Perl_my(pTHX_ OP *o) -{ - PERL_ARGS_ASSERT_MY; - - return my_attrs(o, NULL); -} - -OP * Perl_sawparens(pTHX_ OP *o) { PERL_UNUSED_CONTEXT; @@ -2346,8 +2329,7 @@ Perl_newPROG(pTHX_ OP *o) /* Register with debugger */ if (PERLDB_INTER) { - CV * const cv - = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("DB::postponed"), 0); + CV * const cv = get_cvs("DB::postponed", 0); if (cv) { dSP; PUSHMARK(SP); @@ -2434,8 +2416,8 @@ Perl_jmaybe(pTHX_ OP *o) return o; } -OP * -Perl_fold_constants(pTHX_ register OP *o) +static OP * +S_fold_constants(pTHX_ register OP *o) { dVAR; register OP * VOL curop; @@ -2575,8 +2557,8 @@ Perl_fold_constants(pTHX_ register OP *o) return o; } -OP * -Perl_gen_constant_list(pTHX_ register OP *o) +static OP * +S_gen_constant_list(pTHX_ register OP *o) { dVAR; register OP *curop; @@ -2781,7 +2763,7 @@ Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot) /* faked up qw list? */ if (slot == '(' && tm->mad_type == MAD_SV && - SvPVX((const SV *)tm->mad_val)[0] == 'q') + SvPVX((SV *)tm->mad_val)[0] == 'q') slot = 'x'; if (o) { @@ -2938,7 +2920,7 @@ Perl_newMADsv(pTHX_ char key, SV* sv) } MADPROP * -Perl_newMADPROP(pTHX_ char key, char type, const void* val, I32 vlen) +Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen) { MADPROP *mp; Newxz(mp, 1, MADPROP); @@ -2989,8 +2971,8 @@ Perl_newNULLLIST(pTHX) return newOP(OP_STUB, 0); } -OP * -Perl_force_list(pTHX_ OP *o) +static OP * +S_force_list(pTHX_ OP *o) { if (!o || o->op_type != OP_LIST) o = newLISTOP(OP_LIST, 0, o, NULL); @@ -3127,8 +3109,8 @@ static int uvcompare(const void *a, const void *b) return 0; } -OP * -Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) +static OP * +S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) { dVAR; SV * const tstr = ((SVOP*)expr)->op_sv; @@ -3356,6 +3338,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) SvREFCNT_dec(PAD_SVl(cPADOPo->op_padix)); PAD_SETSV(cPADOPo->op_padix, swash); SvPADTMP_on(swash); + SvREADONLY_on(swash); #else cSVOPo->op_sv = swash; #endif @@ -3451,6 +3434,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) } } } + + if(del && rlen == tlen) { + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); + } else if(rlen > tlen) { + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list"); + } + if (grows) o->op_private |= OPpTRANS_GROWS; #ifdef PERL_MAD @@ -3827,6 +3817,18 @@ Perl_package(pTHX_ OP *o) #endif } +void +Perl_package_version( pTHX_ OP *v ) +{ + dVAR; + U32 savehints = PL_hints; + PERL_ARGS_ASSERT_PACKAGE_VERSION; + PL_hints &= ~HINT_STRICT_VARS; + sv_setsv( GvSV(gv_fetchpvs("VERSION", GV_ADDMULTI, SVt_PV)), cSVOPx(v)->op_sv ); + PL_hints = savehints; + op_free(v); +} + #ifdef PERL_MAD OP* #else @@ -3865,7 +3867,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) SV *meth; if (version->op_type != OP_CONST || !SvNIOKp(vesv)) - Perl_croak(aTHX_ "Version number must be constant number"); + Perl_croak(aTHX_ "Version number must be a constant number"); /* Make copy of idop so we don't free it twice */ pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv)); @@ -3963,7 +3965,11 @@ PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS (or 0 for no flags). ver, if specified, provides version semantics similar to C. The optional trailing SV* arguments can be used to specify arguments to the module's import() -method, similar to C. +method, similar to C. They must be +terminated with a final NULL pointer. Note that this list can only +be omitted when the PERL_LOADMOD_NOIMPORT flag has been used. +Otherwise at least a single NULL pointer to designate the default +import list is required. =cut */ @@ -4333,7 +4339,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) ((LISTOP*)right)->op_last->op_type == OP_CONST) { SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv; - if (SvIVX(sv) == 0) + if (SvIOK(sv) && SvIVX(sv) == 0) sv_setiv(sv, PL_modcount+1); } } @@ -4355,6 +4361,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) PL_eval_start = 0; else { if (!PL_madskills) { /* assignment to $[ is ignored when making a mad dump */ + deprecate("assignment to $["); op_free(o); o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling))); o->op_private |= OPpCONST_ARYBASE; @@ -4537,8 +4544,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if ((cstop = search_const(first))) { if (cstop->op_private & OPpCONST_STRICT) no_bareword_allowed(cstop); - else if ((cstop->op_private & OPpCONST_BARE) && ckWARN(WARN_BAREWORD)) - Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); + else if ((cstop->op_private & OPpCONST_BARE)) + Perl_ck_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional"); if ((type == OP_AND && SvTRUE(((SVOP*)cstop)->op_sv)) || (type == OP_OR && !SvTRUE(((SVOP*)cstop)->op_sv)) || (type == OP_DOR && !SvOK(((SVOP*)cstop)->op_sv))) { @@ -4552,6 +4559,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) return newop; } op_free(first); + if (other->op_type == OP_LEAVE) + other = newUNOP(OP_NULL, OPf_SPECIAL, other); return other; } else { @@ -4566,11 +4575,10 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV || o2->op_type == OP_PADHV) && o2->op_private & OPpLVAL_INTRO - && !(o2->op_private & OPpPAD_STATE) - && ckWARN(WARN_DEPRECATED)) + && !(o2->op_private & OPpPAD_STATE)) { - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), - "Deprecated use of my() in false conditional"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Deprecated use of my() in false conditional"); } *otherp = NULL; @@ -4689,6 +4697,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) op_free(first); op_free(dead); } + if (live->op_type == OP_LEAVE) + live = newUNOP(OP_NULL, OPf_SPECIAL, live); return live; } NewOp(1101, logop, 1, LOGOP); @@ -4780,7 +4790,9 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) if (expr) { if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) return block; /* do {} while 0 does once */ - if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB + if (expr->op_type == OP_READLINE + || expr->op_type == OP_READDIR + || expr->op_type == OP_GLOB || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) { expr = newUNOP(OP_DEFINED, 0, newASSIGNOP(0, newDEFSVOP(), 0, expr) ); @@ -4789,7 +4801,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) const OP * const k2 = k1 ? k1->op_sibling : NULL; switch (expr->op_type) { case OP_NULL: - if (k2 && k2->op_type == OP_READLINE + if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR) && (k2->op_flags & OPf_STACKED) && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) expr = newUNOP(OP_DEFINED, 0, expr); @@ -4842,7 +4854,9 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) PERL_UNUSED_ARG(debuggable); if (expr) { - if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB + if (expr->op_type == OP_READLINE + || expr->op_type == OP_READDIR + || expr->op_type == OP_GLOB || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) { expr = newUNOP(OP_DEFINED, 0, newASSIGNOP(0, newDEFSVOP(), 0, expr) ); @@ -4851,7 +4865,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) const OP * const k2 = (k1) ? k1->op_sibling : NULL; switch (expr->op_type) { case OP_NULL: - if (k2 && k2->op_type == OP_READLINE + if (k2 && (k2->op_type == OP_READLINE || k2->op_type == OP_READDIR) && (k2->op_flags & OPf_STACKED) && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) expr = newUNOP(OP_DEFINED, 0, expr); @@ -5183,6 +5197,7 @@ S_looks_like_bool(pTHX_ const OP *o) switch(o->op_type) { case OP_OR: + case OP_DOR: return looks_like_bool(cLOGOPo->op_first); case OP_AND: @@ -5195,10 +5210,13 @@ S_looks_like_bool(pTHX_ const OP *o) o->op_flags & OPf_KIDS && looks_like_bool(cUNOPo->op_first)); + case OP_SCALAR: + return looks_like_bool(cUNOPo->op_first); + + case OP_ENTERSUB: case OP_NOT: case OP_XOR: - /* Note that OP_DOR is not here */ case OP_EQ: case OP_NE: case OP_LT: case OP_GT: case OP_LE: case OP_GE: @@ -5223,6 +5241,8 @@ S_looks_like_bool(pTHX_ const OP *o) case OP_DEFINED: case OP_EXISTS: case OP_MATCH: case OP_EOF: + case OP_FLOP: + return TRUE; case OP_CONST: @@ -5231,7 +5251,9 @@ S_looks_like_bool(pTHX_ const OP *o) || cSVOPo->op_sv == &PL_sv_no) return TRUE; - + else + return FALSE; + /* FALL THROUGH */ default: return FALSE; @@ -5516,7 +5538,6 @@ CV * Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) { dVAR; - const char *aname; GV *gv; const char *ps; STRLEN ps_len; @@ -5532,6 +5553,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) || PL_madskills) ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT; const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL; + bool has_name; if (proto) { assert(proto->op_type == OP_CONST); @@ -5540,20 +5562,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) else ps = NULL; - if (!name && PERLDB_NAMEANON && CopLINE(PL_curcop)) { + if (name) { + gv = gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV); + has_name = TRUE; + } else if (PERLDB_NAMEANON && CopLINE(PL_curcop)) { SV * const sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "%s[%s:%"IVdf"]", PL_curstash ? "__ANON__" : "__ANON__::__ANON__", CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); - aname = SvPVX_const(sv); + gv = gv_fetchsv(sv, gv_fetch_flags, SVt_PVCV); + has_name = TRUE; + } else if (PL_curstash) { + gv = gv_fetchpvs("__ANON__", gv_fetch_flags, SVt_PVCV); + has_name = FALSE; + } else { + gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV); + has_name = FALSE; } - else - aname = NULL; - - gv = name ? gv_fetchsv(cSVOPo->op_sv, gv_fetch_flags, SVt_PVCV) - : gv_fetchpv(aname ? aname - : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"), - gv_fetch_flags, SVt_PVCV); if (!PL_madskills) { if (o) @@ -5568,10 +5593,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) maximum a prototype before. */ if (SvTYPE(gv) > SVt_NULL) { if (!SvPOK((const SV *)gv) - && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1) - && ckWARN_d(WARN_PROTOTYPE)) + && !(SvIOK((const SV *)gv) && SvIVX((const SV *)gv) == -1)) { - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype"); } cv_ckproto_len((const CV *)gv, NULL, ps, ps_len); } @@ -5587,12 +5611,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) cv = (!name || GvCVGEN(gv)) ? NULL : GvCV(gv); -#ifdef GV_UNIQUE_CHECK - if (cv && GvUNIQUE(gv) && SvREADONLY(cv)) { - Perl_croak(aTHX_ "Can't define subroutine %s (GV is unique)", name); - } -#endif - if (!block || !ps || *ps || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS) #ifdef PERL_MAD @@ -5606,12 +5624,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (cv) { const bool exists = CvROOT(cv) || CvXSUB(cv); -#ifdef GV_UNIQUE_CHECK - if (exists && GvUNIQUE(gv)) { - Perl_croak(aTHX_ "Can't redefine unique subroutine %s", name); - } -#endif - /* if the subroutine doesn't exist and wasn't pre-declared * with a prototype, assume it will be AUTOLOADed, * skipping the prototype check @@ -5689,69 +5701,34 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_compcv = NULL; goto done; } - if (attrs) { - HV *stash; - SV *rcv; - - /* Need to do a C - * before we clobber PL_compcv. - */ - if (cv && (!block + if (cv) { /* must reuse cv if autoloaded */ + /* transfer PL_compcv to cv */ + if (block #ifdef PERL_MAD - || block->op_type == OP_NULL + && block->op_type != OP_NULL #endif - )) { - rcv = MUTABLE_SV(cv); - /* Might have had built-in attributes applied -- propagate them. */ - CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS); - if (CvGV(cv) && GvSTASH(CvGV(cv))) - stash = GvSTASH(CvGV(cv)); - else if (CvSTASH(cv)) - stash = CvSTASH(cv); - else - stash = PL_curstash; + ) { + cv_undef(cv); + CvFLAGS(cv) = CvFLAGS(PL_compcv); + if (!CvWEAKOUTSIDE(cv)) + SvREFCNT_dec(CvOUTSIDE(cv)); + CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv); + CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv); + CvOUTSIDE(PL_compcv) = 0; + CvPADLIST(cv) = CvPADLIST(PL_compcv); + CvPADLIST(PL_compcv) = 0; + /* inner references to PL_compcv must be fixed up ... */ + pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv); + if (PERLDB_INTER)/* Advice debugger on the new sub. */ + ++PL_sub_generation; } else { - /* possibly about to re-define existing subr -- ignore old cv */ - rcv = MUTABLE_SV(PL_compcv); - if (name && GvSTASH(gv)) - stash = GvSTASH(gv); - else - stash = PL_curstash; - } - apply_attrs(stash, rcv, attrs, FALSE); - } - if (cv) { /* must reuse cv if autoloaded */ - if ( -#ifdef PERL_MAD - ( -#endif - !block -#ifdef PERL_MAD - || block->op_type == OP_NULL) && !PL_madskills -#endif - ) { - /* got here with just attrs -- work done, so bug out */ - SAVEFREESV(PL_compcv); - goto done; + /* Might have had built-in attributes applied -- propagate them. */ + CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS); } - /* transfer PL_compcv to cv */ - cv_undef(cv); - CvFLAGS(cv) = CvFLAGS(PL_compcv); - if (!CvWEAKOUTSIDE(cv)) - SvREFCNT_dec(CvOUTSIDE(cv)); - CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv); - CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv); - CvOUTSIDE(PL_compcv) = 0; - CvPADLIST(cv) = CvPADLIST(PL_compcv); - CvPADLIST(PL_compcv) = 0; - /* inner references to PL_compcv must be fixed up ... */ - pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv); /* ... before we throw it away */ SvREFCNT_dec(PL_compcv); PL_compcv = cv; - if (PERLDB_INTER)/* Advice debugger on the new sub. */ - ++PL_sub_generation; } else { cv = PL_compcv; @@ -5767,9 +5744,16 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */ } } - CvGV(cv) = gv; - CvFILE_set_from_cop(cv, PL_curcop); - CvSTASH(cv) = PL_curstash; + if (!CvGV(cv)) { + CvGV(cv) = gv; + CvFILE_set_from_cop(cv, PL_curcop); + CvSTASH(cv) = PL_curstash; + } + if (attrs) { + /* Need to do a C. */ + HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash; + apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE); + } if (ps) sv_setpvn(MUTABLE_SV(cv), ps, ps_len); @@ -5797,6 +5781,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (!block) goto done; + /* If we assign an optree to a PVCV, then we've defined a subroutine that + the debugger could be able to set a breakpoint in, so signal to + pp_entereval that it should not throw away any saved lines at scope + exit. */ + + PL_breakable_sub_gen++; if (CvLVALUE(cv)) { CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, mod(scalarseq(block), OP_LEAVESUBLV)); @@ -5833,7 +5823,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) CvCONST_on(cv); } - if (name || aname) { + if (has_name) { if (PERLDB_SUBLINE && PL_curstash != PL_debstash) { SV * const sv = newSV(0); SV * const tmpstr = sv_newmortal(); @@ -5914,18 +5904,18 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv, return; } else if (*name == 'C') { if (strEQ(name, "CHECK")) { - if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ packWARN(WARN_VOID), - "Too late to run CHECK block"); + if (PL_main_start) + Perl_ck_warner(aTHX_ packWARN(WARN_VOID), + "Too late to run CHECK block"); Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, MUTABLE_SV(cv)); } else return; } else if (*name == 'I') { if (strEQ(name, "INIT")) { - if (PL_main_start && ckWARN(WARN_VOID)) - Perl_warner(aTHX_ packWARN(WARN_VOID), - "Too late to run INIT block"); + if (PL_main_start) + Perl_ck_warner(aTHX_ packWARN(WARN_VOID), + "Too late to run INIT block"); Perl_av_create_and_push(aTHX_ &PL_initav, MUTABLE_SV(cv)); } else @@ -5943,6 +5933,11 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv, Creates a constant sub equivalent to Perl C which is eligible for inlining at compile-time. +Passing NULL for SV creates a constant sub equivalent to C, +which won't be called if used as a destructor, but will suppress the overhead +of a call to C. (This form, however, isn't eligible for inlining at +compile time.) + =cut */ @@ -5952,14 +5947,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv) dVAR; CV* cv; #ifdef USE_ITHREADS - const char *const temp_p = CopFILE(PL_curcop); - const STRLEN len = temp_p ? strlen(temp_p) : 0; + const char *const file = CopFILE(PL_curcop); #else SV *const temp_sv = CopFILESV(PL_curcop); - STRLEN len; - const char *const temp_p = temp_sv ? SvPV_const(temp_sv, len) : NULL; + const char *const file = temp_sv ? SvPV_nolen_const(temp_sv) : NULL; #endif - char *const file = savepvn(temp_p, temp_p ? len : 0); ENTER; @@ -5987,10 +5979,10 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv) and so doesn't get free()d. (It's expected to be from the C pre- processor __FILE__ directive). But we need a dynamically allocated one, and we need it to get freed. */ - cv = newXS_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME); + cv = newXS_flags(name, const_sv_xsub, file ? file : "", "", + XS_DYNAMIC_FILENAME); CvXSUBANY(cv).any_ptr = sv; CvCONST_on(cv); - Safefree(file); #ifdef USE_ITHREADS if (stash) @@ -6146,20 +6138,19 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM) : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM); -#ifdef GV_UNIQUE_CHECK - if (GvUNIQUE(gv)) { - Perl_croak(aTHX_ "Bad symbol for form (GV is unique)"); - } -#endif GvMULTI_on(gv); if ((cv = GvFORM(gv))) { if (ckWARN(WARN_REDEFINE)) { const line_t oldline = CopLINE(PL_curcop); if (PL_parser && PL_parser->copline != NOLINE) CopLINE_set(PL_curcop, PL_parser->copline); - Perl_warner(aTHX_ packWARN(WARN_REDEFINE), - o ? "Format %"SVf" redefined" - : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv)); + if (o) { + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), + "Format %"SVf" redefined", SVfARG(cSVOPo->op_sv)); + } else { + Perl_warner(aTHX_ packWARN(WARN_REDEFINE), + "Format STDOUT redefined"); + } CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); @@ -6237,8 +6228,7 @@ Perl_oopsAV(pTHX_ OP *o) break; default: - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsAV"); break; } return o; @@ -6266,8 +6256,7 @@ Perl_oopsHV(pTHX_ OP *o) break; default: - if (ckWARN_d(WARN_INTERNAL)) - Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "oops: oopsHV"); break; } return o; @@ -6285,10 +6274,9 @@ Perl_newAVREF(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_PADAV]; return o; } - else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV) - && ckWARN(WARN_DEPRECATED)) { - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), - "Using an array as a reference is deprecated"); + else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Using an array as a reference is deprecated"); } return newUNOP(OP_RV2AV, 0, scalar(o)); } @@ -6313,10 +6301,9 @@ Perl_newHVREF(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_PADHV]; return o; } - else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV) - && ckWARN(WARN_DEPRECATED)) { - Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), - "Using a hash as a reference is deprecated"); + else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Using a hash as a reference is deprecated"); } return newUNOP(OP_RV2HV, 0, scalar(o)); } @@ -6383,12 +6370,11 @@ Perl_ck_bitop(pTHX_ OP *o) (left->op_flags & OPf_PARENS) == 0) || (OP_IS_NUMCOMPARE(right->op_type) && (right->op_flags & OPf_PARENS) == 0)) - if (ckWARN(WARN_PRECEDENCE)) - Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE), - "Possible precedence problem on bitwise %c operator", - o->op_type == OP_BIT_OR ? '|' - : o->op_type == OP_BIT_AND ? '&' : '^' - ); + Perl_ck_warner(aTHX_ packWARN(WARN_PRECEDENCE), + "Possible precedence problem on bitwise %c operator", + o->op_type == OP_BIT_OR ? '|' + : o->op_type == OP_BIT_AND ? '&' : '^' + ); } return o; } @@ -6464,6 +6450,8 @@ Perl_ck_delete(pTHX_ OP *o) Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice", OP_DESC(o)); } + if (kid->op_private & OPpLVAL_INTRO) + o->op_private |= OPpLVAL_INTRO; op_null(kid); } return o; @@ -6537,6 +6525,8 @@ Perl_ck_eval(pTHX_ OP *o) /* establish postfix order */ enter->op_next = (OP*)enter; + CHECKOP(OP_ENTERTRY, enter); + o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid); o->op_type = OP_LEAVETRY; o->op_ppaddr = PL_ppaddr[OP_LEAVETRY]; @@ -6855,20 +6845,19 @@ Perl_ck_fun(pTHX_ OP *o) break; case OA_AVREF: if ((type == OP_PUSH || type == OP_UNSHIFT) - && !kid->op_sibling && ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), - "Useless use of %s with no values", - PL_op_desc[type]); + && !kid->op_sibling) + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), + "Useless use of %s with no values", + PL_op_desc[type]); if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { OP * const newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVAV) )); - if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Array @%"SVf" missing the @ in argument %"IVdf" of %s()", - SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Array @%"SVf" missing the @ in argument %"IVdf" of %s()", + SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD op_getmad(kid,newop,'K'); #else @@ -6888,10 +6877,9 @@ Perl_ck_fun(pTHX_ OP *o) { OP * const newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVHV) )); - if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()", - SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()", + SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD op_getmad(kid,newop,'K'); #else @@ -7227,7 +7215,7 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ { PERL_ARGS_ASSERT_CK_DEFINED; - if ((o->op_flags & OPf_KIDS) && ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) { + if ((o->op_flags & OPf_KIDS)) { switch (cUNOPo->op_first->op_type) { case OP_RV2AV: /* This is needed for @@ -7237,22 +7225,17 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ break; /* Globals via GV can be undef */ case OP_PADAV: case OP_AASSIGN: /* Is this a good idea? */ - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "defined(@array) is deprecated"); - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "\t(Maybe you should just omit the defined()?)\n"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "defined(@array) is deprecated"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "\t(Maybe you should just omit the defined()?)\n"); break; case OP_RV2HV: - /* This is needed for - if (defined %stash::) - to work. Do not break Tk. - */ - break; /* Globals via GV can be undef */ case OP_PADHV: - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "defined(%%hash) is deprecated"); - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "\t(Maybe you should just omit the defined()?)\n"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "defined(%%hash) is deprecated"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), + "\t(Maybe you should just omit the defined()?)\n"); break; default: /* no warning */ @@ -7629,14 +7612,29 @@ OP * Perl_ck_return(pTHX_ OP *o) { dVAR; + OP *kid; PERL_ARGS_ASSERT_CK_RETURN; + kid = cLISTOPo->op_first->op_sibling; if (CvLVALUE(PL_compcv)) { - OP *kid; - for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling) + for (; kid; kid = kid->op_sibling) mod(kid, OP_LEAVESUBLV); + } else { + for (; kid; kid = kid->op_sibling) + if ((kid->op_type == OP_NULL) + && ((kid->op_flags & (OPf_SPECIAL|OPf_KIDS)) == (OPf_SPECIAL|OPf_KIDS))) { + /* This is a do block */ + OP *op = kUNOP->op_first; + if (op->op_type == OP_LEAVE && op->op_flags & OPf_KIDS) { + op = cUNOPx(op)->op_first; + assert(op->op_type == OP_ENTER && !(op->op_flags & OPf_SPECIAL)); + /* Force the use of the caller's context */ + op->op_flags |= OPf_SPECIAL; + } + } } + return o; } @@ -7673,20 +7671,15 @@ Perl_ck_shift(pTHX_ OP *o) PERL_ARGS_ASSERT_CK_SHIFT; if (!(o->op_flags & OPf_KIDS)) { - OP *argop; - /* FIXME - this can be refactored to reduce code in #ifdefs */ -#ifdef PERL_MAD - OP * const oldo = o; -#else - op_free(o); -#endif - argop = newUNOP(OP_RV2AV, 0, + OP *argop = newUNOP(OP_RV2AV, 0, scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv))); #ifdef PERL_MAD + OP * const oldo = o; o = newUNOP(type, 0, scalar(argop)); op_getmad(oldo,o,'O'); return o; #else + op_free(o); return newUNOP(type, 0, scalar(argop)); #endif } @@ -7885,9 +7878,9 @@ Perl_ck_split(pTHX_ OP *o) kid->op_type = OP_PUSHRE; kid->op_ppaddr = PL_ppaddr[OP_PUSHRE]; scalar(kid); - if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL && ckWARN(WARN_REGEXP)) { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), - "Use of /g modifier is meaningless in split"); + if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) { + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), + "Use of /g modifier is meaningless in split"); } if (!kid->op_sibling) @@ -7919,7 +7912,7 @@ Perl_ck_join(pTHX_ OP *o) if (kid && kid->op_type == OP_MATCH) { if (ckWARN(WARN_SYNTAX)) { const REGEXP *re = PM_GETRE(kPMOP); - const char *pmstr = re ? RX_PRECOMP(re) : "STRING"; + const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING"; const STRLEN len = re ? RX_PRELEN(re) : 6; Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "/%.*s/ should probably be written as \"%.*s\"", @@ -8267,25 +8260,54 @@ OP * Perl_ck_each(pTHX_ OP *o) { dVAR; - OP *kid = cLISTOPo->op_first; + OP *kid = o->op_flags & OPf_KIDS ? cLISTOPo->op_first : NULL; PERL_ARGS_ASSERT_CK_EACH; - if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) { - const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH - : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES; - o->op_type = new_type; - o->op_ppaddr = PL_ppaddr[new_type]; - } - else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV - || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) - )) { - bad_type(1, "hash or array", PL_op_desc[o->op_type], kid); - return o; + if (kid) { + if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) { + const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH + : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES; + o->op_type = new_type; + o->op_ppaddr = PL_ppaddr[new_type]; + } + else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV + || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) + )) { + bad_type(1, "hash or array", PL_op_desc[o->op_type], kid); + return o; + } } return ck_fun(o); } +/* caller is supposed to assign the return to the + container of the rep_op var */ +OP * +S_opt_scalarhv(pTHX_ OP *rep_op) { + UNOP *unop; + + PERL_ARGS_ASSERT_OPT_SCALARHV; + + NewOp(1101, unop, 1, UNOP); + unop->op_type = (OPCODE)OP_BOOLKEYS; + unop->op_ppaddr = PL_ppaddr[OP_BOOLKEYS]; + unop->op_flags = (U8)(OPf_WANT_SCALAR | OPf_KIDS ); + unop->op_private = (U8)(1 | ((OPf_WANT_SCALAR | OPf_KIDS) >> 8)); + unop->op_first = rep_op; + unop->op_next = rep_op->op_next; + rep_op->op_next = (OP*)unop; + rep_op->op_flags|=(OPf_REF | OPf_MOD); + unop->op_sibling = rep_op->op_sibling; + rep_op->op_sibling = NULL; + /* unop->op_targ = pad_alloc(OP_BOOLKEYS, SVs_PADTMP); */ + if (rep_op->op_type == OP_PADHV) { + rep_op->op_flags &= ~OPf_WANT_SCALAR; + rep_op->op_flags |= OPf_WANT_LIST; + } + return (OP*)unop; +} + /* A peephole optimizer. We visit the ops in the order they're to execute. * See the comments at the top of this file for more details about when * peep() is called */ @@ -8472,12 +8494,67 @@ Perl_peep(pTHX_ register OP *o) } break; + + { + OP *fop; + OP *sop; + + case OP_NOT: + fop = cUNOP->op_first; + sop = NULL; + goto stitch_keys; + break; - case OP_MAPWHILE: - case OP_GREPWHILE: - case OP_AND: + case OP_AND: case OP_OR: case OP_DOR: + fop = cLOGOP->op_first; + sop = fop->op_sibling; + while (cLOGOP->op_other->op_type == OP_NULL) + cLOGOP->op_other = cLOGOP->op_other->op_next; + peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */ + + stitch_keys: + o->op_opt = 1; + if ((fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV) + || ( sop && + (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV) + ) + ){ + OP * nop = o; + OP * lop = o; + if (!(nop->op_flags && OPf_WANT_VOID)) { + while (nop && nop->op_next) { + switch (nop->op_next->op_type) { + case OP_NOT: + case OP_AND: + case OP_OR: + case OP_DOR: + lop = nop = nop->op_next; + break; + case OP_NULL: + nop = nop->op_next; + break; + default: + nop = NULL; + break; + } + } + } + if (lop->op_flags && OPf_WANT_VOID) { + if (fop->op_type == OP_PADHV || fop->op_type == OP_RV2HV) + cLOGOP->op_first = opt_scalarhv(fop); + if (sop && (sop->op_type == OP_PADHV || sop->op_type == OP_RV2HV)) + cLOGOP->op_first->op_sibling = opt_scalarhv(sop); + } + } + + + break; + } + + case OP_MAPWHILE: + case OP_GREPWHILE: case OP_ANDASSIGN: case OP_ORASSIGN: case OP_DORASSIGN: @@ -8543,7 +8620,7 @@ Perl_peep(pTHX_ register OP *o) /* Make the CONST have a shared SV */ svp = cSVOPx_svp(((BINOP*)o)->op_last); - if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) { + if (!SvFAKE(sv = *svp) || !SvREADONLY(sv)) { key = SvPV_const(sv, keylen); lexname = newSVpvn_share(key, SvUTF8(sv) ? -(I32)keylen : (I32)keylen, @@ -8948,15 +9025,20 @@ const_sv_xsub(pTHX_ CV* cv) { dVAR; dXSARGS; + SV *const sv = MUTABLE_SV(XSANY.any_ptr); if (items != 0) { NOOP; #if 0 + /* diag_listed_as: SKIPME */ Perl_croak(aTHX_ "usage: %s::%s()", HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv))); #endif } + if (!sv) { + XSRETURN(0); + } EXTEND(sp, 1); - ST(0) = MUTABLE_SV(XSANY.any_ptr); + ST(0) = sv; XSRETURN(1); }