From @nwc10

Torsten Schoenfeld mailed p5p in 48FB1B1B.40803@​gmx.de
http​://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-10/msg00471.html

it looks like current bleadperl breaks Glib's lazy-loading scheme.

I believe that this issue is the same as
http​://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2009-05/msg00532.html

At the time of writing Torsten Schoenfeld had not replied.

From p5p@spam.wizbit.be

The first test script​:

on perl-5.10.0​:

Foo
  Glib​::InitiallyUnowned
  Glib​::Object​::_LazyLoader
1 at test.pl line 9.
Foo
  Glib​::InitiallyUnowned
  Glib​::Object
1 at test.pl line 11.

on blead​:

Foo
  Glib​::InitiallyUnowned
  Glib​::Object​::_LazyLoader
Warning​: something's wrong at test.pl line 9.
Foo
  Glib​::InitiallyUnowned
  Glib​::Object
1 at test.pl line 11.

p5p@spam.wizbit.be - Status changed from 'new' to 'open'

From p5p@spam.wizbit.be

----Program----
#!/usr/bin/perl
use strict;
use warnings;
use Glib;

@​Foo​::ISA = qw(Glib​::InitiallyUnowned);

dump_hierarchy (Foo​::);
warn Foo->isa('Glib​::Object');
dump_hierarchy (Foo​::);
warn Foo->isa('Glib​::Object');

# force the lazy loader to setup the hierarchy
my $object = Glib​::InitiallyUnowned->new ();

sub dump_hierarchy {
  my ($package, $indent) = @​_;
  $indent ||= 0;

  print ' ' x $indent, $package, "\n";

  no strict 'refs';
  foreach my $parent (@​{$package . '​::ISA'}) {
  dump_hierarchy ($parent, $indent + 2);
  }
}

----Output of ...ppG3AmF/perl-5.10.0@​34353/bin/perl----
1 at /tmp/RT-66112/test.pl line 9.
1 at /tmp/RT-66112/test.pl line 11.
Foo
  Glib​::InitiallyUnowned
  Glib​::Object​::_LazyLoader
Foo
  Glib​::InitiallyUnowned
  Glib​::Object

----EOF ($?='0')----
----Output of ...poKG9rJ/perl-5.10.0@​34354/bin/perl----
Warning​: something's wrong at /tmp/RT-66112/test.pl line 9.
1 at /tmp/RT-66112/test.pl line 11.
Foo
  Glib​::InitiallyUnowned
  Glib​::Object​::_LazyLoader
Foo
  Glib​::InitiallyUnowned
  Glib​::Object

----EOF ($?='0')----

http​://perl5.git.perl.org/perl.git/commit/
a49ba3f
Create a direct lookup hash for ->isa() lookup, by retaining the
de-duping hash used by S_mro_get_linear_isa_dfs(). Provide a new
function Perl_get_isa_hash() to lazily retrieve this. (Which could
actually be static if S_isa_lookup() and Perl_sv_derived_from()
moved into mro.c.) Make S_isa_lookup() use this lookup hash in place
of a linear walk of the linear isa. This should turn isa lookups from
O(n) to O(1), which should make heavy users of ->isa() faster.
(eg PPI, and hence Perl Critic).

p4raw-id​: //depot/perl@​34354

From kaffeetisch@gmx.de

On 28.05.2009 17​:21, Nicholas Clark (via RT) wrote​:

# New Ticket Created by Nicholas Clark
# Please include the string​: [perl #66112]
# in the subject line of all future correspondence about this issue.
#<URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=66112>

Torsten Schoenfeld mailed p5p in 48FB1B1B.40803@​gmx.de
http​://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-10/msg00471.html

it looks like current bleadperl breaks Glib's lazy-loading scheme.

I believe that this issue is the same as
http​://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2009-05/msg00532.html

Yes, both issues are the same.

At the time of writing Torsten Schoenfeld had not replied.

For the record, here's what I wrote to the mailing list​:

Nicholas Clark wrote​:

Is PL_delaymagic 0? If not, which line of code set it non-zero?
If it is, does the call to mg_set() correctly end up in magic_setisa()?
And does that get a non-NULL stash, and hence call this code?

PL_delaymagic is 0 and magic_setisa() is called. It gets an apparently
valid stash and calls mro_isa_changed_in(). stashname in
mro_isa_changed_in() is "Glib​::InitiallyUnowned", so that seems correct.
  The mro_meta struct it then fetches comes out as

  {mro_linear_all = 0x0, mro_linear_current = 0xa4980bc,
  mro_nextmethod = 0x0, cache_gen = 3, pkg_gen = 3, mro_which = 0x8381ab8,
  isa = 0xa4980ec}.

