base.pm

Message-ID: <20061019154748.87433.qmail@web60824.mail.yahoo.com>

p4raw-id: //depot/perl@29090

diff --git a/lib/base.pm b/lib/base.pm
index 9c2135b..d8baa95 100644 (file)
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -2,7 +2,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.07';
+$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)) {
@@ -212,6 +216,12 @@ found in your path.
 
 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
 

diff --git a/lib/base/t/base.t b/lib/base/t/base.t
index 0ddd238..d0e94f8 100644 (file)
--- a/lib/base/t/base.t
+++ b/lib/base/t/base.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 10;
+use Test::More tests => 11;
 
 use_ok('base');
 
@@ -55,6 +55,13 @@ like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
 eval q{use base 'reallyReAlLyNotexists'};
 like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
                                           '  still empty on 2nd load');
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = shift };
+    eval q{package HomoGenous; use base 'HomoGenous';};
+    like($warning, qr/^Class 'HomoGenous' tried to inherit from itself/,
+                                          '  self-inheriting');
+}
 
 BEGIN { $Has::Version_0::VERSION = 0 }