X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=65419bdfefcc118824f74b832adb8516db63bbec;hb=0598b5ab3697b872539de6ed6dc1522b873602e1;hp=d1c2d112db77594ef4ad6c6f7e4a51aa87952ce8;hpb=65269a95bf2e18461f4efd8a5e0ad5bb7d043a5e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index d1c2d11..65419bd 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.
@@ -1213,17 +1213,16 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 		    if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
 			&& AvFILLp(av) == -1)
 			{
-			    const char *pname;
-			    av_push(av, newSVpvs(pname = "NDBM_File"));
-			    gv_stashpvn(pname, 9, GV_ADD);
-			    av_push(av, newSVpvs(pname = "DB_File"));
-			    gv_stashpvn(pname, 7, GV_ADD);
-			    av_push(av, newSVpvs(pname = "GDBM_File"));
-			    gv_stashpvn(pname, 9, GV_ADD);
-			    av_push(av, newSVpvs(pname = "SDBM_File"));
-			    gv_stashpvn(pname, 9, GV_ADD);
-			    av_push(av, newSVpvs(pname = "ODBM_File"));
-			    gv_stashpvn(pname, 9, GV_ADD);
+			    av_push(av, newSVpvs("NDBM_File"));
+			    gv_stashpvs("NDBM_File", GV_ADD);
+			    av_push(av, newSVpvs("DB_File"));
+			    gv_stashpvs("DB_File", GV_ADD);
+			    av_push(av, newSVpvs("GDBM_File"));
+			    gv_stashpvs("GDBM_File", GV_ADD);
+			    av_push(av, newSVpvs("SDBM_File"));
+			    gv_stashpvs("SDBM_File", GV_ADD);
+			    av_push(av, newSVpvs("ODBM_File"));
+			    gv_stashpvs("ODBM_File", GV_ADD);
 			}
 		}
 		break;
@@ -1410,7 +1409,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
 	case ')':
 	case '<':
 	case '>':
-	case ',':
 	case '\\':
 	case '/':
 	case '\001':	/* $^A */
@@ -1855,6 +1853,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))
@@ -2158,7 +2177,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     PUSHs(MUTABLE_SV(cv));
     PUTBACK;
 
-    if ((PL_op = Perl_pp_entersub(aTHX)))
+    if ((PL_op = PL_ppaddr[OP_ENTERSUB](aTHX)))
       CALLRUNOPS(aTHX);
     LEAVE;
     SPAGAIN;
@@ -2212,25 +2231,6 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 /*
 =for apidoc is_gv_magical_sv
 
-Returns C<TRUE> if given the name of a magical GV. Calls is_gv_magical.
-
-=cut
-*/
-
-bool
-Perl_is_gv_magical_sv(pTHX_ SV *name, U32 flags)
-{
-    STRLEN len;
-    const char * const temp = SvPV_const(name, len);
-
-    PERL_ARGS_ASSERT_IS_GV_MAGICAL_SV;
-
-    return is_gv_magical(temp, len, flags);
-}
-
-/*
-=for apidoc is_gv_magical
-
 Returns C<TRUE> if given the name of a magical GV.
 
 Currently only useful internally when determining if a GV should be
@@ -2245,13 +2245,15 @@ pointers returned by SvPV.
 
 =cut
 */
+
 bool
-Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
+Perl_is_gv_magical_sv(pTHX_ SV *const name_sv, U32 flags)
 {
-    PERL_UNUSED_CONTEXT;
-    PERL_UNUSED_ARG(flags);
+    STRLEN len;
+    const char *const name = SvPV_const(name_sv, len);
 
-    PERL_ARGS_ASSERT_IS_GV_MAGICAL;
+    PERL_UNUSED_ARG(flags);
+    PERL_ARGS_ASSERT_IS_GV_MAGICAL_SV;
 
     if (len > 1) {
 	const char * const name1 = name + 1;
@@ -2329,7 +2331,6 @@ Perl_is_gv_magical(pTHX_ const char *name, STRLEN len, U32 flags)
 	case ')':
 	case '<':
 	case '>':
-	case ',':
 	case '\\':
 	case '/':
 	case '|':