perl 5.002beta2 patch: toke.c

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

diff --git a/pp_hot.c b/pp_hot.c
index 2628c3a..13e7c25 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -144,12 +144,16 @@ PP(pp_concat)
     dPOPTOPssrl;
     STRLEN len;
     char *s;
+    if (SvGMAGICAL(left))
+        mg_get(left);
     if (TARG != left) {
        s = SvPV(left,len);
        sv_setpvn(TARG,s,len);
     }
-    else if (!SvOK(TARG))
+    else if (!SvOK(TARG)) {
+       s = SvPV_force(TARG, len);
        sv_setpv(TARG, "");     /* Suppress warning. */
+    }
     s = SvPV(right,len);
     sv_catpvn(TARG,s,len);
     SETTARG;
@@ -161,8 +165,24 @@ PP(pp_padsv)
 {
     dSP; dTARGET;
     XPUSHs(TARG);
-    if (op->op_private & OPpLVAL_INTRO)
-       SAVECLEARSV(curpad[op->op_targ]);
+    if (op->op_flags & OPf_MOD) {
+       if (op->op_private & OPpLVAL_INTRO)
+           SAVECLEARSV(curpad[op->op_targ]);
+        else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
+           SV* sv = curpad[op->op_targ];
+            if (SvGMAGICAL(sv))
+                mg_get(sv);
+            if (!SvOK(sv)) {
+                if (SvREADONLY(sv))
+                    croak(no_modify);
+                (void)SvUPGRADE(sv, SVt_RV);
+                SvRV(sv) = (op->op_private & OPpDEREF_HV ?
+                            (SV*)newHV() : (SV*)newAV());
+                SvROK_on(sv);
+                SvSETMAGIC(sv);
+            }
+        }
+    }
     RETURN;
 }
 
@@ -360,6 +380,8 @@ PP(pp_rv2av)
                    if (op->op_flags & OPf_REF ||
                      op->op_private & HINT_STRICT_REFS)
                        DIE(no_usym, "an ARRAY");
+                   if (GIMME == G_ARRAY)
+                       RETURN;
                    RETPUSHUNDEF;
                }
                sym = SvPV(sv,na);
@@ -431,6 +453,10 @@ PP(pp_rv2hv)
                    if (op->op_flags & OPf_REF ||
                      op->op_private & HINT_STRICT_REFS)
                        DIE(no_usym, "a HASH");
+                   if (GIMME == G_ARRAY) {
+                       SP--;
+                       RETURN;
+                   }
                    RETSETUNDEF;
                }
                sym = SvPV(sv,na);
@@ -502,6 +528,7 @@ PP(pp_aassign)
     ary = Null(AV*);
     hash = Null(HV*);
     while (lelem <= lastlelem) {
+       tainted = 0;            /* Each item stands on its own, taintwise. */
        sv = *lelem++;
        switch (SvTYPE(sv)) {
        case SVt_PVAV:
@@ -518,6 +545,7 @@ PP(pp_aassign)
                (void)av_store(ary,i++,sv);
                if (magic)
                    mg_set(sv);
+               tainted = 0;
            }
            break;
        case SVt_PVHV: {
@@ -542,6 +570,7 @@ PP(pp_aassign)
                    (void)hv_store(hash,tmps,len,tmpstr,0);
                    if (magic)
                        mg_set(tmpstr);
+                   tainted = 0;
                }
            }
            break;
@@ -626,7 +655,7 @@ PP(pp_aassign)
            gid = (int)getgid();
            egid = (int)getegid();
        }
-       tainting |= (euid != uid || egid != gid);
+       tainting |= (uid && (euid != uid || egid != gid));
     }
     delaymagic = 0;
     if (GIMME == G_ARRAY) {
@@ -637,16 +666,11 @@ PP(pp_aassign)
        RETURN;
     }
     else {
+       dTARGET;
        SP = firstrelem;
-       for (relem = firstrelem; relem <= lastrelem; ++relem) {
-           if (SvOK(*relem)) {
-               dTARGET;
                
-               SETi(lastrelem - firstrelem + 1);
-               RETURN;
-           }
-       }
-       RETSETUNDEF;
+       SETi(lastrelem - firstrelem + 1);
+       RETURN;
     }
 }
 
@@ -664,6 +688,7 @@ PP(pp_match)
     I32 gimme = GIMME;
     STRLEN len;
     I32 minmatch = 0;
+    I32 oldsave = savestack_ix;
 
     if (op->op_flags & OPf_STACKED)
        TARG = POPs;
