->isa broken in 5.6.0

[p5pRT]

Migrated from rt.perl.org#2711 (status was 'resolved')

Searchable as RT2711$

[p5pRT]

From nick@ni-s.u-net.com

Created by nick@bactrian.ni-s.u-net.com

Tk's overly complex AUTOLOAD has this code in it​:

if (!defined(&$what) && $method =~ /^[A-Z]\w+$/ && ref($_[0]) && $_[0]->isa('Tk​::Widget'))
  {
  my $obj = $_[0];
  $what = "Tk​::Widget​::$method";
  carp "Assuming 'require Tk​::$method;'";
  require "Tk/$method.pm";
  }

With perl5.6.0 the $_[0]->isa('Tk​::Widget') is returning FALSE.
This is despite the fact that the AUTOLOAD has been inherited!

Printing :
  no strict 'refs';
  print join(',',@​{ref($_[0]).'​::ISA'}),"\n";

Gives​:
Tk​::Derived,Tk​::Widget

As I would expect.

The case in point is Tk​::Frame which starts thus​:

package Tk​::Frame;
require Tk​::Widget;
require Tk​::Derived;
use AutoLoader;
use strict qw(vars);
use Carp;

use base qw(Tk​::Derived Tk​::Widget);

Perl Info

Flags:
    category=core
    severity=critical

Site configuration information for perl v5.6.0:

Configured by nick at Fri Mar 24 10:05:51 GMT 2000.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.2.5, archname=i686-linux-multi
    uname='linux bactrian 2.2.5 #56 sat oct 9 20:14:35 bst 1999 i686 unknown '
    config_args='-der -O -Dcc=gcc -Doptimize=-O2 -g -Dusemymalloc=n -Dusemultiplicity=y -Dusevfork=false'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=define
    useperlio=undef d_sfio=undef uselargefiles=define
    use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
  Compiler:
    cc='gcc', optimize='-O2 -g', gccversion=egcs-2.91.66 19990314 (egcs-1.1.2 release)
    cppflags='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include'
    ccflags ='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    stdchar='char', d_stdstdio=define, usevfork=false
    intsize=4, longsize=4, ptrsize=4, doublesize=8
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
    alignbytes=4, usemymalloc=n, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:



@INC for perl v5.6.0:
    /usr/local/lib/perl5.006/i686-linux
    /usr/local/lib/perl5.006/share
    /usr/local/lib/perl5.006/site/i686-linux
    /usr/local/lib/perl5.006/site/share
    /usr/local/lib/perl5.006/site/share
    .


Environment for perl v5.6.0:
    HOME=/home/nick
    LANG=en_GB.ISO-8859-1
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/usr/local/bin:/usr/bin:/usr/X11R6/bin:/bin:/usr/openwin/bin:/usr/games/bin:/usr/games:/opt/gnome/bin:/opt/kde/bin:.
    PERL_BADLANG (unset)
    SHELL=/bin/bash

[p5pRT]

From [Unknown Contact. See original ticket]

Nick Ing-Simmons <nick@​ni-s.u-net.com> writes​:

This is a bug report for perl from nick@​bactrian.ni-s.u-net.com,
generated with the help of perlbug 1.28 running under perl v5.6.0.

-----------------------------------------------------------------

Here is a testcase​:

package Bar;

sub AUTOLOAD
{
print $AUTOLOAD,"\n";
die "Why" unless $_[0]->isa(__PACKAGE__);
}

sub new
{
my ($class,%args) = @​_;
return bless \%args,$class;
}

package Foo;

sub Thing { }

package FooBar;

use base qw(Foo Bar);

package main;

my $obj = FooBar​::->new;

$obj->Doit;

-----------------------------------------------------------------
---
Flags​:
category=core
severity=critical
---
Site configuration information for perl v5.6.0​:

Configured by nick at Fri Mar 24 10​:05​:51 GMT 2000.

