X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=8cc9d85f43b185052e70e6b32491d47b0cdf3f1b;hb=79522dd28c2cdf92c115561db038e46cd34e5073;hp=9ba8d10a961484afb5edd90e58d53dc2ba531360;hpb=fb45abb286e885c11569ca1f9190bd239b0f0319;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 9ba8d10..8cc9d85 100644
--- a/mg.c
+++ b/mg.c
@@ -86,11 +86,10 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
     dVAR;
     MGS* mgs;
     assert(SvMAGICAL(sv));
-#ifdef PERL_OLD_COPY_ON_WRITE
-    /* Turning READONLY off for a copy-on-write scalar is a bad idea.  */
+    /* Turning READONLY off for a copy-on-write scalar (including shared
+       hash keys) is a bad idea.  */
     if (SvIsCOW(sv))
       sv_force_normal_flags(sv, 0);
-#endif
 
     SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix));
 
@@ -101,7 +100,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
-    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+    SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 }
 
 /*
@@ -116,6 +115,7 @@ void
 Perl_mg_magical(pTHX_ SV *sv)
 {
     const MAGIC* mg;
+    PERL_UNUSED_CONTEXT;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	const MGVTBL* const vtbl = mg->mg_virtual;
 	if (vtbl) {
@@ -152,7 +152,7 @@ Perl_mg_get(pTHX_ SV *sv)
        cause the SV's buffer to get stolen (and maybe other stuff).
        So restore it.
     */
-    sv_2mortal(SvREFCNT_inc(sv));
+    sv_2mortal(SvREFCNT_inc_simple(sv));
     if (!was_temp) {
 	SvTEMP_off(sv);
     }
@@ -348,6 +348,7 @@ Finds the magic pointer for type matching the SV.  See C<sv_magic>.
 MAGIC*
 Perl_mg_find(pTHX_ const SV *sv, int type)
 {
+    PERL_UNUSED_CONTEXT;
     if (sv) {
         MAGIC *mg;
         for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -355,7 +356,7 @@ Perl_mg_find(pTHX_ const SV *sv, int type)
                 return mg;
         }
     }
-    return 0;
+    return NULL;
 }
 
 /*
@@ -409,7 +410,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
     dVAR;
     MAGIC *mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-	const MGVTBL* const vtbl = mg->mg_virtual;
+	MGVTBL* const vtbl = mg->mg_virtual;
 	switch (mg->mg_type) {
 	/* value magic types: don't copy */
 	case PERL_MAGIC_bm:
@@ -642,12 +643,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 }
 
 #define SvRTRIM(sv) STMT_START { \
-    STRLEN len = SvCUR(sv); \
-    char * const p = SvPVX(sv); \
-    while (len > 0 && isSPACE(p[len-1])) \
-	--len; \
-    SvCUR_set(sv, len); \
-    p[len] = '\0'; \
+    if (SvPOK(sv)) { \
+        STRLEN len = SvCUR(sv); \
+        char * const p = SvPVX(sv); \
+	while (len > 0 && isSPACE(p[len-1])) \
+	   --len; \
+	SvCUR_set(sv, len); \
+	p[len] = '\0'; \
+    } \
 } STMT_END
 
 int
@@ -679,15 +682,14 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\005':  /* ^E */
 	 if (nextchar == '\0') {
-#ifdef MACOS_TRADITIONAL
+#if defined(MACOS_TRADITIONAL)
 	     {
 		  char msg[256];
 
 		  sv_setnv(sv,(double)gMacPerl_OSErr);
 		  sv_setpv(sv, gMacPerl_OSErr ? GetSysErrText(gMacPerl_OSErr, msg) : "");
 	     }
-#else
-#ifdef VMS
+#elif defined(VMS)
 	     {
 #	          include <descrip.h>
 #	          include <starlet.h>
@@ -699,8 +701,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		  else
 		       sv_setpvn(sv,"",0);
 	     }
-#else
-#ifdef OS2
+#elif defined(OS2)
 	     if (!(_emx_env & 0x200)) {	/* Under DOS */
 		  sv_setnv(sv, (NV)errno);
 		  sv_setpv(sv, errno ? Strerror(errno) : "");
@@ -713,8 +714,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		  sv_setnv(sv, (NV)Perl_rc);
 		  sv_setpv(sv, os2error(Perl_rc));
 	     }
-#else
-#ifdef WIN32
+#elif defined(WIN32)
 	     {
 		  DWORD dwErr = GetLastError();
 		  sv_setnv(sv, (NV)dwErr);
@@ -733,9 +733,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		 errno = saveerrno;
 	     }
 #endif
-#endif
-#endif
-#endif
 	     SvRTRIM(sv);
 	     SvNOK_on(sv);	/* what a wonderful hack! */
 	 }
