Warn on %{+undef} and @{+undef}
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 3086e73..7fba763 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,6 +1,6 @@
 /*    mg.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.
 #  endif
 #endif
 
-#define TAINT_FROM_REGEX(sv,rx) \
-       if ((rx)->exec_tainted) {       \
-           SvTAINTED_on(sv);           \
-       } else                          \
-           SvTAINTED_off(sv);
-
 /*
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  */
@@ -44,15 +38,13 @@ typedef struct magic_state MGS;
 
 static void restore_magic _((void *p));
 
-static MGS *
-save_magic(sv)
+static void
+save_magic(mgs, sv)
+MGS* mgs;
 SV* sv;
 {
-    MGS* mgs;
-
     assert(SvMAGICAL(sv));
 
-    mgs = (MGS*)safemalloc(sizeof(MGS));
     mgs->mgs_sv = sv;
     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
     SAVEDESTRUCTOR(restore_magic, mgs);
@@ -60,15 +52,13 @@ SV* sv;
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-
-    return mgs;
 }
 
 static void
 restore_magic(p)
 void* p;
 {
-    MGS *mgs = (MGS*)p;
+    MGS* mgs = (MGS*)p;
     SV* sv = mgs->mgs_sv;
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
@@ -80,8 +70,6 @@ void* p;
        if (SvGMAGICAL(sv))
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
     }
-
-    Safefree(mgs);
 }
 
 
@@ -107,13 +95,13 @@ int
 mg_get(sv)
 SV* sv;
 {
-    MGS* mgs;
+    MGS mgs;
     MAGIC* mg;
     MAGIC** mgp;
     int mgp_valid = 0;
 
     ENTER;
-    mgs = save_magic(sv);
+    save_magic(&mgs, sv);
 
     mgp = &SvMAGIC(sv);
     while ((mg = *mgp) != 0) {
@@ -121,8 +109,9 @@ SV* sv;
        if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
            (*vtbl->svt_get)(sv, mg);
            /* Ignore this magic if it's been deleted */
-           if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP))
-               mgs->mgs_flags = 0;
+           if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
+                 (mg->mg_flags & MGf_GSKIP))
+               mgs.mgs_flags = 0;
        }
        /* Advance to next magic (complicated by possible deletion) */
        if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
@@ -141,19 +130,19 @@ int
 mg_set(sv)
 SV* sv;
 {
-    MGS* mgs;
+    MGS mgs;
     MAGIC* mg;
     MAGIC* nextmg;
 
     ENTER;
-    mgs = save_magic(sv);
+    save_magic(&mgs, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
        MGVTBL* vtbl = mg->mg_virtual;
        nextmg = mg->mg_moremagic;      /* it may delete itself */
        if (mg->mg_flags & MGf_GSKIP) {
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
-           mgs->mgs_flags = 0;
+           mgs.mgs_flags = 0;
        }
        if (vtbl && vtbl->svt_set)
            (*vtbl->svt_set)(sv, mg);
@@ -174,8 +163,10 @@ SV* sv;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
        if (vtbl && vtbl->svt_len) {
+           MGS mgs;
+
            ENTER;
-           save_magic(sv);
+           save_magic(&mgs, sv);
            /* omit MGf_GSKIP -- not changed here */
            len = (*vtbl->svt_len)(sv, mg);
            LEAVE;
@@ -191,10 +182,11 @@ int
 mg_clear(sv)
 SV* sv;
 {
+    MGS mgs;
     MAGIC* mg;
 
     ENTER;
-    save_magic(sv);
+    save_magic(&mgs, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
@@ -289,10 +281,8 @@ MAGIC *mg;
                (t = rx->endp[paren]))
            {
                i = t - s;
-               if (i >= 0) {
-                   TAINT_IF(rx->exec_tainted);
+               if (i >= 0)
                    return i;
-               }
            }
        }
        return 0;
@@ -300,28 +290,26 @@ MAGIC *mg;
     case '+':
        if (curpm && (rx = curpm->op_pmregexp)) {
            paren = rx->lastparen;
-           if (!paren)
-               return 0;
-           goto getparen;
+           if (paren)
+               goto getparen;
        }
        return 0;
        break;
     case '`':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->subbeg)) {
+           if ((s = rx->subbeg) && rx->startp[0]) {
                i = rx->startp[0] - s;
-               if (i >= 0) {
-                   TAINT_IF(rx->exec_tainted);
+               if (i >= 0)
                    return i;
-               }
            }
        }
        return 0;
     case '\'':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->endp[0])) {
-               TAINT_IF(rx->exec_tainted);
-               return (STRLEN) (rx->subend - s);
+           if (rx->subend && (s = rx->endp[0])) {
+               i = rx->subend - s;
+               if (i >= 0)
+                   return 0;
            }
        }
        return 0;
@@ -418,9 +406,16 @@ MAGIC *mg;
                (t = rx->endp[paren]))
            {
                i = t - s;
+             getrx:
                if (i >= 0) {
+                   bool was_tainted;
+                   if (tainting) {
+                       was_tainted = tainted;
+                       tainted = FALSE;
+                   }
                    sv_setpvn(sv,s,i);
-                   TAINT_FROM_REGEX(sv,rx);
+                   if (tainting)
+                       tainted = was_tainted || rx->exec_tainted;
                    break;
                }
            }