Summary of my perl5 (revision 5.0 version 6 subversion 0) configuration​:
Platform​:
osname=linux, osvers=2.2.5, archname=i686-linux-multi
uname='linux bactrian 2.2.5 #56 sat oct 9 20​:14​:35 bst 1999 i686 unknown '
config_args='-der -O -Dcc=gcc -Doptimize=-O2 -g -Dusemymalloc=n -Dusemultiplicity=y -Dusevfork=false'
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=define
useperlio=undef d_sfio=undef uselargefiles=define
use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef
Compiler​:
cc='gcc', optimize='-O2 -g', gccversion=egcs-2.91.66 19990314 (egcs-1.1.2 release)
cppflags='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include'
ccflags ='-DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
stdchar='char', d_stdstdio=define, usevfork=false
intsize=4, longsize=4, ptrsize=4, doublesize=8
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
alignbytes=4, usemymalloc=n, prototype=define
Linker and Libraries​:
ld='gcc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib
libs=-lnsl -lndbm -lgdbm -ldbm -ldb -ldl -lm -lc -lposix -lcrypt
libc=, so=so, useshrplib=false, libperl=libperl.a
Dynamic Linking​:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches​:

---
@​INC for perl v5.6.0​:
/usr/local/lib/perl5.006/i686-linux
/usr/local/lib/perl5.006/share
/usr/local/lib/perl5.006/site/i686-linux
/usr/local/lib/perl5.006/site/share
/usr/local/lib/perl5.006/site/share
.

---
Environment for perl v5.6.0​:
HOME=/home/nick
LANG=en_GB.ISO-8859-1
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/home/nick/bin​:/usr/local/bin​:/usr/bin​:/usr/X11R6/bin​:/bin​:/usr/openwin/bin​:/usr/games/bin​:/usr/games​:/opt/gnome/bin​:/opt/kde/bin​:.
PERL_BADLANG (unset)
SHELL=/bin/bash
--
Nick Ing-Simmons

[p5pRT]

From @sciurius

Nick Ing-Simmons <nick@​ni-s.u-net.com> writes​:

With perl5.6.0 the $_[0]->isa('Tk​::Widget') is returning FALSE.
This is despite the fact that the AUTOLOAD has been inherited!

Could this be related to bug [ID 20000321.016] use base / our @​ISA
clash?

-- Johan

[p5pRT]

From [Unknown Contact. See original ticket]

Nick Ing-Simmons <nick@​ing-simmons.net> writes​:

Nick Ing-Simmons <nick@​ni-s.u-net.com> writes​:

This is a bug report for perl from nick@​bactrian.ni-s.u-net.com,
generated with the help of perlbug 1.28 running under perl v5.6.0.

-----------------------------------------------------------------

Here is a testcase​:

package Bar;

sub AUTOLOAD
{
print $AUTOLOAD,"\n";
die "Why" unless $_[0]->isa(__PACKAGE__);
}

sub new
{
my ($class,%args) = @​_;
return bless \%args,$class;
}

package Foo;

sub Thing { }

package FooBar;

use base qw(Foo Bar);

package main;

my $obj = FooBar​::->new;

$obj->Doit;

It is unreleated to AUTOLOAD.
It seems to be caused by new base.pm's use of :

  next if $pkg->isa($base);

Combined with S_isa_lookup()'s use of :​:ISA​::CACHE​::.
When you do a 'use base' it checks isa to see if it needs
to add it. It "ISAn't" so it goes ahead and adds it.
_***BUT***_ it has cached the fact that it "ISAn't"

Thus with 5.6.0 if you
  use base 'Xxx';
you ensure that ->isa('Xxx') returns FALSE!

The attached patch clears the cache whenever anything is
added. (I did consider only deleteing entry for what we just
added - but who knows what other packages it has brought to the
ISA tree.)

Role on 5.6.1 ;-)

--
Nick Ing-Simmons

[p5pRT]

From [Unknown Contact. See original ticket]

Inline Patch

