$\1 and serious bug in evalling

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index 97f9c75..f8f4362 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -426,8 +426,6 @@ PP(pp_rv2av)
        av = (AV*)SvRV(sv);
        if (SvTYPE(av) != SVt_PVAV)
            DIE("Not an ARRAY reference");
-       if (op->op_private & OPpLVAL_INTRO)
-           av = (AV*)save_svref((SV**)sv);
        if (op->op_flags & OPf_REF) {
            PUSHs((SV*)av);
            RETURN;
@@ -503,8 +501,6 @@ PP(pp_rv2hv)
        hv = (HV*)SvRV(sv);
        if (SvTYPE(hv) != SVt_PVHV)
            DIE("Not a HASH reference");
-       if (op->op_private & OPpLVAL_INTRO)
-           hv = (HV*)save_svref((SV**)sv);
        if (op->op_flags & OPf_REF) {
            SETs((SV*)hv);
            RETURN;
@@ -564,10 +560,9 @@ PP(pp_rv2hv)
     }
     else {
        dTARGET;
-       if (HvFILL(hv)) {
-           sprintf(buf, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv)+1);
-           sv_setpv(TARG, buf);
-       }
+       if (HvFILL(hv))
+           sv_setpvf(TARG, "%ld/%ld",
+                     (long)HvFILL(hv), (long)HvMAX(hv) + 1);
        else
            sv_setiv(TARG, 0);
        SETTARG;
@@ -603,8 +598,10 @@ PP(pp_aassign)
     if (op->op_private & OPpASSIGN_COMMON) {
         for (relem = firstrelem; relem <= lastrelem; relem++) {
             /*SUPPRESS 560*/
-            if (sv = *relem)
+            if (sv = *relem) {
+               TAINT_NOT;      /* Each item is independent */
                 *relem = sv_mortalcopy(sv);
+           }
         }
     }
 
@@ -624,13 +621,17 @@ PP(pp_aassign)
            av_extend(ary, lastrelem - relem);
            i = 0;
            while (relem <= lastrelem) {        /* gobble up all the rest */
+               SV **didstore;
                sv = NEWSV(28,0);
                assert(*relem);
                sv_setsv(sv,*relem);
                *(relem++) = sv;
-               (void)av_store(ary,i++,sv);
-               if (magic)
+               didstore = av_store(ary,i++,sv);
+               if (magic) {
                    mg_set(sv);
+                   if (!didstore)
+                       SvREFCNT_dec(sv);
+               }
                TAINT_NOT;
            }
            break;
@@ -643,6 +644,7 @@ PP(pp_aassign)
 
                while (relem < lastrelem) {     /* gobble up all the rest */
                    STRLEN len;
+                   HE *didstore;
                    if (*relem)
                        sv = *(relem++);
                    else
@@ -651,9 +653,12 @@ PP(pp_aassign)
                    if (*relem)
                        sv_setsv(tmpstr,*relem);        /* value */
                    *(relem++) = tmpstr;
-                   (void)hv_store_ent(hash,sv,tmpstr,0);
-                   if (magic)
+                   didstore = hv_store_ent(hash,sv,tmpstr,0);
+                   if (magic) {
                        mg_set(tmpstr);
+                       if (!didstore)
+                           SvREFCNT_dec(tmpstr);
+                   }
                    TAINT_NOT;
                }
                if (relem == lastrelem)
@@ -963,6 +968,13 @@ nope:
        ++BmUSEFUL(pm->op_pmshort);
 
 ret_no:
+    if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
+       if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
+           MAGIC* mg = mg_find(TARG, 'g');
+           if (mg)
+               mg->mg_len = -1;
+       }
+    }
     LEAVE_SCOPE(oldsave);
     if (gimme == G_ARRAY)
        RETURN;
@@ -1314,6 +1326,7 @@ PP(pp_leave)
            gimme = G_SCALAR;
     }
 
+    TAINT_NOT;
     if (gimme == G_VOID)
        SP = newsp;
     else if (gimme == G_SCALAR) {
@@ -1330,10 +1343,13 @@ PP(pp_leave)
        SP = MARK;
     }
     else if (gimme == G_ARRAY) {
-       for (mark = newsp + 1; mark <= SP; mark++)
-           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
+       /* in case LEAVE wipes old return values */
+       for (mark = newsp + 1; mark <= SP; mark++) {
+           if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
                *mark = sv_mortalcopy(*mark);
-               /* in case LEAVE wipes old return values */
+               TAINT_NOT;      /* Each item is independent */
+           }
+       }
     }
     curpm = newpm;     /* Don't pop $1 et al till now */
 
