VMS patches.
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index 23fd79c..048af2e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -103,6 +103,8 @@ PP(pp_rv2gv)
     }
     else {
        if (SvTYPE(sv) != SVt_PVGV) {
+           char *sym;
+
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
                if (SvROK(sv))
@@ -114,16 +116,17 @@ PP(pp_rv2gv)
                    DIE(no_usym, "a symbol");
                RETSETUNDEF;
            }
+           sym = SvPV(sv, na);
            if (op->op_private & HINT_STRICT_REFS)
-               DIE(no_symref, "a symbol");
-           sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVGV);
+               DIE(no_symref, sym, "a symbol");
+           sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
        }
     }
     if (op->op_private & OPpLVAL_INTRO) {
        GP *ogp = GvGP(sv);
 
        SSCHECK(3);
-       SSPUSHPTR(sv);
+       SSPUSHPTR(SvREFCNT_inc(sv));
        SSPUSHPTR(ogp);
        SSPUSHINT(SAVEt_GP);
 
@@ -169,6 +172,8 @@ PP(pp_rv2sv)
     }
     else {
        GV *gv = sv;
+       char *sym;
+
        if (SvTYPE(gv) != SVt_PVGV) {
            if (SvGMAGICAL(sv)) {
                mg_get(sv);
@@ -181,9 +186,10 @@ PP(pp_rv2sv)
                    DIE(no_usym, "a SCALAR");
                RETSETUNDEF;
            }
+           sym = SvPV(sv, na);
            if (op->op_private & HINT_STRICT_REFS)
-               DIE(no_symref, "a SCALAR");
-           gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PV);
+               DIE(no_symref, sym, "a SCALAR");
+           gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
        }
        sv = GvSV(gv);
     }
@@ -194,6 +200,8 @@ PP(pp_rv2sv)
            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());
@@ -250,9 +258,12 @@ PP(pp_rv2cv)
     GV *gv;
     HV *stash;
 
-    /* We always try to add a non-existent subroutine in case of AUTOLOAD. */
-    CV *cv = sv_2cv(TOPs, &stash, &gv, TRUE);
+    /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
+    /* (But not in defined().) */
+    CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
 
+    if (!cv)
+       cv = (CV*)&sv_undef;
     SETs((SV*)cv);
     RETURN;
 }
@@ -260,7 +271,14 @@ PP(pp_rv2cv)
 PP(pp_anoncode)
 {
     dSP;
-    XPUSHs(cSVOP->op_sv);
+    CV* cv = (CV*)cSVOP->op_sv;
+    EXTEND(SP,1);
+
+    if (SvFLAGS(cv) & SVpcv_CLONE) {
+       cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+    }
+
+    PUSHs((SV*)cv);
     RETURN;
 }
 
@@ -316,7 +334,7 @@ PP(pp_ref)
 
     sv = POPs;
     if (!sv || !SvROK(sv))
-       RETPUSHUNDEF;
+       RETPUSHNO;
 
     sv = SvRV(sv);
     pv = sv_reftype(sv,TRUE);
@@ -468,11 +486,11 @@ PP(pp_defined)
        RETPUSHNO;
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
-       if (AvMAX(sv) >= 0)
+       if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
            RETPUSHYES;
        break;
     case SVt_PVHV:
-       if (HvARRAY(sv))
+       if (HvARRAY(sv) || SvRMAGICAL(sv))
            RETPUSHYES;
        break;
     case SVt_PVCV:
@@ -520,17 +538,20 @@ PP(pp_undef)
        cv_undef((CV*)sv);
        sub_generation++;
        break;
+    case SVt_PVGV:
+        if (SvFAKE(sv)) {
+            sv_setsv(sv, &sv_undef);
+            break;
+        }
     default:
-       if (sv != GvSV(defgv)) {
-           if (SvPOK(sv) && SvLEN(sv)) {
-               (void)SvOOK_off(sv);
-               Safefree(SvPVX(sv));
-               SvPV_set(sv, Nullch);
-               SvLEN_set(sv, 0);
-           }
-           (void)SvOK_off(sv);
-           SvSETMAGIC(sv);
+       if (SvPOK(sv) && SvLEN(sv)) {
+           (void)SvOOK_off(sv);
+           Safefree(SvPVX(sv));
+           SvPV_set(sv, Nullch);
+           SvLEN_set(sv, 0);
        }
+       (void)SvOK_off(sv);
+       SvSETMAGIC(sv);
     }
 
     RETPUSHUNDEF;
