From laurent.dami@free.fr

This is a bug report for perl from dami@​cpan.org,
generated with the help of perlbug 1.36 running under perl 5.10.0.

When creating a subclass dynamically, and when adding
AUTOLOAD dynamically into the parent class, then that
AUTOLOAD is not seen in the method cache, even after
a call to "mro​::method_changed_in('Parent')".

It only appears in the method cache after a call
to mro​::invalidate_all_method_caches().

The attached test file demonstrates the problem.

This was detected while trying to solve bug 40159 in DBIx​::DataModel.

Flags​:
  category=library
  severity=medium

Site configuration information for perl 5.10.0​:

Configured by SYSTEM at Tue May 13 16​:52​:25 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration​:
  Platform​:
  osname=MSWin32, osvers=5.00, archname=MSWin32-x86-multi-thread
  uname=''
  config_args='undef'
  hint=recommended, useposix=true, d_sigaction=undef
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=undef, use64bitall=undef, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-DNDEBUG -DWIN32 -D_CONSOLE -DNO_STRICT
-DHAVE_DES_FCRYPT -DUSE_SITECUSTOMIZE -DPRIVLIB_LAST_IN_INC
-DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO
-DPERL_MSVCRT_READFIX -DHASATTRIBUTE -fno-strict-aliasing -mms-bitfields',
  optimize='-O2',
  cppflags='-DWIN32'
  ccversion='', gccversion='3.4.2 (mingw-special)', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
  d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
  ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64',
lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='g++', ldflags ='-L"D​:\Perl\lib\CORE"'
  libpth=\lib
  libs=-lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32
-lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm
-lversion -lodbc32 -lodbccp32 -lmsvcrt
  perllibs=-lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr
-lwinmm -lversion -lodbc32 -lodbccp32 -lmsvcrt
  libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl510.lib
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags='-mdll -L"D​:\Perl\lib\CORE"'

Locally applied patches​:
  ACTIVEPERL_LOCAL_PATCHES_ENTRY
  33741 avoids segfaults invoking S_raise_signal() (on Linux)
  33763 Win32 process ids can have more than 16 bits
  32809 Load 'loadable object' with non-default file extension
  32728 64-bit fix for Time​::Local

@​INC for perl 5.10.0​:
  d​:/Perl/site/lib
  d​:/Perl/lib
  .

Environment for perl 5.10.0​:
  HOME=D​:\dami
  LANG=fr
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=C​:\Program Files\Fichiers
communs\GTK\2.0\bin;d​:\Perl\bin;C​:\WINDOWS\system32;C​:\WINDOWS;C​:\WINDOWS\System32\Wbem;C​:\WINDOWS\system32\nls;C​:\WINDOWS\system32\nls\FRANCAIS;c​:\Program
Files\Novell\ZENworks\;C​:\Program Files\ATI Technologies\ATI Control
Panel;C​:\Program
Files\Novell\ZENworks\;D​:\ProgFiles\MinGW\bin;D​:\ProgFiles\MSys\1.0\bin;C​:\BASISclient\cs\bin;C​:\BASISclient\www\bin;C​:\Program
Files\Novell\SecureLogin;D​:\ProgFiles\GTK\2.0\bin;d​:\ProgFiles\TortoiseSVN\bin;D​:\Progfiles\Subversion\bin;D​:\ProgFiles\Berkeley_DB_4.6.21\bin;D​:\ProgFiles\Berkeley_DB_4.6.21\bin\debug;Z​:.;
  PERL_BADLANG (unset)
  SHELL=D​:/ProgFiles/emacs-22.2/bin/cmdproxy.exe

From laurent.dami@free.fr

mro.pl

From @tonycoz

The following patch fixed the problem with the sample mro.pl.

The extra test in t/mro/basic.t fails without the change to sv.c

Tony

(also attached)

