Fix two minor bugs with local glob assignment

These are combined into one patch because it is hard to fix one with-
out fixing the other.

local *glob = $ref was ignoring the clobbered reference and not
accounting for when updating ISA caches, resulting in two bugs:

*Foo::ISA = *Bar::ISA;
@Foo::ISA = "Baz";
sub Baz::ook { "Baz" }
sub L::ook { "See" }
warn Bar->ook;         # Baz
local *Foo::ISA = ["L"];
warn Bar->ook;         # Baz
@Baz::ISA = @Baz::ISA; # should have no effect
warn Bar->ook;         # See

@Baz::ISA = "Foo::bar";
sub Foo::bar::ber { 'baz' }
sub UNIVERSAL::ber { "black sheep" }
warn Baz->ber;         # baz
local *Foo:: = \%Bar::;
warn Baz->ber;         # baz
@Baz::ISA = @Baz::ISA; # should have no effect
warn Baz->ber;         # black sheep

The dref variable in sv.c:S_glob_assign_ref holds the SV that needs to
be freed.  So during localisation it is NULL.

When I was fixing up isa and mro bugs in perl 5.14, I misunderstood
its purpose and thought it always contained the reference on the left.

Since we need to have access to what was assigned over after the
assignment, this commit changes dref always to hold the clobbered SV,
and makes the SvREFCNT_dec conditional.

diff --git a/sv.c b/sv.c
index d8d0ff8..a2d0cbc 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3741,7 +3741,7 @@ static void
 S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
 {
     SV * const sref = SvRV(sstr);
-    SV *dref = NULL;
+    SV *dref;
     const int intro = GvINTRO(dstr);
     SV **location;
     U8 import_flag = 0;
@@ -3789,8 +3789,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
            }
            SAVEGENERICSV(*location);
        }
-       else
-           dref = *location;
+       dref = *location;
        if (stype == SVt_PVCV && (*location != sref || GvCVGEN(dstr))) {
            CV* const cv = MUTABLE_CV(*location);
            if (cv) {
@@ -3907,7 +3906,7 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
         }
        break;
     }
-    SvREFCNT_dec(dref);
+    if (!intro) SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
        SvTAINT(dstr);
     return;

diff --git a/t/mro/isa_aliases.t b/t/mro/isa_aliases.t
index abdedce..2073e5e 100644 (file)
--- a/t/mro/isa_aliases.t
+++ b/t/mro/isa_aliases.t
@@ -2,7 +2,7 @@
 
 BEGIN { chdir 't'; @INC = '../lib'; require './test.pl' }
 
-plan 12;
+plan 13;
 
 @Foogh::ISA = "Bar";
 *Phoogh::ISA = *Foogh::ISA;
@@ -41,3 +41,11 @@ ok !Foo->isa("Bar"),
  '!isa when another stash has claimed the @ISA via ref-to-glob assignment';
 ok !Phoo->isa("Bar"),
  '!isa on the stash that claimed the @ISA via ref-to-glob assignment';
+
+*Fooo::ISA = *Baro::ISA;
+@Fooo::ISA = "Bazo";
+sub Bazo::ook { "Baz" }
+sub L::ook { "See" }
+Baro->ook;
+local *Fooo::ISA = ["L"];
+is 'Baro'->ook, 'See', 'localised *ISA=$ref assignment';

diff --git a/t/mro/package_aliases.t b/t/mro/package_aliases.t
index 3bc3c8f..34aa2d6 100644 (file)
--- a/t/mro/package_aliases.t
+++ b/t/mro/package_aliases.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 use warnings;
-plan(tests => 52);
+plan(tests => 53);
 
 {
     package New;
@@ -399,4 +399,12 @@ bless [], "O:";
   'isa(foo) when inheriting from "class:" after string-to-glob assignment';
 }
 
-
+@Bazo::ISA = "Fooo::bar";
+sub Fooo::bar::ber { 'baz' }
+sub UNIVERSAL::ber { "black sheep" }
+Bazo->ber;
+local *Fooo:: = \%Baro::;
+{
+    no warnings;
+    is 'Bazo'->ber, 'black sheep', 'localised *glob=$stashref assignment';
+}