'overloading' pragma

1 files changed, 20 insertions, 0 deletions

diff --git a/gv.c b/gv.c
index 74a9b2ecad..d64965d509 100644
--- a/gv.c
+++ b/gv.c
@@ -1853,6 +1853,26 @@ 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 */
+	  const int offset = method / 8;
+	  const int bit    = method % 7;
+	  STRLEN len;
+	  char *pv = SvPV(lex_mask, len);
+
+	  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))