The isarev loop then first finds "Bar" with mro_meta struct

  {mro_linear_all = 0x0, mro_linear_current = 0x92c317c,
  mro_nextmethod = 0x0, cache_gen = 4, pkg_gen = 4, mro_which = 0x8381ab8,
  isa = 0x92c319c},

and then "Foo" with

  {mro_linear_all = 0x0, mro_linear_current = 0x92c30bc,
  mro_nextmethod = 0x0, cache_gen = 4, pkg_gen = 4, mro_which = 0x8381ab8,
  isa = 0x92c30dc}.

The mro_get_linear_isa() loop at the end is not executed since items is 0.

From p5p@spam.wizbit.be

http​://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2009-07/
msg01098.html

From​: Nicholas Clark <nick@​ccl4.org>
Date​: Sat, 25 Jul 2009 17​:15​:53 +0100

I believe I've fixed the problem in blead with 1375cf1

diff --git a/mro.c b/mro.c
index fe77647..23f8c07 100644
--- a/mro.c
+++ b/mro.c
@@ -438,7 +438,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
     if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
 
     /* Iterate the isarev (classes that are our children),
-       wiping out their linearization and method caches */
+       wiping out their linearization, method and isa caches */
     if(isarev) {
         hv_iterinit(isarev);
         while((iter = hv_iternext(isarev))) {
@@ -463,6 +463,10 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash)
                 revmeta->cache_gen++;
             if(revmeta->mro_nextmethod)
                 hv_clear(revmeta->mro_nextmethod);
+	    if (revmeta->isa) {
+		SvREFCNT_dec(revmeta->isa);
+		revmeta->isa = NULL;
+	    }
         }
     }

Does this work for you?

Nicholas Clark

From p5p@spam.wizbit.be

Pure perl test case​:

#!/usr/bin/perl -l

package RT66112​::A;

package RT66112​::B;

sub isa {
  my $self = shift;
  @​ISA = qw/RT66112​::A/;
  return $self->SUPER​::isa(@​_);
}

use strict;
use warnings;

@​Foo​::ISA = qw(RT66112​::B);
warn Foo->isa('RT66112​::A');
print "-" x 50;
warn Foo->isa('RT66112​::A');
__END__

Warning​: something's wrong at test3.pl line 17.

1 at test3.pl line 19.

From p5p@perl.wizbit.be

Citeren Nicholas Clark <nick@​ccl4.org>​:

In perl.git, the branch blead has been updated

<http​://perl5.git.perl.org/perl.git/commitdiff/1375cf1cf2085f851bb176047d5e60248542f555?hp=8ad0ee873ef9de8fbabd98634b89c1b6aca1233a>

- Log -----------------------------------------------------------------
commit 1375cf1
Author​: Nicholas Clark <nick@​ccl4.org>
Date​: Sat Jul 25 17​:04​:29 2009 +0100

When resetting our children\, wipe out the isa cache too\.

\(Fix to change 34354\, which introduced a cached hash to make \->isa O\(1\)\)

M mro.c

Patch attached.

Without Nicholas change​:

ok 118 - modify @​ISA in isa (RT66112​::T1 isa RT66112​::C)
ok 119 - modify @​ISA in isa (RT66112​::T2 isa RT66112​::B)
not ok 120 - modify @​ISA in isa (RT66112​::T3 isa RT66112​::A)
ok 121 - modify @​ISA in isa (RT66112​::T4 isa RT66112​::E)
not ok 122 - modify @​ISA in isa (RT66112​::T5 not isa RT66112​::D)
not ok 123 - modify @​ISA in isa (RT66112​::T6 isa RT66112​::A)
# Failed at op/universal.t line 296
# Failed at op/universal.t line 304
# Failed at op/universal.t line 308
Failed 3/123 subtests

Test Summary Report

op/universal.t (Wstat​: 0 Tests​: 123 Failed​: 3)
  Failed tests​: 120, 122-123
Files=1, Tests=123, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.03
cusr 0.00 csys = 0.08 CPU)
Result​: FAIL
Failed 1/1 test programs. 3/123 subtests failed.

With Nicholas change​:

ok 118 - modify @​ISA in isa (RT66112​::T1 isa RT66112​::C)
ok 119 - modify @​ISA in isa (RT66112​::T2 isa RT66112​::B)
ok 120 - modify @​ISA in isa (RT66112​::T3 isa RT66112​::A)
ok 121 - modify @​ISA in isa (RT66112​::T4 isa RT66112​::E)
ok 122 - modify @​ISA in isa (RT66112​::T5 not isa RT66112​::D)
ok 123 - modify @​ISA in isa (RT66112​::T6 isa RT66112​::A)
ok
All tests successful.
Files=1, Tests=123, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.03
cusr 0.00 csys = 0.08 CPU)
Result​: PASS

