Illegal cpp.
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index 15ba94c..e781dcc 100644 (file)
--- 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 */