X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=65419bdfefcc118824f74b832adb8516db63bbec;hb=cbfd0a879b2bf2ade4a309e6d56c08ba19f320e1;hp=598eb9efdcafeddc77791a31af7b72cd5e2f0d4f;hpb=c8aa86e11144b22a034d68da930a681a5a5fb4f5;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/gv.c b/gv.c
index 598eb9e..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.
@@ -1853,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))
@@ -2210,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
@@ -2243,13 +2245,15 @@ pointers returned by SvPV.
 
 =cut
 */
+
 bool
-S_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;