Mention and discourage use of term 'soft reference'

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

diff --git a/pp_hot.c b/pp_hot.c
index 59aec4f..7f9f513 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,6 +1,6 @@
 /*    pp_hot.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -204,7 +204,10 @@ PP(pp_concat)
        s = SvPV_force(TARG, len);
     }
     s = SvPV(right,len);
-    sv_catpvn(TARG,s,len);
+    if (SvOK(TARG))
+       sv_catpvn(TARG,s,len);
+    else
+       sv_setpvn(TARG,s,len);  /* suppress warning */
     SETTARG;
     RETURN;
   }
@@ -218,7 +221,7 @@ PP(pp_padsv)
        if (op->op_private & OPpLVAL_INTRO)
            SAVECLEARSV(curpad[op->op_targ]);
         else if (op->op_private & OPpDEREF)
-           provide_ref(op, curpad[op->op_targ]);
+           vivify_ref(curpad[op->op_targ], op->op_flags & OPpDEREF);
     }
     RETURN;
 }
@@ -242,7 +245,7 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
-    if (SvREADONLY(TOPs))
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
        croak(no_modify);
     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
@@ -330,17 +333,22 @@ PP(pp_print)
     else
        gv = defoutgv;
     if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
-       SV *sv;
-
-       PUSHMARK(MARK-1);
+       if (MARK == ORIGMARK) {
+           EXTEND(SP, 1);
+           ++MARK;
+           Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
+           ++SP;
+       }
+       PUSHMARK(MARK - 1);
        *MARK = mg->mg_obj;
+       PUTBACK;
        ENTER;
        perl_call_method("PRINT", G_SCALAR);
        LEAVE;
        SPAGAIN;