--- lib/base.pm.ship	Sat Mar 25 15:51:06 2000
+++ lib/base.pm	Sat Mar 25 16:00:52 2000
@@ -45,7 +45,7 @@
 package base;
 
 use 5.005_64;
-our $VERSION = "1.01";
+our $VERSION = "1.02";
 
 sub import {
     my $class = shift;
@@ -55,6 +55,7 @@
     foreach my $base (@_) {
 	next if $pkg->isa($base);
 	push @{"$pkg\::ISA"}, $base;
+	delete ${"$pkg\::"}{'::ISA::CACHE::'};
 	unless (exists ${"$base\::"}{VERSION}) {
 	    eval "require $base";
 	    # Only ignore "Can't locate" errors from our eval require.

[p5pRT]

From @gsar

On Sat, 25 Mar 2000 16​:11​:04 GMT, Nick Ing-Simmons wrote​:

It seems to be caused by new base.pm's use of :

next if $pkg->isa($base);

Combined with S_isa_lookup()'s use of :​:ISA​::CACHE​::.
When you do a 'use base' it checks isa to see if it needs
to add it. It "ISAn't" so it goes ahead and adds it.
_***BUT***_ it has cached the fact that it "ISAn't"

It seems to me this caching is conceptually flawed. This fails to
print "ok\n" in both 5.6.0 and 5.005_03​:

  package Bar;
  package Foo;
  BEGIN { @​Foo​::ISA = 'Bar' unless Foo​::->isa('Bar'); }
  print "ok\n" if Foo​::->isa('Bar');

The basic problem here is that the cache can never be updated when
the ISA hierarchy changes.

The attached patch clears the cache whenever anything is
added. (I did consider only deleteing entry for what we just
added - but who knows what other packages it has brought to the
ISA tree.)

This won't work when @​ISA is manipulated directly as above. Worse,
it won't work in the following scenario​:

  package Baz; $Baz​::VERSION++;
  package Bar; $Baz​::VERSION++;
  package Foo;
  use base 'Bar';
  BEGIN { print Foo->isa('Baz') } # fails, and caches failure
  package Bar;
  use base 'Baz';
  print "ok\n" if Foo->isa('Baz');

I think the caching done by UNIVERSAL​::isa() should be fixed instead
(perhaps by piggybacking on CVGEN generation numbers).

Sarathy
gsar@​ActiveState.com

[p5pRT]

From @gsar

On Sat, 25 Mar 2000 08​:47​:53 PST, Gurusamy Sarathy wrote​:

package Bar; $Baz​::VERSION++;

Oops, must be​: $Bar​::VERSION++

Sarathy
gsar@​ActiveState.com

[p5pRT]

From [Unknown Contact. See original ticket]

Johan Vromans <JVromans@​squirrel.nl> writes​:

Nick Ing-Simmons <nick@​ni-s.u-net.com> writes​:

With perl5.6.0 the $_[0]->isa('Tk​::Widget') is returning FALSE.
This is despite the fact that the AUTOLOAD has been inherited!

Could this be related to bug [ID 20000321.016] use base / our @​ISA
clash?

Seems to be the same bug​:

use strict;
my $p = new Pkg;
print STDERR ("Yes\n") if $p->isa("Foo");

package Foo;
sub new { bless {}, 'Foo' }

package Pkg;
our @​ISA;
use base 'Foo';
sub new { bless {}, 'Pkg' };

Prints nothing with 5.6.0
But if I add a -Ilib to use patch I just sent I get​:

nick@​bactrian​:~/p5/perl-5.6.0 > ./perl -Ilib /tmp/bug2
Yes

As you expected.

Without the 'our' S_isa_lookup() exits without any caching activity.
With the 'our' it creates the cache and remembers it did not find
'Foo'.

None the less declaring @​ISA like that is un-useful.
I purged all the "use vars '@​ISA'" from Tk a while back.
Thus Tk only fails on multiple inheritance - the 1st item in
use base is fine - but subsequent entries get -ve cached.

The robust fix might be to make @​ISA's existing 'magic'
clear the cache, or have S_isa_lookup() tag its cache with PL_sub_generation.

--
Nick Ing-Simmons

[p5pRT]

From [Unknown Contact. See original ticket]

On Sat, 25 Mar 2000 08​:47​:53 PST, Gurusamy Sarathy wrote​:

package Bar; $Baz​::VERSION++;

Oops, must be​: $Bar​::VERSION++

That's one reason why I never use "Baz". In the sequence Foo/Bar/Glarch,
the last two items are clearly distinct from one another. It the
Foo/Bar/Baz sequence, they are not.

(Plus I "grew up" on Glarch as the third item, and only heard Baz
much, much later, by which time it seemed too foreign. :-)

But I think the "how far away is it" thing is enough.

--tom

[p5pRT]

From [Unknown Contact. See original ticket]

Gurusamy Sarathy <gsar@​ActiveState.com> writes​:

The attached patch clears the cache whenever anything is
added. (I did consider only deleteing entry for what we just
added - but who knows what other packages it has brought to the
ISA tree.)

This won't work when @​ISA is manipulated directly as above. Worse,
it won't work in the following scenario​:

package Baz; $Baz​::VERSION++;
package Bar; $Baz​::VERSION++;
package Foo;
use base 'Bar';
BEGIN { print Foo->isa('Baz') } # fails, and caches failure
package Bar;
use base 'Baz';
print "ok\n" if Foo->isa('Baz');

I think the caching done by UNIVERSAL​::isa() should be fixed instead
(perhaps by piggybacking on CVGEN generation numbers).

I agree 100% now I have investigated some more.
The only question which remains at the moment is whether mg.c's
Perl_magic_setisa() has enough info to find the cache and delete
it or whether to use (say) the scalar member of the cache glob
to hold the generation number.

--
Nick Ing-Simmons

[p5pRT]

From @gsar

On Sat, 25 Mar 2000 17​:14​:40 GMT, Nick Ing-Simmons wrote​:

I agree 100% now I have investigated some more.
The only question which remains at the moment is whether mg.c's
Perl_magic_setisa() has enough info to find the cache and delete
it

s/the cache and delete it/all the invalidated caches and delete them/. :-)

or whether to use (say) the scalar member of the cache glob
to hold the generation number.

This is probably easier. Finding the all the subclasses (in order to
invalidate their ISA cache) given only the superclass isn't exactly
trivial.

But if we add the infrastructure to do the latter, it would probably
help method lookups too.

Sarathy
gsar@​ActiveState.com

[p5pRT]

From [Unknown Contact. See original ticket]

Gurusamy Sarathy <gsar@​ActiveState.com> writes​:

It seems to me this caching is conceptually flawed. This fails to
print "ok\n" in both 5.6.0 and 5.005_03​:

package Bar;
package Foo;
BEGIN { @​Foo​::ISA = 'Bar' unless Foo​::->isa('Bar'); }
print "ok\n" if Foo​::->isa('Bar');

The basic problem here is that the cache can never be updated when
the ISA hierarchy changes.

I think the caching done by UNIVERSAL​::isa() should be fixed instead
(perhaps by piggybacking on CVGEN generation numbers).

Attached patch to universal.c stores PL_sub_generation in the scalar
member of the '​::ISA​::CACHE​::' glob. If that does not match cache is
cleared. Also included are some more tests for t/op/universal.t that
probe at least some of the failing cases.

--
Nick Ing-Simmons

[p5pRT]

From [Unknown Contact. See original ticket]

Inline Patch

--- universal.c.ship	Sat Mar 25 14:44:19 2000
+++ universal.c	Thu Mar 30 16:34:26 2000
@@ -14,6 +14,7 @@
     GV* gv;
     GV** gvp;
     HV* hv = Nullhv;
+    SV* subgen = Nullsv;
 
     if (!stash)
 	return &PL_sv_undef;
@@ -26,17 +27,26 @@
 
     gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, FALSE);
 
-    if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv))) {
-	SV* sv;
-	SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
-	if (svp && (sv = *svp) != (SV*)&PL_sv_undef)
-	    return sv;
+    if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (subgen = GvSV(gv)) && (hv = GvHV(gv))) {
+	if (SvIV(subgen) == PL_sub_generation) {
+	    SV* sv;
+	    SV** svp = (SV**)hv_fetch(hv, name, len, FALSE);
+	    if (svp && (sv = *svp) != (SV*)&PL_sv_undef) {
+	        DEBUG_o( Perl_deb(aTHX_ "Using cached ISA %s for package %s\n",name,HvNAME(stash)) );
+		return sv;
+	    }
+	}
+	else {
+	    DEBUG_o( Perl_deb(aTHX_ "ISA Cache in package %s is stale\n",HvNAME(stash)) );
+	    hv_clear(hv);
+	    sv_setiv(subgen, PL_sub_generation);
+	}
     }
 
     gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
