Bug #28399 for base: base and Class::Autouse may lose fields

Plase find attached a patch (including a test) to fix the following problem: when using a complex class hierarchy (with base and fields) together with Class::Autouse to avoid unneccessary loading of class pm files, it can happen that a "Class::Autouse->autouse('Mybase')" happens _before_ the "use base qw(Mybase)" in a derived class; in this situation the derived class won't get the fields defined in the base class, which is the actual problem. I tried to code the fix as non-intrusive as possible, but anyway it introduces a kind of link between base and Class::Autouse - any better solution is of course welcome! Cheers, Marek

diff -ruN base-2.12/lib/base.pm base-2.12p1/lib/base.pm --- base-2.12/lib/base.pm 2007-07-06 17:45:46.000000000 +0200 +++ base-2.12p1/lib/base.pm 2007-07-20 10:57:26.154277000 +0200 @@ -85,10 +85,17 @@ my $sigdie; { local $SIG{__DIE__}; - eval "require $base"; + if(defined $Class::Autouse::VERSION) { + # we have Class::Autouse - and the base class might be + # autoused, so we would lose the base classes fields... + # ...so load it now to get the fields + eval { Class::Autouse->load($base); }; + } else { + eval "require $base"; + } # Only ignore "Can't locate" errors from our eval require. # Other fatal errors (syntax etc) must be reported. - die if $@ && $@ !~ /^Can't locate .*? at \(eval /; + die if $@ && $@ !~ /^Can't locate .*? at (\(eval |.*?\bbase\.pm\b)/; unless (%{"$base\::"}) { require Carp; Carp::croak(<<ERROR); diff -ruN base-2.12/MANIFEST base-2.12p1/MANIFEST --- base-2.12/MANIFEST 2007-07-06 18:06:49.000000000 +0200 +++ base-2.12p1/MANIFEST 2007-07-20 11:01:35.745761000 +0200 @@ -13,6 +13,10 @@ t/fields.t t/lib/Dummy.pm t/lib/HasSigDie.pm +t/lib/Mybad.pm +t/lib/Mybase.pm +t/lib/Myderived.pm t/sigdie.t t/version.t t/warnings.t +t/zClassAutouse.t diff -ruN base-2.12/t/lib/Mybad.pm base-2.12p1/t/lib/Mybad.pm --- base-2.12/t/lib/Mybad.pm 1970-01-01 01:00:00.000000000 +0100 +++ base-2.12p1/t/lib/Mybad.pm 2007-07-20 10:52:09.467724000 +0200 @@ -0,0 +1,12 @@ +package Mybad; + +# a bad base class +use base qw(WhatAStupidClassName); + +sub new +{ + return bless({}, __PACKAGE__); +} + +1; + diff -ruN base-2.12/t/lib/Mybase.pm base-2.12p1/t/lib/Mybase.pm --- base-2.12/t/lib/Mybase.pm 1970-01-01 01:00:00.000000000 +0100 +++ base-2.12p1/t/lib/Mybase.pm 2007-07-20 10:18:28.596283000 +0200 @@ -0,0 +1,19 @@ +package Mybase; + +our $_loaded = 1; +our $VERSION = '1.0'; + +use fields qw(one two); + +sub new +{ + my __PACKAGE__ $self = shift; + unless (ref $self) { + $self = fields::new($self); + } + $self->{one} = 1; + $self->{two} = 2; + return $self; +} + +1; diff -ruN base-2.12/t/lib/Myderived.pm base-2.12p1/t/lib/Myderived.pm --- base-2.12/t/lib/Myderived.pm 1970-01-01 01:00:00.000000000 +0100 +++ base-2.12p1/t/lib/Myderived.pm 2007-07-20 10:18:26.970915000 +0200 @@ -0,0 +1,22 @@ +package Myderived; + +our $_loaded = 1; +our $VERSION = '2.0'; + +use base qw(Mybase); +use fields qw(three four); + +sub new +{ + my __PACKAGE__ $self = shift; + unless (ref $self) { + $self = fields::new($self); + } + $self->SUPER::new(); + $self->{three} = 3; + $self->{four} = 4; + return $self; +} + +1; + diff -ruN base-2.12/t/zClassAutouse.t base-2.12p1/t/zClassAutouse.t --- base-2.12/t/zClassAutouse.t 1970-01-01 01:00:00.000000000 +0100 +++ base-2.12p1/t/zClassAutouse.t 2007-07-20 10:57:56.847548000 +0200 @@ -0,0 +1,44 @@ +#!/usr/bin/perl + +use Test::More; + +BEGIN +{ eval {require Class::Autouse}; + if($@) + { plan skip_all => "requires Class::Autouse."; + exit 0; + } + + plan tests => 13; +} + +use lib qw(t/lib); + +eval q{ Class::Autouse->autouse('Mybase'); }; +::is( $@, '', "Can autouse Mybase base class" ); + +::isnt( $Mybase::_loaded, 1, "Base class not yet loaded" ); + +eval q{ require Myderived; }; +::is( $@, '', "Can require Myderived derived class" ); +::is( $Myderived::VERSION, '2.0', "Derived class version correctly set" ); + +::is( $Mybase::_loaded, 1, "Base class got loaded" ); +# we must eval here, since the mere mentioning of $Mybase::VERSION +# will create the typeglob at load time, which confuses &base::has_version +::is( eval '$Mybase::VERSION', '1.0', "Base class version correctly set" ); + +my $d = Myderived->new(); +isa_ok($d, 'Myderived', "Object is a Myderived" ); +isa_ok($d, 'Mybase', "Object is a Mybase" ); + +::is( $d->{one}, 1, "base field one defined and correct value"); +::is( $d->{two}, 2, "base field two defined and correct value"); +::is( $d->{three}, 3, "derived field three defined and correct value"); +::is( $d->{four}, 4, "derived field four defined and correct value"); + +eval { require Mybad; }; +::like( $@, qr/Base class package "WhatAStupidClassName" is empty/, "Bad base class throws exception"); + +exit 0; +