diff -ru ../current/perl-master/sv.c work3/sv.c
--- ../current/perl-master/sv.c	2008-10-31 09:32:11.000000000 +1100
+++ work3/sv.c	2008-10-31 23:53:47.000000000 +1100
@@ -3463,6 +3463,7 @@
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
+    I32 mro_changes = 0;
 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 
@@ -3489,6 +3490,8 @@
 	goto common;
     case SVt_PVAV:
 	location = (SV **) &GvAV(dstr);
+        if (strEQ(GvNAME((GV*)dstr), "ISA"))
+	    mro_changes = 2;
 	import_flag = GVf_IMPORTED_AV;
 	goto common;
     case SVt_PVIO:
@@ -3566,6 +3569,7 @@
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
 	SvTAINT(dstr);
+    if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
     return;
 }
 
diff -ru ../current/perl-master/t/mro/basic.t work3/t/mro/basic.t
--- ../current/perl-master/t/mro/basic.t	2008-09-20 07:04:20.000000000 +1000
+++ work3/t/mro/basic.t	2008-10-31 23:53:08.000000000 +1100
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 40);
+require q(./test.pl); plan(tests => 42);
 
 {
     package MRO_A;
@@ -231,3 +231,17 @@
     is($stk_obj->foo(3), 6);
 }
 
+{ 
+  {
+    # assigning @ISA via arrayref to globref RT 60220
+    package P1;
+    sub new { bless {}, shift }
+    
+    package P2;
+  }
+  *{P2::ISA} = [ 'P1' ];
+  my $foo = P2->new;
+  ok(!eval { $foo->bark }, "no bark method");
+  *{P1::bark} = sub { "[bark]" };
+  is(scalar eval { $foo->bark }, "[bark]", "can bark now");
+}

# laurent.dami AT justice.ge.ch, Oct 2008
# testing Perl5.9.5 method cache, mro​::method_changed_in(..)
# doesn't seem to work when dynamic subclasses + dynamic Autoload

#----------------------------------------------------------------------
package Parent;
#----------------------------------------------------------------------
sub new {
my ($class, $name) = @​_;

my $self = {name => $name};
bless $self, $class;
}

sub name {
my ($self) = @​_;
return $self->{name};
}

sub hello {
my ($self) = @​_;
return "hello, I'm " . $self->name . " in class Parent";
}

#----------------------------------------------------------------------
package Child;
#----------------------------------------------------------------------
our @​ISA = qw/Parent/;

sub hello {
my ($self) = @​_;
return "hello, I'm " . $self->name . " in class Child";
}

#----------------------------------------------------------------------
package Child2;
#----------------------------------------------------------------------
our @​ISA = qw/Parent/;

sub hello {
my ($self) = @​_;
return "hello, I'm " . $self->name . " in class Child2";
}

#----------------------------------------------------------------------
package main;
#----------------------------------------------------------------------
use strict;
use warnings;

use Test​::More tests => 11;

# dynamically create a subclass
*{GrandChild​::ISA} = [qw/Child Child2/];

# instanciate
my $child = Child->new('child');
my $grandchild = GrandChild->new('grandchild');
my ($result, $expected);

isa_ok($grandchild, 'Child');
isa_ok($grandchild, 'Parent');
can_ok($grandchild, qw/name hello/);

# dynamically add a new method in Parent class
*{Parent​::shout} = sub {
my ($self) = @​_;
return "HELLO, I'M " . $self->name . " IN CLASS PARENT";
};

# is the new method seen ?
can_ok($grandchild, qw/shout/);
$result = eval {$grandchild->shout};
is($result, "HELLO, I'M grandchild IN CLASS PARENT", "shout method");

# dynamically add autoload
*{Parent​::AUTOLOAD} = sub {
my $self = shift;
my $class = ref($self) || $self;
my $method = our $AUTOLOAD;
$method =~ s/^.*​:://;
return if $method eq 'DESTROY'; # won't overload that one!

return "\[$method\] for " \. $self\->name \. " in class Parent";

};