@@ -1694,6 +1710,7 @@ PP(pp_leavesub)
     POPBLOCK(cx,newpm);
     POPSUB1(cx);       /* Delay POPSUB2 until stack values are safe */
  
+    TAINT_NOT;
     if (gimme == G_SCALAR) {
        MARK = newsp + 1;
        if (MARK <= SP)
@@ -1706,8 +1723,10 @@ PP(pp_leavesub)
     }
     else if (gimme == G_ARRAY) {
        for (MARK = newsp + 1; MARK <= SP; MARK++) {
-           if (!SvTEMP(*MARK))
+           if (!SvTEMP(*MARK)) {
                *MARK = sv_mortalcopy(*MARK);
+               TAINT_NOT;      /* Each item is independent */
+           }
        }
     }
     PUTBACK;
@@ -2065,61 +2084,64 @@ PP(pp_method)
     SV* sv;
     SV* ob;
     GV* gv;
-    SV* nm;
+    HV* stash;
+    char* name;
+    char* packname;
+    STRLEN packlen;
 
-    nm = TOPs;
+    name = SvPV(TOPs, na);
     sv = *(stack_base + TOPMARK + 1);
     
-    gv = 0;
     if (SvGMAGICAL(sv))
         mg_get(sv);
     if (SvROK(sv))
        ob = (SV*)SvRV(sv);
     else {
        GV* iogv;
-       char* packname = 0;
-       STRLEN packlen;
 
+       packname = Nullch;
        if (!SvOK(sv) ||
            !(packname = SvPV(sv, packlen)) ||
            !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
            !(ob=(SV*)GvIO(iogv)))
        {
-           char *name = SvPV(nm, na);
-           HV *stash;
-           if (!packname || !isALPHA(*packname))
-DIE("Can't call method \"%s\" without a package or object reference", name);
-           if (!(stash = gv_stashpvn(packname, packlen, FALSE))) {
-               if (gv_stashpvn("UNIVERSAL", 9, FALSE))
-                   stash = gv_stashpvn(packname, packlen, TRUE);
-               else
-                   DIE("Can't call method \"%s\" in empty package \"%s\"",
-                       name, packname);
-           }
-           gv = gv_fetchmethod(stash,name);
-           if (!gv)
-               DIE("Can't locate object method \"%s\" via package \"%s\"",
-                   name, packname);
-           SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
-           RETURN;
+           if (!packname || !isIDFIRST(*packname))
+  DIE("Can't call method \"%s\" without a package or object reference", name);
+           stash = gv_stashpvn(packname, packlen, TRUE);
+           goto fetch;
        }
        *(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
     }
 
-    if (!ob || !SvOBJECT(ob)) {
-       char *name = SvPV(nm, na);
+    if (!ob || !SvOBJECT(ob))
        DIE("Can't call method \"%s\" on unblessed reference", name);
-    }
 
-    if (!gv) {         /* nothing cached */
-       char *name = SvPV(nm, na);
-       gv = gv_fetchmethod(SvSTASH(ob),name);
-       if (!gv)
-           DIE("Can't locate object method \"%s\" via package \"%s\"",
-               name, HvNAME(SvSTASH(ob)));
-    }
+    stash = SvSTASH(ob);
+
+  fetch:
+    gv = gv_fetchmethod(stash, name);
+    if (!gv) {
+       char* leaf = name;
+       char* sep = Nullch;
+       char* p;
 
+       for (p = name; *p; p++) {
+           if (*p == '\'')
+               sep = p, leaf = p + 1;
+           else if (*p == ':' && *(p + 1) == ':')
+               sep = p, leaf = p + 2;
+       }
+       if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
+           packname = HvNAME(sep ? curcop->cop_stash : stash);
+           packlen = strlen(packname);
+       }
+       else {
+           packname = name;
+           packlen = sep - name;
+       }
+       DIE("Can't locate object method \"%s\" via package \"%.*s\"",
+           leaf, (int)packlen, packname);
+    }
     SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
     RETURN;
 }
-