X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=549d672a2a18cfd8217d0053a5dba8931466da9b;hb=5ad5b34cb2af84d4f37219a5dee752fca0459151;hp=74a9b2ecad107ad2a14614845ef0ae69adc33eb1;hpb=9d8f40c4d2ff3c9a7ded072d81df73638a8c1d83;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index 74a9b2e..549d672 100644
--- a/gv.c
+++ b/gv.c
@@ -1,7 +1,7 @@
 /*    gv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
- *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -103,11 +103,6 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
     }
 
     if (!GvIOp(gv)) {
-#ifdef GV_UNIQUE_CHECK
-        if (GvUNIQUE(gv)) {
-            Perl_croak(aTHX_ "Bad symbol for filehandle (GV is unique)");
-        }
-#endif
 	GvIOp(gv) = newIO();
     }
     return gv;
@@ -1237,10 +1232,22 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		if (strEQ(name2, "IG")) {
 		    HV *hv;
 		    I32 i;
-		    if (!PL_psig_ptr) {
-			Newxz(PL_psig_ptr,  SIG_SIZE, SV*);
-			Newxz(PL_psig_name, SIG_SIZE, SV*);
+		    if (!PL_psig_name) {
+			Newxz(PL_psig_name, 2 * SIG_SIZE, SV*);
 			Newxz(PL_psig_pend, SIG_SIZE, int);
+			PL_psig_ptr = PL_psig_name + SIG_SIZE;
+		    } else {
+			/* I think that the only way to get here is to re-use an
+			   embedded perl interpreter, where the previous
+			   use didn't clean up fully because
+			   PL_perl_destruct_level was 0. I'm not sure that we
+			   "support" that, in that I suspect in that scenario
+			   there are sufficient other garbage values left in the
+			   interpreter structure that something else will crash
+			   before we get here. I suspect that this is one of
+			   those "doctor, it hurts when I do this" bugs.  */
+			Zero(PL_psig_name, 2 * SIG_SIZE, SV*);
+			Zero(PL_psig_pend, SIG_SIZE, int);
 		    }
 		    GvMULTI_on(gv);
 		    hv = GvHVn(gv);
@@ -1249,9 +1256,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 			SV * const * const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
 			if (init)
 			    sv_setsv(*init, &PL_sv_undef);
-			PL_psig_ptr[i] = 0;
-			PL_psig_name[i] = 0;
-			PL_psig_pend[i] = 0;
 		    }
 		}
 		break;
@@ -1390,6 +1394,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	ro_magicalize:
 	    SvREADONLY_on(GvSVn(gv));
 	    /* FALL THROUGH */
+	case '0':
 	case '1':
 	case '2':
 	case '3':
@@ -1853,6 +1858,27 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 
   PERL_ARGS_ASSERT_AMAGIC_CALL;
 
+  if ( PL_curcop->cop_hints & HINT_NO_AMAGIC ) {
+      SV *lex_mask = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
+					      0, "overloading", 11, 0, 0);
+
+      if ( !lex_mask || !SvOK(lex_mask) )
+	  /* overloading lexically disabled */
+	  return NULL;
+      else if ( lex_mask && SvPOK(lex_mask) ) {
+	  /* we have an entry in the hints hash, check if method has been
+	   * masked by overloading.pm */
+	  STRLEN len;
+	  const int offset = method / 8;
+	  const int bit    = method % 8;
+	  char *pv = SvPV(lex_mask, len);
+
+	  /* Bit set, so this overloading operator is disabled */
+	  if ( (STRLEN)offset < len && pv[offset] & ( 1 << bit ) )
+	      return NULL;
+      }
+  }
+
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
       && (stash = SvSTASH(SvRV(left)))
       && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
@@ -1962,6 +1988,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	   break;
 	 case int_amg:
 	 case iter_amg:			/* XXXX Eventually should do to_gv. */
+	 case ftest_amg:		/* XXXX Eventually should do to_gv. */
 	     /* FAIL safe */
 	     return NULL;	/* Delegate operation to standard mechanisms. */
 	     break;