X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=edd1ad245116285b722d1cb43f8b73a9c9ba6a67;hb=701a277b5182d929c4baa83d419c46c6d08d2101;hp=ea5d922a27156a77461b482dcc4b2dee3f49da2e;hpb=d2c45030dc616f5607567f346c626dee604321c0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index ea5d922..edd1ad2 100644 --- a/op.c +++ b/op.c @@ -24,10 +24,10 @@ /* #define PL_OP_SLAB_ALLOC */ -#ifdef PL_OP_SLAB_ALLOC +#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT) #define SLAB_SIZE 8192 -static char *PL_OpPtr = NULL; -static int PL_OpSpace = 0; +static char *PL_OpPtr = NULL; /* XXX threadead */ +static int PL_OpSpace = 0; /* XXX threadead */ #define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0) \ var = (type *)(PL_OpPtr -= c*sizeof(type)); \ else \ @@ -1024,6 +1024,9 @@ Perl_scalar(pTHX_ OP *o) } WITH_THR(PL_curcop = &PL_compiling); break; + case OP_SORT: + if (ckWARN(WARN_VOID)) + Perl_warner(aTHX_ WARN_VOID, "Useless use of sort in scalar context"); } return o; } @@ -1670,6 +1673,14 @@ Perl_mod(pTHX_ OP *o, I32 type) goto nomod; break; /* mod()ing was handled by ck_return() */ } + + /* [20011101.069] File test operators interpret OPf_REF to mean that + their argument is a filehandle; thus \stat(".") should not set + it. AMS 20011102 */ + if (type == OP_REFGEN && + PL_check[o->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst)) + return o; + if (type != OP_LEAVESUBLV) o->op_flags |= OPf_MOD; @@ -3297,7 +3308,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) /* Fake up a method call to import/unimport */ meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);; - sv_upgrade(meth, SVt_PVIV); + (void)SvUPGRADE(meth, SVt_PVIV); (void)SvIOK_on(meth); PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth)); imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, @@ -3420,10 +3431,10 @@ Perl_dofile(pTHX_ OP *term) GV *gv; gv = gv_fetchpv("do", FALSE, SVt_PVCV); - if (!(gv && GvIMPORTED_CV(gv))) + if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV); - if (gv && GvIMPORTED_CV(gv)) { + if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED, append_elem(OP_LIST, term, scalar(newUNOP(OP_RV2CV, 0, @@ -3687,10 +3698,10 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) if (PERLDB_LINE && PL_curstash != PL_debstash) { SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); - if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) { - (void)SvIOK_on(*svp); + if (svp && *svp != &PL_sv_undef ) { + (void)SvIOK_on(*svp); SvIVX(*svp) = PTR2IV(cop); - } + } } return prepend_elem(OP_LINESEQ, (OP*)cop, o); @@ -4249,15 +4260,9 @@ Perl_cv_undef(pTHX_ CV *cv) * CV, they don't hold a refcount on the outside CV. This avoids * the refcount loop between the outer CV (which keeps a refcount to * the closure prototype in the pad entry for pp_anoncode()) and the - * closure prototype, and the ensuing memory leak. This does not - * apply to closures generated within eval"", since eval"" CVs are - * ephemeral. --GSAR */ - if (!CvANON(cv) || CvCLONED(cv) - || (CvOUTSIDE(cv) && SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV - && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) - { + * closure prototype, and the ensuing memory leak. --GSAR */ + if (!CvANON(cv) || CvCLONED(cv)) SvREFCNT_dec(CvOUTSIDE(cv)); - } CvOUTSIDE(cv) = Nullcv; if (CvCONST(cv)) { SvREFCNT_dec((SV*)CvXSUBANY(cv).any_ptr); @@ -4904,17 +4909,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } - /* If a potential closure prototype, don't keep a refcount on - * outer CV, unless the latter happens to be a passing eval"". + /* If a potential closure prototype, don't keep a refcount on outer CV. * This is okay as the lifetime of the prototype is tied to the * lifetime of the outer CV. Avoids memory leak due to reference * loop. --GSAR */ - if (!name && CvOUTSIDE(cv) - && !(SvTYPE(CvOUTSIDE(cv)) == SVt_PVCV - && CvEVAL(CvOUTSIDE(cv)) && !CvGV(CvOUTSIDE(cv)))) - { + if (!name) SvREFCNT_dec(CvOUTSIDE(cv)); - } if (name || aname) { char *s; @@ -5443,6 +5443,15 @@ Perl_ck_delete(pTHX_ OP *o) } OP * +Perl_ck_die(pTHX_ OP *o) +{ +#ifdef VMS + if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH; +#endif + return ck_fun(o); +} + +OP * Perl_ck_eof(pTHX_ OP *o) { I32 type = o->op_type; @@ -5511,6 +5520,7 @@ Perl_ck_exit(pTHX_ OP *o) if (svp && *svp && SvTRUE(*svp)) o->op_private |= OPpEXIT_VMSISH; } + if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH; #endif return ck_fun(o); } @@ -5919,8 +5929,11 @@ Perl_ck_glob(pTHX_ OP *o) if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) append_elem(OP_GLOB, o, newDEFSVOP()); - if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv))) + if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) + && GvCVu(gv) && GvIMPORTED_CV(gv))) + { gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); + } #if !defined(PERL_EXTERNAL_GLOB) /* XXX this can be tightened up and made more failsafe. */ @@ -5938,7 +5951,7 @@ Perl_ck_glob(pTHX_ OP *o) } #endif /* PERL_EXTERNAL_GLOB */ - if (gv && GvIMPORTED_CV(gv)) { + if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { append_elem(OP_GLOB, o, newSVOP(OP_CONST, 0, newSViv(PL_glob_index++))); o->op_type = OP_LIST; @@ -6249,10 +6262,10 @@ Perl_ck_require(pTHX_ OP *o) /* handle override, if any */ gv = gv_fetchpv("require", FALSE, SVt_PVCV); - if (!(gv && GvIMPORTED_CV(gv))) + if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV); - if (gv && GvIMPORTED_CV(gv)) { + if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) { OP *kid = cUNOPo->op_first; cUNOPo->op_first = 0; op_free(o);