[no reason given] is not good.

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

diff --git a/mg.c b/mg.c
index af8e9a0..793035d 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -25,8 +25,8 @@
 #  endif
 #endif
 
-static void restore_magic(pTHXo_ void *p);
-static void unwind_handler_stack(pTHXo_ void *p);
+static void restore_magic(pTHX_ void *p);
+static void unwind_handler_stack(pTHX_ void *p);
 
 /*
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
@@ -134,7 +134,7 @@ Perl_mg_get(pTHX_ SV *sv)
        }
     }
 
-    restore_magic(aTHXo_ INT2PTR(void *, (IV)mgs_ix));
+    restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix));
     return 0;
 }
 
@@ -167,7 +167,7 @@ Perl_mg_set(pTHX_ SV *sv)
            CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
     }
 
-    restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
     return 0;
 }
 
@@ -194,7 +194,7 @@ Perl_mg_length(pTHX_ SV *sv)
            save_magic(mgs_ix, sv);
            /* omit MGf_GSKIP -- not changed here */
            len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
-           restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+           restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
            return len;
        }
     }
@@ -224,7 +224,7 @@ Perl_mg_size(pTHX_ SV *sv)
            save_magic(mgs_ix, sv);
            /* omit MGf_GSKIP -- not changed here */
            len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
-           restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+           restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
            return len;
        }
     }
@@ -267,7 +267,7 @@ Perl_mg_clear(pTHX_ SV *sv)
            CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
     }
 
-    restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+    restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
     return 0;
 }
 
@@ -392,7 +392,7 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                else                    /* @- */
                    i = s;
                
