X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fbase.pm;h=d8baa95d0a1063f4ca5ea69d44da78030ce1c5fe;hb=99ffb1cb9ad68572b442d79446caa8bcbb2964fc;hp=b735848f9bccbe2cb89ce6de11de8422211beb0f;hpb=8731c5d9eb453a5b2d087dabd7a5f51b576b8048;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/base.pm b/lib/base.pm index b735848..d8baa95 100644 --- a/lib/base.pm +++ b/lib/base.pm @@ -2,7 +2,7 @@ package base; use strict 'vars'; use vars qw($VERSION); -$VERSION = '2.04'; +$VERSION = '2.08'; # constant.pm is slow sub SUCCESS () { 1 } @@ -71,6 +71,10 @@ sub import { my $inheritor = caller(0); foreach my $base (@_) { + if ( $inheritor eq $base ) { + warn "Class '$inheritor' tried to inherit from itself\n"; + } + next if $inheritor->isa($base); if (has_version($base)) { @@ -78,7 +82,7 @@ sub import { unless defined ${$base.'::VERSION'}; } else { - local $SIG{__DIE__} = 'IGNORE'; + local $SIG{__DIE__}; eval "require $base"; # Only ignore "Can't locate" errors from our eval require. # Other fatal errors (syntax etc) must be reported. @@ -97,7 +101,7 @@ ERROR push @{"$inheritor\::ISA"}, $base; if ( has_fields($base) || has_attr($base) ) { - # No multiple fields inheritence *suck* + # No multiple fields inheritance *suck* if ($fields_base) { require Carp; Carp::croak("Can't multiply inherit %FIELDS"); @@ -152,10 +156,9 @@ sub inherit_fields { } } - unless( keys %$bfields ) { - foreach my $idx (1..$#{$battr}) { - $dattr->[$idx] = $battr->[$idx] & INHERITED; - } + foreach my $idx (1..$#{$battr}) { + next if defined $dattr->[$idx]; + $dattr->[$idx] = $battr->[$idx] & INHERITED; } } @@ -193,15 +196,32 @@ it, will define $VERSION in the base package, setting it to the string C<-1, set by base.pm>. Will also initialize the fields if one of the base classes has it. -Multiple inheritence of fields is B supported, if two or more +Multiple inheritance of fields is B supported, if two or more base classes each have inheritable fields the 'base' pragma will croak. See L, L and L for a description of this feature. +=head1 DIAGNOSTICS + +=over 4 + +=item Base class package "%s" is empty. + +base.pm was unable to require the base package, because it was not +found in your path. + +=back + =head1 HISTORY This module was introduced with Perl 5.004_04. +Attempting to inherit from yourself generates a warning: + + use Foo; + use base 'Foo'; + + # Class 'Foo' tried to inherit from itself =head1 CAVEATS