X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=bdf204bd8f3d6e69c8ae33a9d6b863f547ac2fa2;hb=0678cb22c235366e6443f8ba36afc299093d457c;hp=44324296210cb40dab28290213590b6af8a57a39;hpb=765f542df20317f47bb284c276cd0abfb50dcfd6;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 4432429..bdf204b 100644
--- a/mg.c
+++ b/mg.c
@@ -29,6 +29,10 @@
 #  endif
 #endif
 
+#ifdef __hpux
+#  include <sys/pstat.h>
+#endif
+
 /* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
 #if !defined(HAS_SIGACTION) && defined(VMS)
 #  define  FAKE_PERSISTENT_SIGNAL_HANDLERS
@@ -654,7 +658,9 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #endif
         }
         else if (strEQ(mg->mg_ptr, "\024AINT"))
-            sv_setiv(sv, PL_tainting);
+            sv_setiv(sv, PL_tainting
+		    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
+		    : 0);
         break;
     case '\027':		/* ^W  & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */
 	if (*(mg->mg_ptr+1) == '\0')
@@ -814,7 +820,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\\':
 	if (PL_ors_sv)
-	    sv_setpv(sv,SvPVX(PL_ors_sv));
+	    sv_copypv(sv, PL_ors_sv);
 	break;
     case '#':
 	sv_setpv(sv,PL_ofmt);
@@ -872,11 +878,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '0':
 	break;
 #endif
-#ifdef USE_5005THREADS
-    case '@':
-	sv_setsv(sv, thr->errsv);
-	break;
-#endif /* USE_5005THREADS */
     }
     return 0;
 }
@@ -1851,32 +1852,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	DEBUG_x(dump_all());
 	break;
     case '\005':  /* ^E */
-	 if (*(mg->mg_ptr+1) == '\0') {
+	if (*(mg->mg_ptr+1) == '\0') {
 #ifdef MACOS_TRADITIONAL
-	      gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+	    gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 #else
 #  ifdef VMS
-	      set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #  else
 #    ifdef WIN32
-	      SetLastError( SvIV(sv) );
+	    SetLastError( SvIV(sv) );
 #    else
 #      ifdef OS2
-	      os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+	    os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #      else
-	      /* will anyone ever use this? */
-	      SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+	    /* will anyone ever use this? */
+	    SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #      endif
 #    endif
 #  endif
 #endif
-	 }
-	 else if (strEQ(mg->mg_ptr+1, "NCODING")) {
-	     if (PL_encoding)
-	         sv_setsv(PL_encoding, sv);
-	     else
-	         PL_encoding = newSVsv(sv);
-	 }
+	}
+	else if (strEQ(mg->mg_ptr+1, "NCODING")) {
+	    if (PL_encoding)
+		SvREFCNT_dec(PL_encoding);
+	    if (SvOK(sv) || SvGMAGICAL(sv)) {
+		PL_encoding = newSVsv(sv);
+	    }
+	    else {
+		PL_encoding = Nullsv;
+	    }
+	}
+	break;
     case '\006':	/* ^F */
 	PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 	break;
@@ -2062,8 +2068,15 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 	break;
     case '!':
+        {
+#ifdef VMS
+#   define PERL_VMS_BANG vaxc$errno
+#else
+#   define PERL_VMS_BANG 0
+#endif
 	SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
-		 (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
+		 (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG);
+	}
 	break;
     case '<':
 	PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -2200,6 +2213,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
 #ifndef MACOS_TRADITIONAL
     case '0':
+	LOCK_DOLLARZERO_MUTEX;
 #ifdef HAS_SETPROCTITLE
 	/* The BSDs don't show the argv[] in ps(1) output, they
 	 * show a string from the process struct and provide
@@ -2224,6 +2238,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #   endif
 	}
 #endif
+#if defined(__hpux) && defined(PSTAT_SETCMD)
+	{
+	     union pstun un;
+	     s = SvPV(sv, len);
+	     un.pst_command = s;
+	     pstat(PSTAT_SETCMD, un, len, 0, 0);
+	}
+#endif
 	if (!PL_origalen) {
 	    s = PL_origargv[0];
 	    s += strlen(s);
@@ -2279,32 +2301,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    for (i = 1; i < PL_origargc; i++)
 		PL_origargv[i] = Nullch;
 	}
+	UNLOCK_DOLLARZERO_MUTEX;
 	break;
 #endif
-#ifdef USE_5005THREADS
-    case '@':
-	sv_setsv(thr->errsv, sv);
-	break;
-#endif /* USE_5005THREADS */
     }
     return 0;
 }
 
-#ifdef USE_5005THREADS
-int
-Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
-{
-    DEBUG_S(PerlIO_printf(Perl_debug_log,
-			  "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
-			  PTR2UV(thr), PTR2UV(sv)));
-    if (MgOWNER(mg))
-	Perl_croak(aTHX_ "panic: magic_mutexfree");
-    MUTEX_DESTROY(MgMUTEXP(mg));
-    COND_DESTROY(MgCONDP(mg));
-    return 0;
-}
-#endif /* USE_5005THREADS */
-
 I32
 Perl_whichsig(pTHX_ char *sig)
 {