@@ -437,23 +432,18 @@ MAGIC *mg;
        break;
     case '`':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->subbeg)) {
+           if ((s = rx->subbeg) && rx->startp[0]) {
                i = rx->startp[0] - s;
-               if (i >= 0) {
-                   sv_setpvn(sv,s,i);
-                   TAINT_FROM_REGEX(sv,rx);
-                   break;
-               }
+               goto getrx;
            }
        }
        sv_setsv(sv,&sv_undef);
        break;
     case '\'':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->endp[0])) {
-               sv_setpvn(sv,s, rx->subend - s);
-               TAINT_FROM_REGEX(sv,rx);
-               break;
+           if (rx->subend && (s = rx->endp[0])) {
+               i = rx->subend - s;
+               goto getrx;
            }
        }
        sv_setsv(sv,&sv_undef);
@@ -466,7 +456,11 @@ MAGIC *mg;
 #endif
        break;
     case '?':
-       sv_setiv(sv, (IV)statusvalue);
+       sv_setiv(sv, (IV)STATUS_CURRENT);
+#ifdef COMPLEX_STATUS
+       LvTARGOFF(sv) = statusvalue;
+       LvTARGLEN(sv) = statusvalue_vms;
+#endif
        break;
     case '^':
        s = IoTOP_NAME(GvIOp(defoutgv));
@@ -591,37 +585,76 @@ MAGIC* mg;
     char *ptr;
     STRLEN len;
     I32 i;
+
     s = SvPV(sv,len);
     ptr = MgPV(mg);
     my_setenv(ptr, s);
+
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
     if (!len) {
        HE *envhe;
        SV *keysv;
-       if (mg->mg_len == HEf_SVKEY) keysv = (SV *)mg->mg_ptr;
-       else keysv = newSVpv(mg->mg_ptr,mg->mg_len);
-       if (envhe = hv_fetch_ent(GvHVn(envgv),keysv,FALSE,0))
-           s = SvPV(HeVAL(envhe),len);
-       if (mg->mg_len != HEf_SVKEY) SvREFCNT_dec(keysv);
+       if (mg->mg_len == HEf_SVKEY)
+           keysv = (SV *)mg->mg_ptr;
+       else
+           keysv = newSVpv(mg->mg_ptr, mg->mg_len);
+       if ((envhe = hv_fetch_ent(GvHVn(envgv), keysv, FALSE, 0)))
+           s = SvPV(HeVAL(envhe), len);
+       if (mg->mg_len != HEf_SVKEY)
+           SvREFCNT_dec(keysv);
     }
 #endif
+
+#if !defined(OS2) && !defined(AMIGAOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
+       MgTAINTEDDIR_off(mg);
+#ifdef VMS
+       if (s && strnEQ(ptr, "DCL$PATH", 8)) {
+           char pathbuf[256], eltbuf[256], *cp, *elt = s;
+           struct stat sbuf;
+           int i = 0, j = 0;
+
+           do {          /* DCL$PATH may be a search list */
+               while (1) {   /* as may dev portion of any element */
+                   if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
+                       if ( *(cp+1) == '.' || *(cp+1) == '-' ||
+                            cando_by_name(S_IWUSR,0,elt) ) {
+                           MgTAINTEDDIR_on(mg);
+                           return 0;
+                       }
+                   }
+                   if ((cp = strchr(elt, ':')) != Nullch)
+                       *cp = '\0';
+                   if (my_trnlnm(elt, eltbuf, j++))
+                       elt = eltbuf;
+                   else
+                       break;
+               }
+               j = 0;
+           } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
+       }
+#endif /* VMS */
        if (s && strEQ(ptr,"PATH")) {
            char *strend = s + len;
 
            while (s < strend) {
-               s = cpytill(tokenbuf,s,strend,':',&i);
+               struct stat st;
+               s = cpytill(tokenbuf, s, strend, ':', &i);
                s++;
                if (*tokenbuf != '/'
-                 || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+                     || (Stat(tokenbuf, &st) == 0 && (st.st_mode & 2)) ) {
                    MgTAINTEDDIR_on(mg);
+                   return 0;
+               }
            }
        }
     }
+#endif /* neither OS2 nor AMIGAOS */
+
     return 0;
 }
 
@@ -712,13 +745,11 @@ MAGIC* mg;
                warn("No such signal: SIG%s", s);
            return 0;
        }
-        if(psig_ptr[i])
-           SvREFCNT_dec(psig_ptr[i]);
+       SvREFCNT_dec(psig_name[i]);
+       SvREFCNT_dec(psig_ptr[i]);
        psig_ptr[i] = SvREFCNT_inc(sv);
-       if(psig_name[i])
-           SvREFCNT_dec(psig_name[i]);
-       psig_name[i] = newSVpv(s,strlen(s));
        SvTEMP_off(sv); /* Make sure it doesn't go away on us */
