tweaks to overloaded constants (change#1259)

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

diff --git a/pp.c b/pp.c
index fafc606..3d7638e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -101,9 +101,11 @@ typedef unsigned UBW;
 #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
 #endif
 
+#ifndef PERL_OBJECT
 static void doencodes _((SV* sv, char* s, I32 len));
 static SV* refto _((SV* sv));
 static U32 seed _((void));
+#endif
 
 static bool srand_called = FALSE;
 
@@ -322,7 +324,11 @@ PP(pp_pos)
        }
 
        LvTYPE(TARG) = '.';
-       LvTARG(TARG) = sv;
+       if (LvTARG(TARG) != sv) {
+           if (LvTARG(TARG))
+               SvREFCNT_dec(LvTARG(TARG));
+           LvTARG(TARG) = SvREFCNT_inc(sv);
+       }
        PUSHs(TARG);    /* no SvSETMAGIC */
        RETURN;
     }
@@ -456,7 +462,7 @@ PP(pp_refgen)
     RETURN;
 }
 
-static SV*
+STATIC SV*
 refto(SV *sv)
 {
     SV* rv;
@@ -507,8 +513,14 @@ PP(pp_bless)
 
     if (MAXARG == 1)
        stash = curcop->cop_stash;
-    else
-       stash = gv_stashsv(POPs, TRUE);
+    else {
+       SV *ssv = POPs;
+       STRLEN len;
+       char *ptr = SvPV(ssv,len);
+       if (dowarn && len == 0)
+           warn("Explicit blessing to '' (assuming package main)");
+       stash = gv_stashpvn(ptr, len, TRUE);
+    }
 
     (void)sv_bless(TOPs, stash);
     RETURN;
@@ -518,40 +530,40 @@ PP(pp_gelem)
 {
     GV *gv;
     SV *sv;
-    SV *ref;
+    SV *tmpRef;
     char *elem;
     djSP;
 
     sv = POPs;
     elem = SvPV(sv, na);
     gv = (GV*)POPs;
-    ref = Nullsv;
+    tmpRef = Nullsv;
     sv = Nullsv;
     switch (elem ? *elem : '\0')
     {
     case 'A':
        if (strEQ(elem, "ARRAY"))
-           ref = (SV*)GvAV(gv);
+           tmpRef = (SV*)GvAV(gv);
        break;
     case 'C':
        if (strEQ(elem, "CODE"))
-           ref = (SV*)GvCVu(gv);
+           tmpRef = (SV*)GvCVu(gv);
        break;
     case 'F':
        if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
-           ref = (SV*)GvIOp(gv);
+           tmpRef = (SV*)GvIOp(gv);
        break;
     case 'G':
        if (strEQ(elem, "GLOB"))
-           ref = (SV*)gv;
+           tmpRef = (SV*)gv;
        break;
     case 'H':
        if (strEQ(elem, "HASH"))
-           ref = (SV*)GvHV(gv);
+           tmpRef = (SV*)GvHV(gv);
        break;
     case 'I':
        if (strEQ(elem, "IO"))
-           ref = (SV*)GvIOp(gv);
+           tmpRef = (SV*)GvIOp(gv);
        break;
     case 'N':
        if (strEQ(elem, "NAME"))
@@ -563,11 +575,11 @@ PP(pp_gelem)
        break;
     case 'S':
        if (strEQ(elem, "SCALAR"))
-           ref = GvSV(gv);
+           tmpRef = GvSV(gv);
        break;
     }
-    if (ref)
-       sv = newRV(ref);
+    if (tmpRef)
+       sv = newRV(tmpRef);
     if (sv)
        sv_2mortal(sv);
     else
@@ -763,7 +775,7 @@ PP(pp_undef)
        hv_undef((HV*)sv);
        break;
     case SVt_PVCV:
-       if (cv_const_sv((CV*)sv))
+       if (dowarn && cv_const_sv((CV*)sv))
            warn("Constant subroutine %s undefined",
                 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
        /* FALL THROUGH */
@@ -909,7 +921,7 @@ PP(pp_divide)
 
 PP(pp_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
       UV left;
       UV right;
@@ -1395,7 +1407,7 @@ PP(pp_i_divide)
 
 PP(pp_i_modulo)
 {
-    djSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
+    djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); 
     {
       dPOPTOPiirl;
       if (!right)
@@ -1591,7 +1603,7 @@ PP(pp_srand)
     RETPUSHYES;
 }
 
-static U32
+STATIC U32
 seed(void)
 {
     /*
@@ -1790,10 +1802,17 @@ PP(pp_substr)
     I32 lvalue = op->op_flags & OPf_MOD;
     char *tmps;
     I32 arybase = curcop->cop_arybase;
+    char *repl = 0;
+    STRLEN repl_len;
 
     SvTAINTED_off(TARG);                       /* decontaminate */
-    if (MAXARG > 2)
+    if (MAXARG > 2) {
+       if (MAXARG > 3) {
+           sv = POPs;
+           repl = SvPV(sv, repl_len);
+       }
        len = POPi;
+    }
     pos = POPi;
     sv = POPs;
     PUTBACK;
@@ -1802,37 +1821,37 @@ PP(pp_substr)
        pos -= arybase;
        rem = curlen-pos;
        fail = rem;
-        if (MAXARG > 2) {
-            if (len < 0) {
-               rem += len;
-                if (rem < 0)
-                    rem = 0;
-            }
-            else if (rem > len)
-                     rem = len;
-        }
+       if (MAXARG > 2) {
+           if (len < 0) {
+               rem += len;
+               if (rem < 0)
+                   rem = 0;
+           }
+           else if (rem > len)
+                    rem = len;
+       }
     }
     else {
-        pos += curlen;
-        if (MAXARG < 3)
-            rem = curlen;
-        else if (len >= 0) {
-            rem = pos+len;
-            if (rem > (I32)curlen)
-                rem = curlen;
-        }
-        else {
-            rem = curlen+len;
-            if (rem < pos)
-                rem = pos;
-        }
-        if (pos < 0)
-            pos = 0;
-        fail = rem;
-        rem -= pos;
+       pos += curlen;
+       if (MAXARG < 3)
+           rem = curlen;
+       else if (len >= 0) {
+           rem = pos+len;
+           if (rem > (I32)curlen)
+               rem = curlen;
+       }
+       else {
+           rem = curlen+len;
+           if (rem < pos)
+               rem = pos;
+       }
+       if (pos < 0)
+           pos = 0;
+       fail = rem;
+       rem -= pos;
     }
     if (fail < 0) {
-       if (dowarn || lvalue)
+       if (dowarn || lvalue || repl)
            warn("substr outside of string");
        RETPUSHUNDEF;
     }
@@ -1858,10 +1877,16 @@ PP(pp_substr)
            }
 
            LvTYPE(TARG) = 'x';
-           LvTARG(TARG) = sv;
+           if (LvTARG(TARG) != sv) {
+               if (LvTARG(TARG))
+                   SvREFCNT_dec(LvTARG(TARG));
+               LvTARG(TARG) = SvREFCNT_inc(sv);
+           }
            LvTARGOFF(TARG) = pos;
            LvTARGLEN(TARG) = rem;
        }
+       else if (repl)
+           sv_insert(sv, pos, rem, repl, repl_len);
     }
     SPAGAIN;
     PUSHs(TARG);               /* avoid SvSETMAGIC here */
@@ -1893,7 +1918,11 @@ PP(pp_vec)
            }
 
            LvTYPE(TARG) = 'v';