@@ -539,7 +560,12 @@ PP(pp_undef)
 PP(pp_predec)
 {
     dSP;
-    sv_dec(TOPs);
+    if (SvIOK(TOPs)) {
+       --SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+       sv_dec(TOPs);
     SvSETMAGIC(TOPs);
     return NORMAL;
 }
@@ -548,7 +574,12 @@ PP(pp_postinc)
 {
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
-    sv_inc(TOPs);
+    if (SvIOK(TOPs)) {
+       ++SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+       sv_inc(TOPs);
     SvSETMAGIC(TOPs);
     if (!SvOK(TARG))
        sv_setiv(TARG, 0);
@@ -560,7 +591,12 @@ PP(pp_postdec)
 {
     dSP; dTARGET;
     sv_setsv(TARG, TOPs);
-    sv_dec(TOPs);
+    if (SvIOK(TOPs)) {
+       --SvIVX(TOPs);
+       SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
+    }
+    else
+       sv_dec(TOPs);
     SvSETMAGIC(TOPs);
     SETs(TARG);
     return NORMAL;
@@ -642,7 +678,8 @@ PP(pp_modulo)
 
 PP(pp_repeat)
 {
-    dSP; dATARGET;
+  dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+  {
     register I32 count = POPi;
     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
        dMARK;
@@ -691,6 +728,7 @@ PP(pp_repeat)
        PUSHTARG;
     }
     RETURN;
+  }
 }
 
 PP(pp_subtract)
@@ -707,9 +745,9 @@ PP(pp_left_shift)
 {
     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); 
     {
-      dPOPTOPiirl;
-      SETi( left << right );
-      RETURN;
+        dPOPTOPiirl;
+        SETi( left << right );
+        RETURN;
     }
 }
 
@@ -855,7 +893,7 @@ PP(pp_bit_and) {
     dSP; dATARGET; tryAMAGICbin(band,opASSIGN); 
     {
       dPOPTOPssrl;
-      if (SvNIOK(left) || SvNIOK(right)) {
+      if (SvNIOKp(left) || SvNIOKp(right)) {
        unsigned long value = U_L(SvNV(left));
        value = value & U_L(SvNV(right));
        SETn((double)value);
@@ -873,7 +911,7 @@ PP(pp_bit_xor)
     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); 
     {
       dPOPTOPssrl;
-      if (SvNIOK(left) || SvNIOK(right)) {
+      if (SvNIOKp(left) || SvNIOKp(right)) {
        unsigned long value = U_L(SvNV(left));
        value = value ^ U_L(SvNV(right));
        SETn((double)value);
@@ -891,7 +929,7 @@ PP(pp_bit_or)
     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); 
     {
       dPOPTOPssrl;
-      if (SvNIOK(left) || SvNIOK(right)) {
+      if (SvNIOKp(left) || SvNIOKp(right)) {
        unsigned long value = U_L(SvNV(left));
        value = value | U_L(SvNV(right));
        SETn((double)value);
@@ -909,9 +947,11 @@ PP(pp_negate)
     dSP; dTARGET; tryAMAGICun(neg);
     {
        dTOPss;
-       if (SvNIOK(sv))
+       if (SvGMAGICAL(sv))
+           mg_get(sv);
+       if (SvNIOKp(sv))
            SETn(-SvNV(sv));
-       else if (SvPOK(sv)) {
+       else if (SvPOKp(sv)) {
            STRLEN len;
            char *s = SvPV(sv, len);
            if (isALPHA(*s) || *s == '_') {
@@ -926,6 +966,8 @@ PP(pp_negate)
                sv_setnv(TARG, -SvNV(sv));
            SETTARG;
        }
+       else
+           SETn(-SvNV(sv));
     }
     RETURN;
 }
@@ -946,8 +988,12 @@ PP(pp_complement)
       dTOPss;
       register I32 anum;
 
-      if (SvNIOK(sv)) {
-       SETi(  ~SvIV(sv) );
+      if (SvNIOKp(sv)) {
+       IV iv = ~SvIV(sv);
+       if (iv < 0)
+           SETn( (double) ~U_L(SvNV(sv)) );
+       else
+           SETi( iv );
       }
       else {
        register char *tmps;
@@ -976,84 +1022,6 @@ PP(pp_complement)
 
 /* integer versions of some of the above */
 
-PP(pp_i_preinc)
-{
-#ifndef OVERLOAD
-    dSP; dTOPiv;
-    sv_setiv(TOPs, value + 1);
-    SvSETMAGIC(TOPs);
-#else
-    dSP;
-    if (SvAMAGIC(TOPs) ) {
-      sv_inc(TOPs);
-    } else {
-      dTOPiv;
-      sv_setiv(TOPs, value + 1);
-      SvSETMAGIC(TOPs);
-    }
-#endif /* OVERLOAD */
-    return NORMAL;
-}
-
-PP(pp_i_predec)
-{
-#ifndef OVERLOAD
-    dSP; dTOPiv;
-    sv_setiv(TOPs, value - 1);
-    SvSETMAGIC(TOPs);
-#else
-    dSP;
-    if (SvAMAGIC(TOPs)) {
-      sv_dec(TOPs);
-    } else {
-      dTOPiv;
-      sv_setiv(TOPs, value - 1);
-      SvSETMAGIC(TOPs);
-    }
-#endif /* OVERLOAD */
-    return NORMAL;
-}
-
-PP(pp_i_postinc)
-{
-    dSP; dTARGET;
-    sv_setsv(TARG, TOPs);
-#ifndef OVERLOAD
-    sv_setiv(TOPs, SvIV(TOPs) + 1);
-    SvSETMAGIC(TOPs);
-#else
-    if (SvAMAGIC(TOPs) ) {
-      sv_inc(TOPs);
-    } else {
-      sv_setiv(TOPs, SvIV(TOPs) + 1);
-      SvSETMAGIC(TOPs);
-    }
-#endif /* OVERLOAD */
-    if (!SvOK(TARG))
-       sv_setiv(TARG, 0);
-    SETs(TARG);
-    return NORMAL;
-}
-
-PP(pp_i_postdec)
-{
-    dSP; dTARGET;
-    sv_setsv(TARG, TOPs);
-#ifndef OVERLOAD
-    sv_setiv(TOPs, SvIV(TOPs) - 1);
-    SvSETMAGIC(TOPs);
-#else
-    if (SvAMAGIC(TOPs) ) {
-      sv_dec(TOPs);
-    } else {
-      sv_setiv(TOPs, SvIV(TOPs) - 1);
-      SvSETMAGIC(TOPs);
-    }
-#endif /* OVERLOAD */
-    SETs(TARG);
-    return NORMAL;
-}
-
 PP(pp_i_multiply)
 {
     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); 
@@ -1408,7 +1376,7 @@ PP(pp_substr)
        if (MAXARG < 3)
            len = curlen;
        else if (len < 0) {
-           len += curlen;
+           len += curlen - pos;
            if (len < 0)
                len = 0;
        }
@@ -1418,6 +1386,7 @@ PP(pp_substr)
            rem = len;
        sv_setpvn(TARG, tmps, rem);
        if (lvalue) {                   /* it's an lvalue! */
+           (void)SvPOK_only(sv);
            if (SvTYPE(TARG) < SVt_PVLV) {
                sv_upgrade(TARG, SVt_PVLV);
                sv_magic(TARG, Nullsv, 'x', Nullch, 0);
@@ -1466,20 +1435,24 @@ PP(pp_vec)
                retnum = 0;
            else {
                offset >>= 3;
-               if (size == 16)
-                   retnum = (unsigned long) s[offset] << 8;
-               else if (size == 32) {
-                   if (offset < len) {
-                       if (offset + 1 < len)
-                           retnum = ((unsigned long) s[offset] << 24) +
-                               ((unsigned long) s[offset + 1] << 16) +
-                               (s[offset + 2] << 8);
-                       else
-                           retnum = ((unsigned long) s[offset] << 24) +
-                               ((unsigned long) s[offset + 1] << 16);
-                   }
+               if (size == 16) {
+                   if (offset >= srclen)
+                       retnum = 0;
                    else
+                       retnum = (unsigned long) s[offset] << 8;
+               }
+               else if (size == 32) {
+                   if (offset >= srclen)
+                       retnum = 0;
+                   else if (offset + 1 >= srclen)
                        retnum = (unsigned long) s[offset] << 24;
+                   else if (offset + 2 >= srclen)
+                       retnum = ((unsigned long) s[offset] << 24) +
+                           ((unsigned long) s[offset + 1] << 16);
+                   else
+                       retnum = ((unsigned long) s[offset] << 24) +
+                           ((unsigned long) s[offset + 1] << 16) +
+                           (s[offset + 2] << 8);
                }
            }
        }
@@ -1605,13 +1578,12 @@ PP(pp_chr)
     dSP; dTARGET;
     char *tmps;
 
-    if (!SvPOK(TARG)) {
-       (void)SvUPGRADE(TARG,SVt_PV);
-       SvGROW(TARG,1);
-    }
+    (void)SvUPGRADE(TARG,SVt_PV);
+    SvGROW(TARG,2);
     SvCUR_set(TARG, 1);
     tmps = SvPVX(TARG);
-    *tmps = POPi;
+    *tmps++ = POPi;
+    *tmps = '\0';
     (void)SvPOK_only(TARG);
     XPUSHs(TARG);
     RETURN;
@@ -1757,11 +1729,25 @@ PP(pp_aslice)
     register SV** svp;
     register AV* av = (AV*)POPs;
     register I32 lval = op->op_flags & OPf_MOD;
+    I32 arybase = curcop->cop_arybase;
+    I32 elem;
 
     if (SvTYPE(av) == SVt_PVAV) {
+       if (lval && op->op_private & OPpLVAL_INTRO) {
+           I32 max = -1;
+           for (svp = mark + 1; svp <= sp; svp++) {
+               elem = SvIVx(*svp);
+               if (elem > max)
+                   max = elem;
+           }
+           if (max > AvMAX(av))
+               av_extend(av, max);
+       }
        while (++MARK <= SP) {
-           I32 elem = SvIVx(*MARK);
+           elem = SvIVx(*MARK);
 
+           if (elem > 0)
+               elem -= arybase;
            svp = av_fetch(av, elem, lval);
            if (lval) {
                if (!svp || *svp == &sv_undef)
@@ -1772,7 +1758,7 @@ PP(pp_aslice)
            *MARK = svp ? *svp : &sv_undef;
        }
     }
-    else if (GIMME != G_ARRAY) {
+    if (GIMME != G_ARRAY) {
        MARK = ORIGMARK;
        *++MARK = *SP;
        SP = MARK;
@@ -1829,7 +1815,8 @@ PP(pp_delete)
        DIE("Not a HASH reference");
     }
     tmps = SvPV(tmpsv, len);
-    sv = hv_delete(hv, tmps, len);
+    sv = hv_delete(hv, tmps, len,
+       op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
     if (!sv)
        RETPUSHUNDEF;
     PUSHs(sv);
@@ -1905,13 +1892,19 @@ PP(pp_lslice)
     SV **firstlelem = stack_base + POPMARK + 1;
     register SV **firstrelem = lastlelem + 1;
     I32 arybase = curcop->cop_arybase;
+    I32 lval = op->op_flags & OPf_MOD;
+    I32 is_something_there = lval;
 
     register I32 max = lastrelem - lastlelem;
     register SV **lelem;
     register I32 ix;
 
     if (GIMME != G_ARRAY) {
-       ix = SvIVx(*lastlelem) - arybase;
+       ix = SvIVx(*lastlelem);
+       if (ix < 0)
+           ix += max;
+       else
+           ix -= arybase;
        if (ix < 0 || ix >= max)
            *firstlelem = &sv_undef;
        else
@@ -1926,7 +1919,7 @@ PP(pp_lslice)
     }
 
     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
-       ix = SvIVx(*lelem) - arybase;
+       ix = SvIVx(*lelem);
        if (ix < 0) {
            ix += max;
            if (ix < 0)
@@ -1934,10 +1927,18 @@ PP(pp_lslice)
            else if (!(*lelem = firstrelem[ix]))
                *lelem = &sv_undef;
        }
-       else if (ix >= max || !(*lelem = firstrelem[ix]))
-           *lelem = &sv_undef;
+       else {
+           ix -= arybase;
+           if (ix >= max || !(*lelem = firstrelem[ix]))
+               *lelem = &sv_undef;
+       }
+       if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
+           is_something_there = TRUE;
     }
-    SP = lastlelem;
+    if (is_something_there)
+       SP = lastlelem;
+    else
+       SP = firstlelem - 1;
     RETURN;
 }
 
@@ -2300,7 +2301,7 @@ PP(pp_unpack)
     if (GIMME != G_ARRAY) {            /* arrange to do first one only */
        /*SUPPRESS 530*/
        for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
-       if (strchr("aAbBhH", *patend) || *pat == '%') {
+       if (strchr("aAbBhHP", *patend) || *pat == '%') {
            patend++;
            while (isDIGIT(*patend) || *patend == '*')
                patend++;
@@ -3409,7 +3410,7 @@ PP(pp_split)
     else {
        maxiters += (strend - s) * rx->nparens;
        while (s < strend && --limit &&
-           regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
+           pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
            if (rx->subbase
              && rx->subbase != orig) {
                m = s;
@@ -3428,8 +3429,12 @@ PP(pp_split)
                for (i = 1; i <= rx->nparens; i++) {
                    s = rx->startp[i];
                    m = rx->endp[i];
-                   dstr = NEWSV(33, m-s);
-                   sv_setpvn(dstr, s, m-s);
+                   if (m && s) {
+                       dstr = NEWSV(33, m-s);
+                       sv_setpvn(dstr, s, m-s);
+                   }
+                   else
+                       dstr = NEWSV(33, 0);
                    if (!realarray)
                        sv_2mortal(dstr);
                    XPUSHs(dstr);