-       sv = POPs;
-       SP = ORIGMARK;
-       PUSHs(sv);
+       MARK = ORIGMARK + 1;
+       *MARK = *SP;
+       SP = MARK;
        RETURN;
     }
     if (!(io = GvIO(gv))) {
@@ -412,7 +420,6 @@ PP(pp_print)
 PP(pp_rv2av)
 {
     dSP; dPOPss;
-
     AV *av;
 
     if (SvROK(sv)) {
@@ -450,6 +457,8 @@ PP(pp_rv2av)
                    if (op->op_flags & OPf_REF ||
                      op->op_private & HINT_STRICT_REFS)
                        DIE(no_usym, "an ARRAY");
+                   if (dowarn)
+                       warn(warn_uninit);
                    if (GIMME == G_ARRAY)
                        RETURN;
                    RETPUSHUNDEF;
@@ -487,9 +496,7 @@ PP(pp_rv2av)
 
 PP(pp_rv2hv)
 {
-
     dSP; dTOPss;
-
     HV *hv;
 
     if (SvROK(sv)) {
@@ -527,6 +534,8 @@ PP(pp_rv2hv)
                    if (op->op_flags & OPf_REF ||
                      op->op_private & HINT_STRICT_REFS)
                        DIE(no_usym, "a HASH");
+                   if (dowarn)
+                       warn(warn_uninit);
                    if (GIMME == G_ARRAY) {
                        SP--;
                        RETURN;
@@ -557,7 +566,7 @@ PP(pp_rv2hv)
     else {
        dTARGET;
        if (HvFILL(hv)) {
-           sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
+           sprintf(buf, "%ld/%ld", (long)HvFILL(hv), (long)HvMAX(hv)+1);
            sv_setpv(TARG, buf);
        }
        else
@@ -951,7 +960,6 @@ nope:
        ++BmUSEFUL(pm->op_pmshort);
 
 ret_no:
-    TAINT_IF(rx->exec_tainted);                /* /\W/ */
     LEAVE_SCOPE(oldsave);
     if (gimme == G_ARRAY)
        RETURN;
@@ -1082,6 +1090,7 @@ do_readline()
                           PerlIO_rewind(tmpfp);
                           IoTYPE(io) = '<';
                           IoIFP(io) = fp = tmpfp;
+                          IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
                        }
                    }
                }
@@ -1137,6 +1146,8 @@ do_readline()
     }
     else {
        sv = TARG;
+       if (SvROK(sv))
+           sv_unref(sv);
        (void)SvUPGRADE(sv, SVt_PV);
        tmplen = SvLEN(sv);     /* remember if already alloced */
        if (!tmplen)
@@ -1244,14 +1255,28 @@ PP(pp_helem)
     HE* he;
     SV *keysv = POPs;
     HV *hv = (HV*)POPs;
-    I32 lval = op->op_flags & OPf_MOD;
+    U32 lval = op->op_flags & OPf_MOD;
+    U32 defer = op->op_private & OPpLVAL_DEFER;
 
     if (SvTYPE(hv) != SVt_PVHV)
        RETPUSHUNDEF;
-    he = hv_fetch_ent(hv, keysv, lval, 0);
+    he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
     if (lval) {
-       if (!he || HeVAL(he) == &sv_undef)
-           DIE(no_helem, SvPV(keysv, na));
+       if (!he || HeVAL(he) == &sv_undef) {
+           SV* lv;
+           SV* key2;
+           if (!defer)
+               DIE(no_helem, SvPV(keysv, na));
+           lv = sv_newmortal();
+           sv_upgrade(lv, SVt_PVLV);
+           LvTYPE(lv) = 'y';
+           sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0);
+           SvREFCNT_dec(key2); /* sv_magic() increments refcount */
+           LvTARG(lv) = SvREFCNT_inc(hv);
+           LvTARGLEN(lv) = 1;
+           PUSHs(lv);
+           RETURN;
+       }
        if (op->op_private & OPpLVAL_INTRO) {
            if (HvNAME(hv) && isGV(HeVAL(he)))
                save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
@@ -1259,7 +1284,7 @@ PP(pp_helem)
                save_svref(&HeVAL(he));
        }
        else if (op->op_private & OPpDEREF)
-           provide_ref(op, HeVAL(he));
+           vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
     }
     PUSHs(he ? HeVAL(he) : &sv_undef);
     RETURN;
@@ -1349,14 +1374,14 @@ PP(pp_iter)
        if (lv)
            SvREFCNT_dec(LvTARG(lv));
        else {
-           lv = cx->blk_loop.iterlval = newSVsv(sv);
+           lv = cx->blk_loop.iterlval = NEWSV(26, 0);
            sv_upgrade(lv, SVt_PVLV);
-           sv_magic(lv, Nullsv, 'y', Nullch, 0);
            LvTYPE(lv) = 'y';
+           sv_magic(lv, Nullsv, 'y', Nullch, 0);
        }
        LvTARG(lv) = SvREFCNT_inc(av);
        LvTARGOFF(lv) = cx->blk_loop.iterix;
-       LvTARGLEN(lv) = 1;
+       LvTARGLEN(lv) = -1;
        sv = (SV*)lv;
     }
 
@@ -1396,8 +1421,12 @@ PP(pp_subst)
        TARG = GvSV(defgv);
        EXTEND(SP,1);
     }
+    if (SvREADONLY(TARG)
+       || (SvTYPE(TARG) > SVt_PVLV
+           && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
+       croak(no_modify);
     s = SvPV(TARG, len);
-    if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
+    if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
        force_on_match = 1;
     TAINT_NOT;
 
@@ -1460,7 +1489,6 @@ PP(pp_subst)
     if (c && clen <= rx->minlen) {
        if (! pregexec(rx, s, strend, orig, 0,
                       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
-           TAINT_IF(rx->exec_tainted);
            PUSHs(&sv_no);
            LEAVE_SCOPE(oldsave);
            RETURN;
@@ -1606,7 +1634,6 @@ PP(pp_subst)
        RETURN;
     }
 
-    TAINT_IF(rx->exec_tainted);
     PUSHs(&sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
@@ -1968,30 +1995,43 @@ PP(pp_aelem)
     dSP;
     SV** svp;
     I32 elem = POPi;
-    AV *av = (AV*)POPs;
-    I32 lval = op->op_flags & OPf_MOD;
+    AV* av = (AV*)POPs;
+    U32 lval = op->op_flags & OPf_MOD;
+    U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
 
     if (elem > 0)
        elem -= curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)
        RETPUSHUNDEF;
-    svp = av_fetch(av, elem, lval);
+    svp = av_fetch(av, elem, lval && !defer);
     if (lval) {
-       if (!svp || *svp == &sv_undef)
-           DIE(no_aelem, elem);
+       if (!svp || *svp == &sv_undef) {
+           SV* lv;
+           if (!defer)
+               DIE(no_aelem, elem);
+           lv = sv_newmortal();
+           sv_upgrade(lv, SVt_PVLV);
+           LvTYPE(lv) = 'y';
+           sv_magic(lv, Nullsv, 'y', Nullch, 0);
+           LvTARG(lv) = SvREFCNT_inc(av);
+           LvTARGOFF(lv) = elem;
+           LvTARGLEN(lv) = 1;
+           PUSHs(lv);
+           RETURN;
+       }
        if (op->op_private & OPpLVAL_INTRO)
            save_svref(svp);
        else if (op->op_private & OPpDEREF)
-           provide_ref(op, *svp);
+           vivify_ref(*svp, op->op_private & OPpDEREF);
     }
     PUSHs(svp ? *svp : &sv_undef);
     RETURN;
 }
 
 void
-provide_ref(op, sv)
-OP* op;
+vivify_ref(sv, to_what)
 SV* sv;
+U32 to_what;
 {
     if (SvGMAGICAL(sv))
        mg_get(sv);
@@ -2005,8 +2045,7 @@ SV* sv;
            Safefree(SvPVX(sv));
            SvLEN(sv) = SvCUR(sv) = 0;
        }
-       switch (op->op_private & OPpDEREF)
-       {
+       switch (to_what) {
        case OPpDEREF_SV:
            SvRV(sv) = newSV(0);
            break;