-    
+
     if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
-	if(!hv) {
+	if(!hv || !subgen) {
 	    gvp = (GV**)hv_fetch(stash, "::ISA::CACHE::", 14, TRUE);
 
 	    gv = *gvp;
@@ -44,7 +54,12 @@
 	    if (SvTYPE(gv) != SVt_PVGV)
 		gv_init(gv, stash, "::ISA::CACHE::", 14, TRUE);
 
-	    hv = GvHVn(gv);
+	    if (!hv)
+		hv = GvHVn(gv);
+	    if (!subgen) {
+		subgen = newSViv(PL_sub_generation);
+		GvSV(gv) = subgen;
+	    }
 	}
 	if(hv) {
 	    SV** svp = AvARRAY(av);
@@ -88,10 +103,10 @@
 {
     char *type;
     HV *stash;
-  
+
     stash = Nullhv;
     type = Nullch;
- 
+
     if (SvGMAGICAL(sv))
         mg_get(sv) ;
 
@@ -104,7 +119,7 @@
     else {
         stash = gv_stashsv(sv, FALSE);
     }
- 
+
     return (type && strEQ(type,name)) ||
             (stash && isa_lookup(stash, name, strlen(name), 0) == &PL_sv_yes)
         ? TRUE
--- t/op/universal.t.ship	Thu Mar 30 15:33:02 2000
+++ t/op/universal.t	Thu Mar 30 16:35:21 2000
@@ -6,9 +6,10 @@
 BEGIN {
     chdir 't' if -d 't';
     unshift @INC, '../lib' if -d '../lib';
+    $| = 1;
 }
 
-print "1..73\n";
+print "1..80\n";
 
 $a = {};
 bless $a, "Bob";
@@ -28,6 +29,18 @@
 
 $Alice::VERSION = 2.718;
 
+{package Cedric;
+ our @ISA;
+ use base qw(Human);
+}
+
+{package Programmer;
+ our $VERSION = 1.667;
+
+ sub write_perl { 1 }
+}
+
+
 package main;
 
 my $i = 2;
@@ -45,12 +58,33 @@
 
 test ! $a->isa("Male");
 
+test ! $a->isa('Programmer');
+
 test $a->can("drink");
 
 test $a->can("eat");
 
 test ! $a->can("sleep");
 
+test (!Cedric->isa('Programmer'));
+
+test (Cedric->isa('Human'));
+
+push(@Cedric::ISA,'Programmer');
+
+test (Cedric->isa('Programmer'));
+
+{package Alice;
+ base::->import('Programmer');
+}
+
+test $a->isa('Programmer');
+test $a->isa("Female");
+
+@Cedric::ISA = qw(Bob);
+
+test (!Cedric->isa('Programmer'));
+
 my $b = 'abc';
 my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
 my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
@@ -88,7 +122,7 @@
 
 test $a->isa("UNIVERSAL");
 
-my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
+my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
 # XXX import being here is really a bug
 if ('a' lt 'A') {
     test $sub2 eq "can import isa VERSION";