-               if (i > 0 && PL_reg_sv_utf8) {
+               if (i > 0 && PL_reg_match_utf8) {
                    char *b = rx->subbeg;
                    if (b)
                        i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
@@ -433,7 +433,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
            {
                i = t1 - s1;
              getlen:
-               if (i > 0 && PL_reg_sv_utf8) {
+               if (i > 0 && PL_reg_match_utf8) {
                    char *s    = rx->subbeg + s1;
                    char *send = rx->subbeg + t1;
 
@@ -612,12 +612,16 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        }
        break;
     case '\024':               /* ^T */
+        if (*(mg->mg_ptr+1) == '\0') {
 #ifdef BIG_TIME
-       sv_setnv(sv, PL_basetime);
+            sv_setnv(sv, PL_basetime);
 #else
-       sv_setiv(sv, (IV)PL_basetime);
+            sv_setiv(sv, (IV)PL_basetime);
 #endif
-       break;
+        }
+        else if (strEQ(mg->mg_ptr, "\024AINT"))
+            sv_setiv(sv, PL_tainting);
+        break;
     case '\027':               /* ^W  & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */
        if (*(mg->mg_ptr+1) == '\0')
            sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
@@ -666,7 +670,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                        PL_tainted = FALSE;
                    }
                    sv_setpvn(sv, s, i);
-                   if (PL_reg_sv_utf8 && is_utf8_string((U8*)s, i))
+                   if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
                        SvUTF8_on(sv);
                    else
                        SvUTF8_off(sv);
@@ -955,27 +959,10 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #if defined(VMS) || defined(EPOC)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
-#   ifdef PERL_IMPLICIT_SYS
+#   if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
     PerlEnv_clearenv();
 #   else
-#      ifdef WIN32
-    char *envv = GetEnvironmentStrings();
-    char *cur = envv;
-    STRLEN len;
-    while (*cur) {
-       char *end = strchr(cur,'=');
-       if (end && end != cur) {
-           *end = '\0';
-           my_setenv(cur,Nullch);
-           *end = '=';
-           cur = end + strlen(end+1)+2;
-       }
-       else if ((len = strlen(cur)))
-           cur += len+1;
-    }
-    FreeEnvironmentStrings(envv);
-#      else
-#ifdef USE_ENVIRON_ARRAY
+#       ifdef USE_ENVIRON_ARRAY
 #          ifndef PERL_USE_SAFE_PUTENV
     I32 i;
 
@@ -988,10 +975,9 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 
     environ[0] = Nullch;
 
-#endif /* USE_ENVIRON_ARRAY */
-#      endif /* WIN32 */
-#   endif /* PERL_IMPLICIT_SYS */
-#endif /* VMS */
+#       endif /* USE_ENVIRON_ARRAY */
+#   endif /* PERL_IMPLICIT_SYS || WIN32 */
+#endif /* VMS || EPC */
     return 0;
 }
 
@@ -1506,7 +1492,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
        sv_insert(lsv, lvoff, lvlen, tmps, len);
        SvUTF8_on(lsv);
     }
-    else if (SvUTF8(lsv)) {
+    else if (lsv && SvUTF8(lsv)) {
        sv_pos_u2b(lsv, &lvoff, &lvlen);
        tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
        sv_insert(lsv, lvoff, lvlen, tmps, len);
@@ -1894,6 +1880,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '|':
        {
            IO *io = GvIOp(PL_defoutgv);
+           if(!io)
+             break;
            if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
                IoFLAGS(io) &= ~IOf_FLUSH;
            else {
@@ -1911,10 +1899,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_multiline = (i != 0);
        break;
     case '/':
-       SvREFCNT_dec(PL_nrs);
-       PL_nrs = newSVsv(sv);
        SvREFCNT_dec(PL_rs);
-       PL_rs = SvREFCNT_inc(PL_nrs);
+       PL_rs = newSVsv(sv);
        break;
     case '\\':
        if (PL_ors_sv)
@@ -2218,13 +2204,15 @@ Perl_whichsig(pTHX_ char *sig)
     return 0;
 }
 
+#if !defined(PERL_IMPLICIT_CONTEXT)
 static SV* sig_sv;
+#endif
 
 Signal_t
 Perl_sighandler(int sig)
 {
 #if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    dTHXoa(PL_curinterp);      /* fake TLS, because signals don't do TLS */
+    dTHXa(PL_curinterp);       /* fake TLS, because signals don't do TLS */
 #else
     dTHX;
 #endif
@@ -2238,7 +2226,7 @@ Perl_sighandler(int sig)
     XPV *tXpv = PL_Xpv;
 
 #if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    PERL_SET_THX(aTHXo);       /* fake TLS, see above */
+    PERL_SET_THX(aTHX);        /* fake TLS, see above */
 #endif
 
     if (PL_savestack_ix + 15 <= PL_savestack_max)
@@ -2286,7 +2274,9 @@ Perl_sighandler(int sig)
     if(PL_psig_name[sig]) {
        sv = SvREFCNT_inc(PL_psig_name[sig]);
        flags |= 64;
+#if !defined(PERL_IMPLICIT_CONTEXT)
        sig_sv = sv;
+#endif
     } else {
        sv = sv_newmortal();
        sv_setpv(sv,PL_sig_name[sig]);
@@ -2317,7 +2307,7 @@ Perl_sighandler(int sig)
        (void)rsignal(sig, &Perl_csighandler);
 #endif
 #endif /* !PERL_MICRO */
-       Perl_die(aTHX_ Nullch);
+       Perl_die(aTHX_ Nullformat);
     }
 cleanup:
     if (flags & 1)
@@ -2338,12 +2328,8 @@ cleanup:
 }
 
 
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
 static void
-restore_magic(pTHXo_ void *p)
+restore_magic(pTHX_ void *p)
 {
     MGS* mgs = SSPTR(PTR2IV(p), MGS*);
     SV* sv = mgs->mgs_sv;
@@ -2384,13 +2370,15 @@ restore_magic(pTHXo_ void *p)
 }
 
 static void
-unwind_handler_stack(pTHXo_ void *p)
+unwind_handler_stack(pTHX_ void *p)
 {
     U32 flags = *(U32*)p;
 
     if (flags & 1)
        PL_savestack_ix -= 5; /* Unprotect save in progress. */
     /* cxstack_ix-- Not needed, die already unwound it. */
+#if !defined(PERL_IMPLICIT_CONTEXT)
     if (flags & 64)
        SvREFCNT_dec(sig_sv);
+#endif
 }