@@ -752,7 +777,7 @@ play_it_again:
            pm->op_pmshort = Nullsv;    /* opt is being useless */
        }
     }
-    if (regexec(rx, s, strend, truebase, minmatch,
+    if (pregexec(rx, s, strend, truebase, minmatch,
       SvSCREAM(TARG) ? TARG : Nullsv,
       safebase)) {
        curpm = pm;
@@ -788,6 +813,7 @@ play_it_again:
                ++rx->endp[0];
            goto play_it_again;
        }
+       LEAVE_SCOPE(oldsave);
        RETURN;
     }
     else {
@@ -809,6 +835,7 @@ play_it_again:
            else
                mg->mg_len = -1;
        }
+       LEAVE_SCOPE(oldsave);
        RETPUSHYES;
     }
 
@@ -835,6 +862,7 @@ yup:
        tmps = rx->startp[0] = tmps + (s - t);
        rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
     }
+    LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
 nope:
@@ -849,6 +877,7 @@ ret_no:
                mg->mg_len = -1;
        }
     }
+    LEAVE_SCOPE(oldsave);
     if (gimme == G_ARRAY)
        RETURN;
     RETPUSHNO;
@@ -995,7 +1024,7 @@ do_readline()
            SP--;
     }
     if (!fp) {
-       if (dowarn && !(IoFLAGS(io) & IOf_START))
+       if (dowarn && io && !(IoFLAGS(io) & IOf_START))
            warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
        if (GIMME == G_SCALAR) {
            (void)SvOK_off(TARG);
@@ -1200,16 +1229,20 @@ PP(pp_iter)
     dSP;
     register CONTEXT *cx;
     SV *sv;
+    AV* av;
 
     EXTEND(sp, 1);
     cx = &cxstack[cxstack_ix];
     if (cx->cx_type != CXt_LOOP)
        DIE("panic: pp_iter");
+    av = cx->blk_loop.iterary;
+    if (av == stack && cx->blk_loop.iterix >= cx->blk_oldsp)
+       RETPUSHNO;
 
-    if (cx->blk_loop.iterix >= cx->blk_oldsp)
+    if (cx->blk_loop.iterix >= AvFILL(av))
        RETPUSHNO;
 
-    if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) {
+    if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) {
        SvTEMP_off(sv);
        *cx->blk_loop.itervar = sv;
     }
@@ -1240,6 +1273,7 @@ PP(pp_subst)
     register REGEXP *rx = pm->op_pmregexp;
     STRLEN len;
     int force_on_match = 0;
+    I32 oldsave = savestack_ix;
 
     if (pm->op_pmflags & PMf_CONST)    /* known replacement string? */
        dstr = POPs;
@@ -1250,7 +1284,7 @@ PP(pp_subst)
        EXTEND(SP,1);
     }
     s = SvPV(TARG, len);
-    if (!SvPOKp(TARG) || SvREADONLY(TARG))
+    if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
        force_on_match = 1;
 
   force_it:
@@ -1311,7 +1345,7 @@ PP(pp_subst)
        c = SvPV(dstr, clen);
        if (clen <= rx->minlen) {
                                        /* can do inplace substitution */
-           if (regexec(rx, s, strend, orig, 0,
+           if (pregexec(rx, s, strend, orig, 0,
              SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
                if (force_on_match) {
                    force_on_match = 0;
@@ -1342,6 +1376,7 @@ PP(pp_subst)
                        (void)SvPOK_only(TARG);
                        SvSETMAGIC(TARG);
                        PUSHs(&sv_yes);
+                       LEAVE_SCOPE(oldsave);
                        RETURN;
                    }
                    /*SUPPRESS 560*/
@@ -1357,6 +1392,7 @@ PP(pp_subst)
                        (void)SvPOK_only(TARG);
                        SvSETMAGIC(TARG);
                        PUSHs(&sv_yes);
+                       LEAVE_SCOPE(oldsave);
                        RETURN;
                    }
                    else if (clen) {
@@ -1366,6 +1402,7 @@ PP(pp_subst)
                        (void)SvPOK_only(TARG);
                        SvSETMAGIC(TARG);
                        PUSHs(&sv_yes);
+                       LEAVE_SCOPE(oldsave);
                        RETURN;
                    }
                    else {
@@ -1373,6 +1410,7 @@ PP(pp_subst)
                        (void)SvPOK_only(TARG);
                        SvSETMAGIC(TARG);
                        PUSHs(&sv_yes);
+                       LEAVE_SCOPE(oldsave);
                        RETURN;
                    }
                    /* NOTREACHED */
@@ -1392,7 +1430,7 @@ PP(pp_subst)
                        d += clen;
                    }
                    s = rx->endp[0];
-               } while (regexec(rx, s, strend, orig, s == m,
+               } while (pregexec(rx, s, strend, orig, s == m,
                    Nullsv, TRUE));     /* (don't match same null twice) */
                if (s != d) {
                    i = strend - s;
@@ -1402,15 +1440,17 @@ PP(pp_subst)
                (void)SvPOK_only(TARG);
                SvSETMAGIC(TARG);
                PUSHs(sv_2mortal(newSViv((I32)iters)));
+               LEAVE_SCOPE(oldsave);
                RETURN;
            }
            PUSHs(&sv_no);
+           LEAVE_SCOPE(oldsave);
            RETURN;
        }
     }
     else
        c = Nullch;
-    if (regexec(rx, s, strend, orig, 0,
+    if (pregexec(rx, s, strend, orig, 0,
       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
     long_way:
        if (force_on_match) {
@@ -1443,10 +1483,11 @@ PP(pp_subst)
                sv_catpvn(dstr, c, clen);
            if (once)
                break;
-       } while (regexec(rx, s, strend, orig, s == m, Nullsv,
+       } while (pregexec(rx, s, strend, orig, s == m, Nullsv,
            safebase));
        sv_catpvn(dstr, s, strend - s);
 
+       (void)SvOOK_off(TARG);
        Safefree(SvPVX(TARG));
        SvPVX(TARG) = SvPVX(dstr);
        SvCUR_set(TARG, SvCUR(dstr));
@@ -1457,14 +1498,17 @@ PP(pp_subst)
        (void)SvPOK_only(TARG);
        SvSETMAGIC(TARG);
        PUSHs(sv_2mortal(newSViv((I32)iters)));
+       LEAVE_SCOPE(oldsave);
        RETURN;
     }
     PUSHs(&sv_no);
+    LEAVE_SCOPE(oldsave);
     RETURN;
 
 nope:
     ++BmUSEFUL(pm->op_pmshort);
     PUSHs(&sv_no);
+    LEAVE_SCOPE(oldsave);
     RETURN;
 }
 
@@ -1604,8 +1648,17 @@ PP(pp_entersub)
 
     if (!CvROOT(cv) && !CvXSUB(cv)) {
        if (gv = CvGV(cv)) {
-           SV *tmpstr = sv_newmortal();
+           SV *tmpstr;
            GV *ngv;
+           if (SvFAKE(cv) && GvCV(gv) != cv) { /* autoloaded stub? */
+               cv = GvCV(gv);
+               if (SvTYPE(sv) == SVt_PVGV) {
+                   SvREFCNT_dec(GvCV((GV*)sv));
+                   GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
+               }
+               goto retry;
+           }
+           tmpstr = sv_newmortal();
            gv_efullname(tmpstr, gv);
            ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
            if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
@@ -1619,10 +1672,11 @@ PP(pp_entersub)
        DIE("Undefined subroutine called");
     }
 
+    gimme = GIMME;
     if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) {
        sv = GvSV(DBsub);
        save_item(sv);
-       if (SvFLAGS(cv) & SVpcv_ANON)   /* Is GV potentially non-unique? */
+       if (SvFLAGS(cv) & (SVpcv_ANON | SVpcv_CLONED)) /* Is GV potentially non-unique? */
            sv_setsv(sv, newRV((SV*)cv));
        else {
            gv = CvGV(cv);
@@ -1633,8 +1687,6 @@ PP(pp_entersub)
            DIE("No DBsub routine");
     }
 
-    gimme = GIMME;
-
     if (CvXSUB(cv)) {
        if (CvOLDSTYLE(cv)) {
            I32 (*fp3)_((int,int,int));
@@ -1687,7 +1739,7 @@ PP(pp_entersub)
            if (CvDEPTH(cv) > AvFILL(padlist)) {
                AV *av;
                AV *newpad = newAV();
-               AV *oldpad = (AV*)AvARRAY(svp[CvDEPTH(cv)-1]);
+               SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
                I32 ix = AvFILL((AV*)svp[1]);
                svp = AvARRAY(svp[0]);
                for ( ;ix > 0; ix--) {
@@ -1695,7 +1747,7 @@ PP(pp_entersub)
                        char *name = SvPVX(svp[ix]);
                        if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
                            av_store(newpad, ix,
-                               SvREFCNT_inc(AvARRAY(oldpad)[ix]) );
+                               SvREFCNT_inc(oldpad[ix]) );
                        }
                        else {                          /* our own lexical */
                            if (*name == '@')