lib/Package/Constants/t/01_list.t Package::Constants tests
lib/Params/Check.pm Params::Check
lib/Params/Check/t/01_Params-Check.t Params::Check tests
+lib/parent.pm Establish an ISA relationship with base classes at compile time
+lib/parent/t/compile-time-file.t tests for parent.pm
+lib/parent/t/compile-time.t tests for parent.pm
+lib/parent/t/lib/Dummy2.plugin test files for parent.pm
+lib/parent/t/lib/Dummy.pm test files for parent.pm
+lib/parent/t/lib/Dummy/Outside.pm test files for parent.pm
+lib/parent/t/lib/FileThatOnlyExistsAsPMC.pmc test files for parent.pm
+lib/parent/t/lib/ReturnsFalse.pm test files for parent.pm
+lib/parent/t/parent-classfromclassfile.t tests for parent.pm
+lib/parent/t/parent-classfromfile.t tests for parent.pm
+lib/parent/t/parent-pmc.t tests for parent.pm
+lib/parent/t/parent-returns-false.t tests for parent.pm
+lib/parent/t/parent.t tests for parent.pm
lib/perl5db.pl Perl debugging routines
lib/perl5db.t Tests for the Perl debugger
lib/perl5db/t/eval-line-bug Tests for the Perl debugger
'arandal' => 'Allison Randal <allison@perl.org>',
'audreyt' => 'Audrey Tang <cpan@audreyt.org>',
'avar' => 'Ævar Arnfjörð Bjarmason <avar@cpan.org>',
+ 'corion' => 'Max Maischein <corion@corion.net>',
'craig' => 'Craig Berry <craigberry@mac.com>',
'dankogai' => 'Dan Kogai <dankogai@cpan.org>',
'dconway' => 'Damian Conway <dconway@cpan.org>',
'CPAN' => 1,
},
+ 'parent' =>
+ {
+ 'MAINTAINER' => 'corion',
+ 'FILES' => q[lib/parent lib/parent.pm],
+ 'CPAN' => 1,
+ },
+
'perlebcdic' =>
{
'MAINTAINER' => 'pvhp',
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '2.13';
+$VERSION = '2.14';
+$VERSION = eval $VERSION;
# constant.pm is slow
sub SUCCESS () { 1 }
=head1 DESCRIPTION
+Unless you are using the C<fields> pragma, consider this module discouraged
+in favor of the lighter-weight C<parent>.
+
Allows you to both load one or more modules, while setting up inheritance from
those modules at the same time. Roughly similar in effect to
--- /dev/null
+package parent;
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.221';
+
+sub import {
+ my $class = shift;
+
+ my $inheritor = caller(0);
+
+ if ( @_ and $_[0] eq '-norequire' ) {
+ shift @_;
+ } else {
+ for ( my @filename = @_ ) {
+ if ( $_ eq $inheritor ) {
+ warn "Class '$inheritor' tried to inherit from itself\n";
+ };
+
+ s{::|'}{/}g;
+ require "$_.pm"; # dies if the file is not found
+ }
+ }
+
+ {
+ no strict 'refs';
+ # This is more efficient than push for the new MRO
+ # at least until the new MRO is fixed
+ @{"$inheritor\::ISA"} = (@{"$inheritor\::ISA"} , @_);
+ };
+};
+
+"All your base are belong to us"
+
+__END__
+
+=head1 NAME
+
+parent - Establish an ISA relationship with base classes at compile time
+
+=head1 SYNOPSIS
+
+ package Baz;
+ use parent qw(Foo Bar);
+
+=head1 DESCRIPTION
+
+Allows you to both load one or more modules, while setting up inheritance from
+those modules at the same time. Mostly similar in effect to
+
+ package Baz;
+ BEGIN {
+ require Foo;
+ require Bar;
+ push @ISA, qw(Foo Bar);
+ }
+
+By default, every base class needs to live in a file of its own.
+If you want to have a subclass and its parent class in the same file, you
+can tell C<parent> not to load any modules by using the C<-norequire> switch:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ use parent -norequire, 'Foo', 'Bar';
+ # will not go looking for Foo.pm or Bar.pm
+
+This is equivalent to the following code:
+
+ package Foo;
+ sub exclaim { "I CAN HAS PERL" }
+
+ package DoesNotLoadFooBar;
+ push @DoesNotLoadFooBar::ISA, 'Foo';
+
+This is also helpful for the case where a package lives within
+a differently named file:
+
+ package MyHash;
+ use Tie::Hash;
+ use parent -norequire, 'Tie::StdHash';
+
+This is equivalent to the following code:
+
+ package MyHash;
+ require Tie::Hash;
+ push @ISA, 'Tie::StdHash';
+
+If you want to load a subclass from a file that C<require> would
+not consider an eligible filename (that is, it does not end in
+either C<.pm> or C<.pmc>), use the following code:
+
+ package MySecondPlugin;
+ require './plugins/custom.plugin'; # contains Plugin::Custom
+ use parent -norequire, 'Plugin::Custom';
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item Class 'Foo' tried to inherit from itself
+
+Attempting to inherit from yourself generates a warning.
+
+ use Foo;
+ use parent 'Foo';
+
+=back
+
+=head1 HISTORY
+
+This module was forked from L<base> to remove the cruft
+that had accumulated in it.
+
+=head1 CAVEATS
+
+=head1 SEE ALSO
+
+L<base>
+
+=head1 AUTHORS AND CONTRIBUTORS
+
+Rafaël Garcia-Suarez, Bart Lateur, Max Maischein, Anno Siegel, Michael Schwern
+
+=head1 MAINTAINER
+
+Max Maischein C< corion@cpan.org >
+
+Copyright (c) 2007 Max Maischein C<< <corion@cpan.org> >>
+Based on the idea of C<base.pm>, which was introduced with Perl 5.004_04.
+
+=head1 LICENSE
+
+This module is released under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 9;
+use lib 't/lib';
+
+{
+ package Child;
+ use parent 'Dummy';
+}
+
+{
+ package Child2;
+ require Dummy;
+ use parent -norequire, 'Dummy::InlineChild';
+}
+
+{
+ package Child3;
+ use parent "Dummy'Outside";
+}
+
+my $obj = {};
+bless $obj, 'Child';
+isa_ok $obj, 'Dummy';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy", 'Inheritance is set up correctly';
+
+$obj = {};
+bless $obj, 'Child2';
+isa_ok $obj, 'Dummy::InlineChild';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy::InlineChild", 'Inheritance is set up correctly for inlined classes';
+
+$obj = {};
+bless $obj, 'Child3';
+isa_ok $obj, 'Dummy::Outside';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN FROM Dummy::Outside", "Inheritance is set up correctly for classes inherited from via '";
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 3;
+
+{
+ package MyParent;
+ sub exclaim { "I CAN HAS PERL?" }
+}
+
+{
+ package Child;
+ use parent -norequire, 'MyParent';
+}
+
+my $obj = {};
+bless $obj, 'Child';
+isa_ok $obj, 'MyParent', 'Inheritance';
+can_ok $obj, 'exclaim';
+is $obj->exclaim, "I CAN HAS PERL?", 'Inheritance is set up correctly';
+
--- /dev/null
+package Dummy;
+
+# Attempt to emulate a bug with finding the version in Exporter.
+$VERSION = '5.562';
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+package Dummy::InlineChild;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
--- /dev/null
+package Dummy::Outside;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
+
--- /dev/null
+package Dummy2;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+package Dummy2::InlineChild;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
--- /dev/null
+package FileThatOnlyExistsAsPMC;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
--- /dev/null
+package ReturnsFalse;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+0;
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 3;
+use lib 't/lib';
+
+use_ok('parent');
+
+# Tests that a bare (non-double-colon) class still loads
+# and does not get treated as a file:
+eval q{package Test1; require Dummy; use parent -norequire, 'Dummy::InlineChild'; };
+is $@, '', "Loading an unadorned class works";
+isn't $INC{"Dummy.pm"}, undef, 'We loaded Dummy.pm';
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 4;
+use lib 't/lib';
+
+use_ok('parent');
+
+my $base = './t';
+
+# Tests that a bare (non-double-colon) class still loads
+# and does not get treated as a file:
+eval sprintf q{package Test2; require '%s/lib/Dummy2.plugin'; use parent -norequire, 'Dummy2::InlineChild' }, $base;
+is $@, '', "Loading a class from a file works";
+isn't $INC{"$base/lib/Dummy2.plugin"}, undef, "We loaded the plugin file";
+my $o = bless {}, 'Test2';
+isa_ok $o, 'Dummy2::InlineChild';
--- /dev/null
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More;
+use lib 't/lib';
+
+plan skip_all => ".pmc are only available with 5.6 and later" if $] < 5.006;
+plan tests => 3;
+
+use vars qw($got_here);
+
+my $res = eval q{
+ package MyTest;
+
+ use parent 'FileThatOnlyExistsAsPMC';
+
+ 1
+};
+my $error = $@;
+
+is $res, 1, "Block ran until the end";
+is $error, '', "No error";
+
+my $obj = bless {}, 'FileThatOnlyExistsAsPMC';
+can_ok $obj, 'exclaim';
--- /dev/null
+#!/usr/bin/perl -w
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 2;
+use lib 't/lib';
+
+use vars qw($got_here);
+
+my $res = eval q{
+ package MyTest;
+
+ use parent 'ReturnsFalse';
+
+ $main::got_here++
+};
+my $error = $@;
+
+is $got_here, undef, "The block did not run to its end.";
+like $error, q{/^ReturnsFalse.pm did not return a true value at /}, "A module that returns a false value raises an error";
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't' if -d 't';
+ chdir '../lib/parent';
+ @INC = '..';
+ }
+}
+
+use strict;
+use Test::More tests => 10;
+
+use_ok('parent');
+
+
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use parent -norequire, 'No::Version';
+::is( $No::Version::VERSION, undef, '$VERSION gets left alone' );
+
+# Test Inverse: parent.pm should not clobber existing $VERSION
+package Has::Version;
+
+BEGIN { $Has::Version::VERSION = '42' };
+
+package Test::Version2;
+
+use parent -norequire, 'Has::Version';
+::is( $Has::Version::VERSION, 42 );
+
+package main;
+
+my $eval1 = q{
+ {
+ package Eval1;
+ {
+ package Eval2;
+ use parent -norequire, 'Eval1';
+ $Eval2::VERSION = "1.02";
+ }
+ $Eval1::VERSION = "1.01";
+ }
+};
+
+eval $eval1;
+is( $@, '' );
+
+# String comparisons, just to be safe from floating-point errors
+is( $Eval1::VERSION, '1.01' );
+
+is( $Eval2::VERSION, '1.02' );
+
+
+eval q{use parent 'reallyReAlLyNotexists'};
+like( $@, q{/^Can't locate reallyReAlLyNotexists.pm in \@INC \(\@INC contains:/}, 'baseclass that does not exist');
+
+eval q{use parent 'reallyReAlLyNotexists'};
+like( $@, q{/^Can't locate reallyReAlLyNotexists.pm in \@INC \(\@INC contains:/}, ' still failing on 2nd load');
+{
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning = shift };
+ eval q{package HomoGenous; use parent 'HomoGenous';};
+ like($warning, q{/^Class 'HomoGenous' tried to inherit from itself/},
+ ' self-inheriting');
+}
+
+{
+ BEGIN { $Has::Version_0::VERSION = 0 }
+
+ package Test::Version3;
+
+ use parent -norequire, 'Has::Version_0';
+ ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+}
+
projects / platform / upstream / perl.git / commitdiff