@@ -818,7 +815,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		 * it could have been extended by warnings::register */
 		SV **bits_all;
 		HV * const bits=get_hv("warnings::Bits", FALSE);
-		if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+		if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
 		    sv_setsv(sv, *bits_all);
 		}
 	        else {
@@ -848,8 +845,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    {
 		i = t1 - s1;
 		s = rx->subbeg + s1;
-		if (!rx->subbeg)
-		    break;
+		assert(rx->subbeg);
 
 	      getrx:
 		if (i >= 0) {
@@ -1081,7 +1077,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 			    return 0;
 			}
 		    }
-		    if ((cp = strchr(elt, ':')) != Nullch)
+		    if ((cp = strchr(elt, ':')) != NULL)
 			*cp = '\0';
 		    if (my_trnlnm(elt, eltbuf, j++))
 			elt = eltbuf;
@@ -1120,7 +1116,7 @@ int
 Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_UNUSED_ARG(sv);
-    my_setenv(MgPV_nolen_const(mg),Nullch);
+    my_setenv(MgPV_nolen_const(mg),NULL);
     return 0;
 }
 
@@ -1192,7 +1188,7 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     	    	sv_setpv(sv,"IGNORE");
     	    else
     	    	sv_setsv(sv,&PL_sv_undef);
-    	    PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	    PL_psig_ptr[i] = SvREFCNT_inc_simple(sv);
     	    SvTEMP_off(sv);
     	}
     }
@@ -1404,7 +1400,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	SvREFCNT_dec(PL_psig_name[i]);
 	to_dec = PL_psig_ptr[i];
-	PL_psig_ptr[i] = SvREFCNT_inc(sv);
+	PL_psig_ptr[i] = SvREFCNT_inc_simple(sv);
 	SvTEMP_off(sv); /* Make sure it doesn't go away on us */
 	PL_psig_name[i] = newSVpvn(s, len);
 	SvREADONLY_on(PL_psig_name[i]);
@@ -1417,7 +1413,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 #endif
 	}
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple_NN(sv);
 	if(to_dec)
 	    SvREFCNT_dec(to_dec);
 	return 0;
@@ -1455,7 +1451,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	if (i)
 	    (void)rsignal(i, PL_csighandlerp);
 	else
-	    *svp = SvREFCNT_inc(sv);
+	    *svp = SvREFCNT_inc_simple(sv);
     }
 #ifdef HAS_SIGPROCMASK
     if(i)
@@ -1843,20 +1839,6 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 }
 
 int
-Perl_magic_getglob(pTHX_ SV *sv, MAGIC *mg)
-{
-    PERL_UNUSED_ARG(mg);
-    if (SvFAKE(sv)) {			/* FAKE globs can get coerced */
-	SvFAKE_off(sv);
-	gv_efullname3(sv,((GV*)sv), "*");
-	SvFAKE_on(sv);
-    }
-    else
-	gv_efullname3(sv,((GV*)sv), "*");	/* a gv value, be nice */
-    return 0;
-}
-
-int
 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 {
     GV* gv;
@@ -1864,6 +1846,12 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
 	return 0;
+    if (SvFLAGS(sv) & SVp_SCREAM
+	&& (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVGV)) {
+	/* We're actually already a typeglob, so don't need the stuff below.
+	 */
+	return 0;
+    }
     gv =  gv_fetchsv(sv, GV_ADD, SVt_PVGV);
     if (sv == (SV*)gv)
 	return 0;
@@ -1979,7 +1967,7 @@ int
 Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    SV *targ = Nullsv;
+    SV *targ = NULL;
     if (LvTARGLEN(sv)) {
 	if (mg->mg_obj) {
 	    SV * const ahv = LvTARG(sv);
@@ -1995,10 +1983,10 @@ Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 	if (targ && targ != &PL_sv_undef) {
 	    /* somebody else defined it for us */
 	    SvREFCNT_dec(LvTARG(sv));
-	    LvTARG(sv) = SvREFCNT_inc(targ);
+	    LvTARG(sv) = SvREFCNT_inc_simple_NN(targ);
 	    LvTARGLEN(sv) = 0;
 	    SvREFCNT_dec(mg->mg_obj);
-	    mg->mg_obj = Nullsv;
+	    mg->mg_obj = NULL;
 	    mg->mg_flags &= ~MGf_REFCOUNTED;
 	}
     }
@@ -2026,7 +2014,7 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 {
     dVAR;
     MAGIC *mg;
-    SV *value = Nullsv;
+    SV *value = NULL;
 
     if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem)))
 	return;