-           LvTARG(TARG) = src;
+           if (LvTARG(TARG) != src) {
+               if (LvTARG(TARG))
+                   SvREFCNT_dec(LvTARG(TARG));
+               LvTARG(TARG) = SvREFCNT_inc(src);
+           }
            LvTARGOFF(TARG) = offset;
            LvTARGLEN(TARG) = size;
        }
@@ -2380,7 +2409,6 @@ PP(pp_exists)
 PP(pp_hslice)
 {
     djSP; dMARK; dORIGMARK;
-    register HE *he;
     register HV *hv = (HV*)POPs;
     register I32 lval = op->op_flags & OPf_MOD;
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
@@ -2390,18 +2418,18 @@ PP(pp_hslice)
            SV *keysv = *MARK;
            SV **svp;
            if (realhv) {
-               he = hv_fetch_ent(hv, keysv, lval, 0);
+               HE *he = hv_fetch_ent(hv, keysv, lval, 0);
                svp = he ? &HeVAL(he) : 0;
            } else {
                svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
            }
            if (lval) {
-               if (!he || HeVAL(he) == &sv_undef)
+               if (!svp || *svp == &sv_undef)
                    DIE(no_helem, SvPV(keysv, na));
                if (op->op_private & OPpLVAL_INTRO)
-                   save_helem(hv, keysv, &HeVAL(he));
+                   save_helem(hv, keysv, svp);
            }
-           *MARK = he ? HeVAL(he) : &sv_undef;
+           *MARK = svp ? *svp : &sv_undef;
        }
     }
     if (GIMME != G_ARRAY) {
@@ -2552,8 +2580,11 @@ PP(pp_splice)
            DIE(no_aelem, i);
        if (++MARK < SP) {
            length = SvIVx(*MARK++);
-           if (length < 0)
-               length = 0;
+           if (length < 0) {
+               length += AvFILLp(ary) - offset + 1;
+               if (length < 0)
+                   length = 0;
+           }
        }
        else
            length = AvMAX(ary) + 1;            /* close enough to infinity */
@@ -2848,7 +2879,7 @@ PP(pp_reverse)
     RETURN;
 }
 
-static SV      *
+STATIC SV      *
 mul128(SV *sv, U8 m)
 {
   STRLEN          len;
@@ -3411,6 +3442,9 @@ PP(pp_unpack)
            break;
 #ifdef HAS_QUAD
        case 'q':
+           along = (strend - s) / sizeof(Quad_t);
+           if (len > along)
+               len = along;
            EXTEND(SP, len);
            EXTEND_MORTAL(len);
            while (len-- > 0) {
@@ -3429,6 +3463,9 @@ PP(pp_unpack)
            }
            break;
        case 'Q':
+           along = (strend - s) / sizeof(Quad_t);
+           if (len > along)
+               len = along;
            EXTEND(SP, len);
            EXTEND_MORTAL(len);
            while (len-- > 0) {
@@ -3577,7 +3614,7 @@ PP(pp_unpack)
     RETURN;
 }
 
-static void
+STATIC void
 doencodes(register SV *sv, register char *s, register I32 len)
 {
     char hunk[5];
@@ -3601,7 +3638,7 @@ doencodes(register SV *sv, register char *s, register I32 len)
     sv_catpvn(sv, "\n", 1);
 }
 
-static SV      *
+STATIC SV      *
 is_an_int(char *s, STRLEN l)
 {
   SV             *result = newSVpv("", l);
@@ -3649,7 +3686,7 @@ is_an_int(char *s, STRLEN l)
   return (result);
 }
 
-static int
+STATIC int
 div128(SV *pnum, bool *done)
                                            /* must be '\0' terminated */