X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=e781dcc0d54d601917406e3cbde47368edf5909a;hb=f48583aa2d2b7c9a2c44c530083c6fdd7e6f9713;hp=15ba94c041ce65b0bd7f78904a09256ded839bc2;hpb=51d9a56bf5df931c436b7ede535c78bc64655187;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 15ba94c..e781dcc 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,6 +1,7 @@ /* pp_hot.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -807,7 +808,7 @@ PP(pp_rv2hv) RETURN; } else if (LVRET) { - if (GIMME == G_SCALAR) + if (GIMME != G_SCALAR) Perl_croak(aTHX_ "Can't return hash to lvalue scalar context"); SETs((SV*)hv); RETURN; @@ -1233,7 +1234,7 @@ PP(pp_match) if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; - if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + if ((pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { SAVEINT(PL_multiline); PL_multiline = pm->op_pmflags & PMf_MULTILINE; } @@ -1496,7 +1497,7 @@ Perl_do_readline(pTHX) /* undef TARG, and push that undefined value */ if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST_COW_DROP(TARG); - SvOK_off(TARG); + (void)SvOK_off(TARG); } PUSHTARG; } @@ -1509,7 +1510,7 @@ Perl_do_readline(pTHX) sv_unref(sv); (void)SvUPGRADE(sv, SVt_PV); tmplen = SvLEN(sv); /* remember if already alloced */ - if (!tmplen) + if (!tmplen && !SvREADONLY(sv)) Sv_Grow(sv, 80); /* try short-buffering it */ offset = 0; if (type == OP_RCATLINE && SvOK(sv)) { @@ -1560,7 +1561,7 @@ Perl_do_readline(pTHX) if (gimme == G_SCALAR) { if (type != OP_RCATLINE) { SV_CHECK_THINKFIRST_COW_DROP(TARG); - SvOK_off(TARG); + (void)SvOK_off(TARG); } SPAGAIN; PUSHTARG; @@ -1858,6 +1859,12 @@ PP(pp_iter) else { sv = AvARRAY(av)[++cx->blk_loop.iterix]; } + if (sv && SvREFCNT(sv) == 0) { + *itersvp = Nullsv; + Perl_croak(aTHX_ + "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)"); + } + if (sv) SvTEMP_off(sv); else @@ -1972,7 +1979,7 @@ PP(pp_subst) ? REXEC_COPY_STR : 0; if (SvSCREAM(TARG)) r_flags |= REXEC_SCREAM; - if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + if ((pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { SAVEINT(PL_multiline); PL_multiline = pm->op_pmflags & PMf_MULTILINE; } @@ -2154,6 +2161,7 @@ PP(pp_subst) if (!c) { register PERL_CONTEXT *cx; SPAGAIN; + ReREFCNT_inc(rx); PUSHSUBST(cx); RETURNOP(cPMOP->op_pmreplroot); } @@ -2926,8 +2934,18 @@ S_method_common(pTHX_ SV* meth, U32* hashp) /* this isn't a reference */ packname = Nullch; + + if(SvOK(sv) && (packname = SvPV(sv, packlen))) { + HE* he; + he = hv_fetch_ent(PL_stashcache, sv, 0, 0); + if (he) { + stash = INT2PTR(HV*,SvIV(HeVAL(he))); + goto fetch; + } + } + if (!SvOK(sv) || - !(packname = SvPV(sv, packlen)) || + !(packname) || !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) || !(ob=(SV*)GvIO(iogv))) { @@ -2946,6 +2964,10 @@ S_method_common(pTHX_ SV* meth, U32* hashp) stash = gv_stashpvn(packname, packlen, FALSE); if (!stash) packsv = sv; + else { + SV* ref = newSViv(PTR2IV(stash)); + hv_store(PL_stashcache, packname, packlen, ref, 0); + } goto fetch; } /* it _is_ a filehandle name -- replace with a reference */ @@ -3002,7 +3024,11 @@ S_method_common(pTHX_ SV* meth, U32* hashp) /* the method name is unqualified or starts with SUPER:: */ packname = sep ? CopSTASHPV(PL_curcop) : stash ? HvNAME(stash) : packname; - packlen = strlen(packname); + if (!packname) + Perl_croak(aTHX_ + "Can't use anonymous symbol table for method lookup"); + else + packlen = strlen(packname); } else { /* the method name is qualified */