Best regards,

Bram

From p5p@perl.wizbit.be

From 32ec6541495f6e8508bbce224833c45a364644be Mon Sep 17 00:00:00 2001
From: Bram <p5p@perl.wizbit.be>
Date: Sat, 25 Jul 2009 22:11:55 +0200
Subject: [PATCH] [perl #66112]: Tests for commit 1375cf1cf2085f851bb176047d5e60248542f555

---
 t/op/universal.t |   56 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 files changed, 55 insertions(+), 1 deletions(-)

diff --git a/t/op/universal.t b/t/op/universal.t
index a1ff975..a24d7aa 100644
--- a/t/op/universal.t
+++ b/t/op/universal.t
@@ -10,7 +10,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan tests => 117;
+plan tests => 123;
 
 $a = {};
 bless $a, "Bob";
@@ -253,3 +253,57 @@ use warnings "deprecated";
     like($m, qr/^UNIVERSAL->import is deprecated/,
 	"deprecation warning for UNIVERSAL->import");
 }
+
+# Test: [perl #66112]: change @ISA inside  sub isa
+{
+    package RT66112::A;
+
+    package RT66112::B;
+
+    sub isa {
+	my $self = shift;
+	@ISA = qw/RT66112::A/;
+	return $self->SUPER::isa(@_);
+    }
+
+    package RT66112::C;
+
+    package RT66112::D;
+
+    sub isa {
+	my $self = shift;
+	@RT66112::E::ISA = qw/RT66112::A/;
+	return $self->SUPER::isa(@_);
+    }
+
+    package RT66112::E;
+
+    package main;
+
+    @RT66112::B::ISA = qw//;
+    @RT66112::C::ISA = qw/RT66112::B/;
+    @RT66112::T1::ISA = qw/RT66112::C/;
+    ok(RT66112::T1->isa('RT66112::C'), "modify \@ISA in isa (RT66112::T1 isa RT66112::C)");
+
+    @RT66112::B::ISA = qw//;
+    @RT66112::C::ISA = qw/RT66112::B/;
+    @RT66112::T2::ISA = qw/RT66112::C/;
+    ok(RT66112::T2->isa('RT66112::B'), "modify \@ISA in isa (RT66112::T2 isa RT66112::B)");
+
+    @RT66112::B::ISA = qw//;
+    @RT66112::C::ISA = qw/RT66112::B/;
+    @RT66112::T3::ISA = qw/RT66112::C/;
+    ok(RT66112::T3->isa('RT66112::A'), "modify \@ISA in isa (RT66112::T3 isa RT66112::A)");
+
+    @RT66112::E::ISA = qw/RT66112::D/;
+    @RT66112::T4::ISA = qw/RT66112::E/;
+    ok(RT66112::T4->isa('RT66112::E'), "modify \@ISA in isa (RT66112::T4 isa RT66112::E)");
+
+    @RT66112::E::ISA = qw/RT66112::D/;
+    @RT66112::T5::ISA = qw/RT66112::E/;
+    ok(! RT66112::T5->isa('RT66112::D'), "modify \@ISA in isa (RT66112::T5 not isa RT66112::D)");
+
+    @RT66112::E::ISA = qw/RT66112::D/;
+    @RT66112::T6::ISA = qw/RT66112::E/;
+    ok(RT66112::T6->isa('RT66112::A'), "modify \@ISA in isa (RT66112::T6 isa RT66112::A)");
+}
-- 
1.6.3.2

From @nwc10

On Sat, Jul 25, 2009 at 10​:27​:44PM +0200, Bram wrote​:

Citeren Nicholas Clark <nick@​ccl4.org>​:

In perl.git, the branch blead has been updated

<http​://perl5.git.perl.org/perl.git/commitdiff/1375cf1cf2085f851bb176047d5e60248542f555?hp=8ad0ee873ef9de8fbabd98634b89c1b6aca1233a>

- Log -----------------------------------------------------------------
commit 1375cf1
Author​: Nicholas Clark <nick@​ccl4.org>
Date​: Sat Jul 25 17​:04​:29 2009 +0100

When resetting our children, wipe out the isa cache too.

(Fix to change 34354, which introduced a cached hash to make ->isa
O(1))

M mro.c

Patch attached.

Thanks applied (2788925)

Nicholas Clark

p5p@spam.wizbit.be - Status changed from 'open' to 'resolved'