[win32] add archname to *sitearch in config.{b,g,v}c

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

diff --git a/mg.c b/mg.c
index 5d27026..1d00143 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -69,7 +69,6 @@ restore_magic(void *p)
     }
 }
 
-
 void
 mg_magical(SV *sv)
 {
@@ -247,6 +246,7 @@ mg_free(SV *sv)
 U32
 magic_len(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -310,6 +310,7 @@ magic_len(SV *sv, MAGIC *mg)
 int
 magic_get(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -348,10 +349,22 @@ magic_get(SV *sv, MAGIC *mg)
            sv_setpv(sv, os2error(Perl_rc));
        }
 #else
+#ifdef WIN32
+       {
+           DWORD dwErr = GetLastError();
+           sv_setnv(sv, (double)dwErr);
+           if (dwErr)
+               win32_str_os_error(sv, dwErr);
+           else
+               sv_setpv(sv, "");
+           SetLastError(dwErr);
+       }
+#else
        sv_setnv(sv, (double)errno);
        sv_setpv(sv, errno ? Strerror(errno) : "");
 #endif
 #endif
+#endif
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
     case '\006':               /* ^F */
@@ -396,7 +409,11 @@ magic_get(SV *sv, MAGIC *mg)
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           paren = atoi(GvENAME((GV*)mg->mg_obj));
+           /*
+            * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
+            * XXX Does the new way break anything?
+            */
+           paren = atoi(mg->mg_ptr);
          getparen:
            if (paren <= rx->nparens &&
                (s = rx->startp[paren]) &&
@@ -412,7 +429,7 @@ magic_get(SV *sv, MAGIC *mg)
                    }
                    sv_setpvn(sv,s,i);
                    if (tainting)
-                       tainted = was_tainted || rx->exec_tainted;
+                       tainted = was_tainted || RX_MATCH_TAINTED(rx);
                    break;
                }
            }
@@ -553,6 +570,11 @@ magic_get(SV *sv, MAGIC *mg)
        break;
     case '0':
        break;
+#ifdef USE_THREADS
+    case '@':
+       sv_setsv(sv, thr->errsv);
+       break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -589,7 +611,7 @@ magic_setenv(SV *sv, MAGIC *mg)
     }
 #endif
 
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
@@ -638,7 +660,7 @@ magic_setenv(SV *sv, MAGIC *mg)
            }
        }
     }
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
 
     return 0;
 }
@@ -718,7 +740,6 @@ magic_getsig(SV *sv, MAGIC *mg)
        if(psig_ptr[i])
            sv_setsv(sv,psig_ptr[i]);
        else {
-           dTHR;               /* just for SvREFCNT_inc */
            Sighandler_t sigstate = rsignal_state(i);
 
            /* cache state so we don't fetch it again */
@@ -828,7 +849,54 @@ magic_setsig(SV *sv, MAGIC *mg)
 int
 magic_setisa(SV *sv, MAGIC *mg)
 {
+    HV *stash;
+    SV **svp;
+    I32 fill;
+    HV *basefields = Nullhv;
+    GV **gvp;
+    GV *gv;
+    HE *he;
+    static char *FIELDS = "FIELDS";
+
     sub_generation++;
+
+    if (mg->mg_type == 'i')
+       return 0;       /* Ignore lower-case version of the magic */
+
+    stash = GvSTASH(mg->mg_obj);
+    svp = AvARRAY((AV*)sv);
+    
+    for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
+       HV *basestash = gv_stashsv(*svp, FALSE);
+
+       if (!basestash) {
+           if (dowarn)
+               warn("No such package \"%_\" in @ISA assignment", *svp);
+           continue;
+       }
+       gvp = (GV**)hv_fetch(basestash, FIELDS, 6, FALSE);
+       if (gvp && *gvp && GvHV(*gvp)) {
+           if (basefields)
+               croak("Can't multiply inherit %%FIELDS");
+           basefields = GvHV(*gvp);
+       }
+    }
+
+    if (!basefields)
+       return 0;
+    
+    gv = (GV*)*hv_fetch(stash, FIELDS, 6, TRUE);
+    if (!isGV(gv))
+       gv_init(gv, stash, FIELDS, 6, TRUE);
+    if (!GvHV(gv))
+       GvHV(gv) = newHV();
+    if (HvKEYS(GvHV(gv)))
+       croak("Inherited %%FIELDS can't override existing %%FIELDS");
+
+    hv_iterinit(GvHV(gv));
+    while ((he = hv_iternext(basefields)))
+       hv_store(GvHV(gv), HeKEY(he), HeKLEN(he), HeVAL(he), HeHASH(he));
+
     return 0;
 }
 
@@ -1098,6 +1166,7 @@ magic_setsubstr(SV *sv, MAGIC *mg)
 int
 magic_gettaint(SV *sv, MAGIC *mg)
 {
+    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
             (mg->mg_len & 2) && mg->mg_obj == sv);     /* kludge */
     return 0;
@@ -1247,6 +1316,14 @@ magic_setuvar(SV *sv, MAGIC *mg)
     return 0;
 }
 
+int
+magic_freeregexp(SV *sv, MAGIC *mg)
+{
+    regexp *re = (regexp *)mg->mg_obj;
+    ReREFCNT_dec(re);
+    return 0;
+}
+
 #ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(SV *sv, MAGIC *mg)
@@ -1283,9 +1360,13 @@ magic_set(SV *sv, MAGIC *mg)
 #ifdef VMS
        set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #else
+#ifdef WIN32
+       SetLastError( SvIV(sv) );
+#else
        /* will anyone ever use this? */
        SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #endif
+#endif
        break;
     case '\006':       /* ^F */
        maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1604,6 +1685,11 @@ magic_set(SV *sv, MAGIC *mg)
                origargv[i] = Nullch;
        }
        break;
+#ifdef USE_THREADS
+    case '@':
+       sv_setsv(thr->errsv, sv);
+       break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -1662,15 +1748,15 @@ Signal_t
 sighandler(int sig)
 {
     dSP;
-    GV *gv;
+    GV *gv = Nullgv;
     HV *st;
     SV *sv, *tSv = Sv;
-    CV *cv;
+    CV *cv = Nullcv;
     AV *oldstack;
     OP *myop = op;
     U32 flags = 0;
     I32 o_save_i = savestack_ix, type;
-    CONTEXT *cx;
+    PERL_CONTEXT *cx;
     XPV *tXpv = Xpv;
     
     if (savestack_ix + 15 <= savestack_max)
@@ -1717,8 +1803,11 @@ sighandler(int sig)
     if (!cv || !CvROOT(cv)) {
        if (dowarn)
            warn("SIG%s handler \"%s\" not defined.\n",
-               sig_name[sig], GvENAME(gv) );
-       return;
+               sig_name[sig], (gv ? GvENAME(gv)
+                               : ((cv && CvGV(cv))
+                                  ? GvENAME(CvGV(cv))
+                                  : "__ANON__")));
+       goto cleanup;
     }
 
     oldstack = curstack;
@@ -1741,6 +1830,7 @@ sighandler(int sig)
     perl_call_sv((SV*)cv, G_DISCARD);
 
     SWITCHSTACK(signalstack, oldstack);
+cleanup:
     if (flags & 1)
        savestack_ix -= 8; /* Unprotect save in progress. */
     if (flags & 2) {