@@ -2041,19 +2029,19 @@ Perl_vivify_defelem(pTHX_ SV *sv)
     else {
 	AV* const av = (AV*)LvTARG(sv);
 	if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
-	    LvTARG(sv) = Nullsv;	/* array can't be extended */
+	    LvTARG(sv) = NULL;	/* array can't be extended */
 	else {
 	    SV** const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
 	    if (!svp || (value = *svp) == &PL_sv_undef)
 		Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
 	}
     }
-    (void)SvREFCNT_inc(value);
+    SvREFCNT_inc_simple_void(value);
     SvREFCNT_dec(LvTARG(sv));
     LvTARG(sv) = value;
     LvTARGLEN(sv) = 0;
     SvREFCNT_dec(mg->mg_obj);
-    mg->mg_obj = Nullsv;
+    mg->mg_obj = NULL;
     mg->mg_flags &= ~MGf_REFCOUNTED;
 }
 
@@ -2066,6 +2054,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_CONTEXT;
     mg->mg_len = -1;
     SvSCREAM_off(sv);
     return 0;
@@ -2126,6 +2115,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
      * RenE<eacute> Descartes said "I think not."
      * and vanished with a faint plop.
      */
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     if (mg->mg_ptr) {
 	Safefree(mg->mg_ptr);
@@ -2140,6 +2130,7 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_UNUSED_ARG(sv);
     Safefree(mg->mg_ptr);	/* The mg_ptr holds the pos cache. */
     mg->mg_ptr = 0;
@@ -2199,7 +2190,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 		PL_encoding = newSVsv(sv);
 	    }
 	    else {
-		PL_encoding = Nullsv;
+		PL_encoding = NULL;
 	    }
 	}
 	break;
@@ -2211,12 +2202,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '\011':	/* ^I */ /* NOT \t in EBCDIC */
 	Safefree(PL_inplace);
-	PL_inplace = SvOK(sv) ? savesvpv(sv) : Nullch;
+	PL_inplace = SvOK(sv) ? savesvpv(sv) : NULL;
 	break;
     case '\017':	/* ^O */
 	if (*(mg->mg_ptr+1) == '\0') {
 	    Safefree(PL_osname);
-	    PL_osname = Nullch;
+	    PL_osname = NULL;
 	    if (SvOK(sv)) {
 		TAINT_PROPER("assigning to $^O");
 		PL_osname = savesvpv(sv);
@@ -2341,7 +2332,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_ors_sv = newSVsv(sv);
 	}
 	else {
-	    PL_ors_sv = Nullsv;
+	    PL_ors_sv = NULL;
 	}
 	break;
     case ',':
@@ -2351,7 +2342,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_ofs_sv = newSVsv(sv);
 	}
 	else {
-	    PL_ofs_sv = Nullsv;
+	    PL_ofs_sv = NULL;
 	}
 	break;
     case '[':
@@ -2597,6 +2588,7 @@ I32
 Perl_whichsig(pTHX_ const char *sig)
 {
     register char* const* sigv;
+    PERL_UNUSED_CONTEXT;
 
     for (sigv = (char* const*)PL_sig_name; *sigv; sigv++)
 	if (strEQ(sig,*sigv))
@@ -2625,10 +2617,10 @@ Perl_sighandler(int sig)
     dTHX;
 #endif
     dSP;
-    GV *gv = Nullgv;
-    SV *sv = Nullsv;
+    GV *gv = NULL;
+    SV *sv = NULL;
     SV * const tSv = PL_Sv;
-    CV *cv = Nullcv;
+    CV *cv = NULL;
     OP *myop = PL_op;
     U32 flags = 0;
     XPV * const tXpv = PL_Xpv;
@@ -2674,7 +2666,7 @@ Perl_sighandler(int sig)
     }
 
     if(PL_psig_name[sig]) {
-    	sv = SvREFCNT_inc(PL_psig_name[sig]);
+	sv = SvREFCNT_inc_NN(PL_psig_name[sig]);
 	flags |= 64;
 #if !defined(PERL_IMPLICIT_CONTEXT)
 	PL_sig_sv = sv;
@@ -2743,7 +2735,7 @@ Perl_sighandler(int sig)
 	(void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-	Perl_die(aTHX_ Nullch);
+	Perl_die(aTHX_ NULL);
     }
 cleanup:
     if (flags & 1)