# is AUTOLOAD seen ?
$result = eval {$grandchild->bark};
$expected = "[bark] for grandchild in class Parent",
is($result, $expected, $expected);

$result = eval {$child->bark};
$expected = "[bark] for child in class Parent",
is($result, $expected, $expected);

# is it seen after a "methods_changed_in" ?
mro​::method_changed_in('Parent');
diag("mro​::method_changed_in('Parent')");

$result = eval {$grandchild->bark};
$expected = "[bark] for grandchild in class Parent",
is($result, $expected, $expected);

$result = eval {$child->bark};
$expected = "[bark] for child in class Parent",
is($result, $expected, $expected);

# is it seen after a "invalidate_all_method_caches" ?
mro​::invalidate_all_method_caches();
diag("mro​::invalidate_all_method_caches()");

$result = eval {$grandchild->bark};
$expected = "[bark] for grandchild in class Parent",
is($result, $expected, $expected);

$result = eval {$child->bark};
$expected = "[bark] for child in class Parent",
is($result, $expected, $expected);

From @tonycoz

diff -ru ../current/perl-master/sv.c work3/sv.c
--- ../current/perl-master/sv.c	2008-10-31 09:32:11.000000000 +1100
+++ work3/sv.c	2008-10-31 23:53:47.000000000 +1100
@@ -3463,6 +3463,7 @@
     SV **location;
     U8 import_flag = 0;
     const U32 stype = SvTYPE(sref);
+    I32 mro_changes = 0;
 
     PERL_ARGS_ASSERT_GLOB_ASSIGN_REF;
 
@@ -3489,6 +3490,8 @@
 	goto common;
     case SVt_PVAV:
 	location = (SV **) &GvAV(dstr);
+        if (strEQ(GvNAME((GV*)dstr), "ISA"))
+	    mro_changes = 2;
 	import_flag = GVf_IMPORTED_AV;
 	goto common;
     case SVt_PVIO:
@@ -3566,6 +3569,7 @@
     SvREFCNT_dec(dref);
     if (SvTAINTED(sstr))
 	SvTAINT(dstr);
+    if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
     return;
 }
 
diff -ru ../current/perl-master/t/mro/basic.t work3/t/mro/basic.t
--- ../current/perl-master/t/mro/basic.t	2008-09-20 07:04:20.000000000 +1000
+++ work3/t/mro/basic.t	2008-10-31 23:53:08.000000000 +1100
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 40);
+require q(./test.pl); plan(tests => 42);
 
 {
     package MRO_A;
@@ -231,3 +231,17 @@
     is($stk_obj->foo(3), 6);
 }
 
+{ 
+  {
+    # assigning @ISA via arrayref to globref RT 60220
+    package P1;
+    sub new { bless {}, shift }
+    
+    package P2;
+  }
+  *{P2::ISA} = [ 'P1' ];
+  my $foo = P2->new;
+  ok(!eval { $foo->bark }, "no bark method");
+  *{P1::bark} = sub { "[bark]" };
+  is(scalar eval { $foo->bark }, "[bark]", "can bark now");
+}

The RT System itself - Status changed from 'new' to 'open'

From @nwc10

On Sat, Nov 01, 2008 at 12​:20​:21AM +1100, Tony Cook wrote​:

The following patch fixed the problem with the sample mro.pl.

The extra test in t/mro/basic.t fails without the change to sv.c

Thanks for this.

Without looking fully at it yet (something I don't currently have time for,
sorry) a bikeshed question​:

+ I32 mro_changes = 0;

+ if (strEQ(GvNAME((GV*)dstr), "ISA"))
+ mro_changes = 2;

+ if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
return;
}

Why the value 2, for a new variable that is effectively only used for
true/false?

Nicholas Clark

From @tonycoz

On Fri, Oct 31, 2008 at 01​:25​:23PM +0000, Nicholas Clark wrote​:

On Sat, Nov 01, 2008 at 12​:20​:21AM +1100, Tony Cook wrote​:

The following patch fixed the problem with the sample mro.pl.

The extra test in t/mro/basic.t fails without the change to sv.c

Thanks for this.

Without looking fully at it yet (something I don't currently have time for,
sorry) a bikeshed question​:

+ I32 mro_changes = 0;

+ if (strEQ(GvNAME((GV*)dstr), "ISA"))
+ mro_changes = 2;

+ if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
return;
}

Why the value 2, for a new variable that is effectively only used for
true/false?

I was following the similar logic in S_glob_assign_glob and
considering whether similar code was needed here.

I'm not all that attached to the value 2, using it as a boolean would
work just as well.

I just tried the test script from 60232 and that runs successfully
with the patch.

Tony

From laurent.dami@free.fr

When creating a subclass dynamically, and when adding
AUTOLOAD dynamically into the parent class, then that
AUTOLOAD is not seen in the method cache, even after
a call to "mro​::method_changed_in('Parent')".

After a more careful read of perldelta, I just found out
that the problem is solved if the dynamic subclass
is created through

  @​{$my_subclass."​::ISA"} = @​$parents_aref;

instead of

  *{$my_subclass."​::ISA} = $parents_aref;

In other words, updating @​ISA magically refreshes the method
cache, while updating the glob does not.

From [Unknown Contact. See original ticket]

When creating a subclass dynamically, and when adding
AUTOLOAD dynamically into the parent class, then that
AUTOLOAD is not seen in the method cache, even after
a call to "mro​::method_changed_in('Parent')".

After a more careful read of perldelta, I just found out
that the problem is solved if the dynamic subclass
is created through

  @​{$my_subclass."​::ISA"} = @​$parents_aref;

instead of

  *{$my_subclass."​::ISA} = $parents_aref;

In other words, updating @​ISA magically refreshes the method
cache, while updating the glob does not.

From @tonycoz

On Sat, Nov 01, 2008 at 01​:17​:26AM -0700, laurent dami via RT wrote​:

In other words, updating @​ISA magically refreshes the method
cache, while updating the glob does not.

That matches the patch I produced - I added a check to
S_glob_assign_ref for assignment of an array ref to @​{Foo​::ISA}.

Tony

From @nwc10

Dave notes​:

not clear whether this is a regression or not. There's also an offered
patch which hasn't been applied

From @craigberry

On Fri, Oct 31, 2008 at 8​:37 AM, Tony Cook<tony@​develop-help.com> wrote​:

On Fri, Oct 31, 2008 at 01​:25​:23PM +0000, Nicholas Clark wrote​:

On Sat, Nov 01, 2008 at 12​:20​:21AM +1100, Tony Cook wrote​:

The following patch fixed the problem with the sample mro.pl.

The extra test in t/mro/basic.t fails without the change to sv.c

Thanks for this.

Without looking fully at it yet (something I don't currently have time for,
sorry) a bikeshed question​:

+    I32 mro_changes = 0;

+        if (strEQ(GvNAME((GV*)dstr), "ISA"))
+       mro_changes = 2;

+    if(mro_changes == 2) mro_isa_changed_in(GvSTASH(dstr));
     return;
 }

Why the value 2, for a new variable that is effectively only used for
true/false?

I was following the similar logic in S_glob_assign_glob and
considering whether similar code was needed here.

I'm not all that attached to the value 2, using it as a boolean would
work just as well.

I just tried the test script from 60232 and that runs successfully
with the patch.

This is now (at long last) in blead at​:

http​://perl5.git.perl.org/perl.git/commitdiff/26d68d8

I see no new test failures in the core test suite with default builds
on recent versions of Mac OS X or VMS, but folks who do evil things
with mro method caches might want to check their back closets for
appropriate torture tests. And of course follow the smoke reports at​:

http​://www.nntp.perl.org/group/perl.daily-build.reports/

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