From 9b6f3a2799817e49df9aa5ce0e1223e07b2091a0 Mon Sep 17 00:00:00 2001 From: Ovid Date: Thu, 19 Oct 2006 01:47:48 -0700 Subject: [PATCH] base.pm Message-ID: <20061019154748.87433.qmail@web60824.mail.yahoo.com> p4raw-id: //depot/perl@29090 --- lib/base.pm | 12 +++++++++++- lib/base/t/base.t | 9 ++++++++- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/lib/base.pm b/lib/base.pm index 9c2135b..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.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 --- 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 } -- 2.7.4