From: Father Chrysostomos <sprout@cpan.org>
Date: Fri, 18 May 2012 16:56:15 +0000 (-0700)
Subject: gv.c: Check overload tables when overloading is used
X-Git-Tag: upstream/5.20.0~6821^2~24
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=0a2c84ab2027a9fdfab9e35378f8e7a35f5413b7;p=platform%2Fupstream%2Fperl.git

gv.c: Check overload tables when overloading is used

Instead of checking whether overload tables are up to date only during
bless, do this check whenever using overloading.

This allows changes to methods and @ISA that affect overloading to
come into effect immediately, instead of requiring a dummy ‘bless[]’
to reset things.  (This does not yet apply to @ISA changes that cause
non-overloaded classes to start inheriting overloading.)

This fixes a bug brought up in ticket #112708, though the original bug
still exists.

Some tests had to change, but those tests were checking to make sure
that caches could go stale and still be used, which made no sense.
---

diff --git a/gv.c b/gv.c
index 395cba5..00aaade 100644
--- a/gv.c
+++ b/gv.c
@@ -2626,7 +2626,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   }
 
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
-      && (stash = SvSTASH(SvRV(left)))
+      && (stash = SvSTASH(SvRV(left))) && Gv_AMG(stash)
       && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
@@ -2749,7 +2749,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	 }
 	 if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
-	       && (stash = SvSTASH(SvRV(right)))
+	       && (stash = SvSTASH(SvRV(right))) && Gv_AMG(stash)
 	       && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table))
 	       && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			  ? (amtp = (AMT*)mg->mg_ptr)->table
diff --git a/lib/overload.t b/lib/overload.t
index 045dc60..7ff1214 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -131,7 +131,7 @@ $b++;
 
 is(ref $b, "Oscalar");
 is($a, "087");
-is($b, "88");
+is($b, "89");
 is(ref $a, "Oscalar");
 
 package Oscalar;
@@ -142,7 +142,7 @@ $b++;
 
 is(ref $b, "Oscalar");
 is($a, "087");
-is($b, "90");
+is($b, "91");
 is(ref $a, "Oscalar");
 
 $b=$a;
@@ -267,11 +267,12 @@ is("$aI", "xx");
 is($aI, "xx");
 is("b${aI}c", "_._.b.__.xx._.__.c._");
 
-# Here we test blessing to a package updates hash
+# Here we test that both "no overloading" and
+# blessing to a package update hash
 
 eval "package Oscalar; no overload '.'";
 
-is("b${a}", "_.b.__.xx._");
+is("b${a}", "bxx");
 $x="1";
 bless \$x, Oscalar;
 is("b${a}c", "bxxc");
@@ -291,8 +292,8 @@ like($@, qr/no method found/);
 
 eval "package Oscalar; sub comple; use overload '~' => 'comple'";
 
-$na = eval { ~$a };		# Hash was not updated
-like($@, qr/no method found/);
+$na = eval { ~$a };
+is($@, '');
 
 bless \$x, Oscalar;
 
@@ -303,8 +304,8 @@ is($na, '_!_xx_!_');
 
 $na = 0;
 
-$na = eval { ~$aI };		# Hash was not updated
-like($@, qr/no method found/);
+$na = eval { ~$aI };
+like($@, '');
 
 bless \$x, OscalarI;
 
@@ -316,8 +317,8 @@ is($na, '_!_xx_!_');
 
 eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
 
-$na = eval { $aI >> 1 };	# Hash was not updated
-like($@, qr/no method found/);
+$na = eval { $aI >> 1 };
+is($@, '');
 
 bless \$x, OscalarI;
 
@@ -2213,7 +2214,6 @@ sub thirteentative::abs { 'thirteen' }
     undef $TODO;
     is cos $o, 'eleven',
       'ovrld applies to previously-blessed obj after other obj is blessed';
-    $TODO = '[perl #112708]';
     $o = bless [], 'eleventative';
     *eleventative::cos = sub { 'ten' };
     is cos $o, 'ten', 'method changes affect overloading';