+       psig_name[i] = newSVpv(s, strlen(s));
        SvREADONLY_on(psig_name[i]);
     }
     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
@@ -1007,6 +1038,7 @@ MAGIC* mg;
     else if (pos > len)
        pos = len;
     mg->mg_len = pos;
+    mg->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
 }
@@ -1045,12 +1077,6 @@ MAGIC* mg;
     if (GvGP(sv))
        gp_free((GV*)sv);
     GvGP(sv) = gp_ref(GvGP(gv));
-    if (!GvAV(gv))
-       gv_AVadd(gv);
-    if (!GvHV(gv))
-       gv_HVadd(gv);
-    if (!GvIOp(gv))
-       GvIOp(gv) = newIO();
     return 0;
 }
 
@@ -1103,6 +1129,65 @@ MAGIC* mg;
 }
 
 int
+magic_getitervar(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SV *targ = Nullsv;
+    if (LvTARGLEN(sv)) {
+       AV* av = (AV*)LvTARG(sv);
+       if (LvTARGOFF(sv) <= AvFILL(av))
+           targ = AvARRAY(av)[LvTARGOFF(sv)];
+    }
+    else
+       targ = LvTARG(sv);
+    sv_setsv(sv, targ ? targ : &sv_undef);
+    return 0;
+}
+
+int
+magic_setitervar(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    if (LvTARGLEN(sv))
+       vivify_itervar(sv);
+    if (LvTARG(sv))
+       sv_setsv(LvTARG(sv), sv);
+    return 0;
+}
+
+int
+magic_freeitervar(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SvREFCNT_dec(LvTARG(sv));
+    return 0;
+}
+
+void
+vivify_itervar(sv)
+SV* sv;
+{
+    AV* av;
+
+    if (!LvTARGLEN(sv))
+       return;
+    av = (AV*)LvTARG(sv);
+    if (LvTARGOFF(sv) <= AvFILL(av)) {
+       SV** svp = AvARRAY(av) + LvTARGOFF(sv);
+       LvTARG(sv) = newSVsv(*svp);
+       SvREFCNT_dec(*svp);
+       *svp = SvREFCNT_inc(LvTARG(sv));
+    }
+    else
+       LvTARG(sv) = Nullsv;
+    SvREFCNT_dec(av);
+    LvTARGLEN(sv) = 0;
+}
+
+int
 magic_setmglob(sv,mg)
 SV* sv;
 MAGIC* mg;
@@ -1144,6 +1229,7 @@ MAGIC* mg;
     return 0;
 }
 
+#ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(sv,mg)
 SV* sv;
@@ -1153,9 +1239,14 @@ MAGIC* mg;
      * RenĂ© Descartes said "I think not."
      * and vanished with a faint plop.
      */
-    sv_unmagic(sv, 'o');
+    if (mg->mg_ptr) {
+       Safefree(mg->mg_ptr);
+       mg->mg_ptr = NULL;
+       mg->mg_len = -1;
+    }
     return 0;
 }
+#endif /* USE_LOCALE_COLLATE */
 
 int
 magic_set(sv,mg)
@@ -1177,7 +1268,8 @@ MAGIC* mg;
 #ifdef VMS
        set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #else
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);         /* will anyone ever use this? */
+       /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #endif
        break;
     case '\006':       /* ^F */
@@ -1270,7 +1362,12 @@ MAGIC* mg;
     case '\\':
        if (ors)
            Safefree(ors);
-       ors = savepv(SvPV(sv,orslen));
+       if (SvOK(sv) || SvGMAGICAL(sv))
+           ors = savepv(SvPV(sv,orslen));
+       else {
+           ors = Nullch;
+           orslen = 0;
+       }
        break;
     case ',':
        if (ofs)
@@ -1286,10 +1383,23 @@ MAGIC* mg;
        compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        break;
     case '?':
-       statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#ifdef COMPLEX_STATUS
+       if (localizing == 2) {
+           statusvalue = LvTARGOFF(sv);
+           statusvalue_vms = LvTARGLEN(sv);
+       }
+       else
+#endif
+#ifdef VMSISH_STATUS
+       if (VMSISH_STATUS)
+           STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
+       else
+#endif
+           STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);              /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
+                (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
        break;
     case '<':
        uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1474,10 +1584,10 @@ int sig;
     SV *sv;
     CV *cv;
     AV *oldstack;
-    
-    if(!psig_ptr[sig])
-       die("Signal SIG%s received, but no signal handler set.\n",
-       sig_name[sig]);
+
+    if (!psig_ptr[sig])
+       die("Signal SIG%s received, but no signal handler set.\n",
+           sig_name[sig]);
 
     cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
     if (!cv || !CvROOT(cv)) {
@@ -1495,8 +1605,8 @@ int sig;
     if(psig_name[sig])
        sv = SvREFCNT_inc(psig_name[sig]);
     else {
-        sv = sv_newmortal();
-        sv_setpv(sv,sig_name[sig]);
+       sv = sv_newmortal();
+       sv_setpv(sv,sig_name[sig]);
     }
     PUSHMARK(sp);
     PUSHs(sv);