Move parent from ext/ to cpan/

13 files changed, 427 insertions, 0 deletions

diff --git a/cpan/parent/lib/parent.pm b/cpan/parent/lib/parent.pm
new file mode 100644
index 0000000000..a18526bb51
--- /dev/null
+++ b/cpan/parent/lib/parent.pm
@@ -0,0 +1,136 @@
+package parent;
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.223';
+
+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', 'Bar';
+
+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
diff --git a/cpan/parent/t/compile-time-file.t b/cpan/parent/t/compile-time-file.t
new file mode 100644
index 0000000000..bff8861552
--- /dev/null
+++ b/cpan/parent/t/compile-time-file.t
@@ -0,0 +1,47 @@
+#!/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 '";
+
diff --git a/cpan/parent/t/compile-time.t b/cpan/parent/t/compile-time.t
new file mode 100644
index 0000000000..be6d54cb74
--- /dev/null
+++ b/cpan/parent/t/compile-time.t
@@ -0,0 +1,21 @@
+#!/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';
+
diff --git a/cpan/parent/t/lib/Dummy.pm b/cpan/parent/t/lib/Dummy.pm
new file mode 100644
index 0000000000..0136328832
--- /dev/null
+++ b/cpan/parent/t/lib/Dummy.pm
@@ -0,0 +1,12 @@
+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;
diff --git a/cpan/parent/t/lib/Dummy/Outside.pm b/cpan/parent/t/lib/Dummy/Outside.pm
new file mode 100644
index 0000000000..020d79c3d3
--- /dev/null
+++ b/cpan/parent/t/lib/Dummy/Outside.pm
@@ -0,0 +1,6 @@
+package Dummy::Outside;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
+
diff --git a/cpan/parent/t/lib/Dummy2.plugin b/cpan/parent/t/lib/Dummy2.plugin
new file mode 100644
index 0000000000..2a68d3d51f
--- /dev/null
+++ b/cpan/parent/t/lib/Dummy2.plugin
@@ -0,0 +1,7 @@
+package Dummy2;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+package Dummy2::InlineChild;
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
diff --git a/cpan/parent/t/lib/FileThatOnlyExistsAsPMC.pmc b/cpan/parent/t/lib/FileThatOnlyExistsAsPMC.pmc
new file mode 100644
index 0000000000..d9b8b8fd98
--- /dev/null
+++ b/cpan/parent/t/lib/FileThatOnlyExistsAsPMC.pmc
@@ -0,0 +1,5 @@
+package FileThatOnlyExistsAsPMC;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+1;
diff --git a/cpan/parent/t/lib/ReturnsFalse.pm b/cpan/parent/t/lib/ReturnsFalse.pm
new file mode 100644
index 0000000000..41db2138a5
--- /dev/null
+++ b/cpan/parent/t/lib/ReturnsFalse.pm
@@ -0,0 +1,5 @@
+package ReturnsFalse;
+
+sub exclaim { "I CAN FROM " . __PACKAGE__ }
+
+0;
diff --git a/cpan/parent/t/parent-classfromclassfile.t b/cpan/parent/t/parent-classfromclassfile.t
new file mode 100644
index 0000000000..6d92e2ddf3
--- /dev/null
+++ b/cpan/parent/t/parent-classfromclassfile.t
@@ -0,0 +1,21 @@
+#!/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';
diff --git a/cpan/parent/t/parent-classfromfile.t b/cpan/parent/t/parent-classfromfile.t
new file mode 100644
index 0000000000..13dbcc15a4
--- /dev/null
+++ b/cpan/parent/t/parent-classfromfile.t
@@ -0,0 +1,25 @@
+#!/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';
diff --git a/cpan/parent/t/parent-pmc.t b/cpan/parent/t/parent-pmc.t
new file mode 100644
index 0000000000..851a438fd3
--- /dev/null
+++ b/cpan/parent/t/parent-pmc.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        chdir '../lib/parent';
+        @INC = '..';
+    }
+}
+
+use strict;
+use Test::More;
+use Config;
+use lib 't/lib';
+
+plan skip_all => ".pmc are only available with 5.6 and later" if $] < 5.006;
+plan skip_all => ".pmc are disabled in this perl"
+    if $Config{ccflags} =~ /(?<!\w)-DPERL_DISABLE_PMC\b/;
+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';
diff --git a/cpan/parent/t/parent-returns-false.t b/cpan/parent/t/parent-returns-false.t
new file mode 100644
index 0000000000..d388b4c9ed
--- /dev/null
+++ b/cpan/parent/t/parent-returns-false.t
@@ -0,0 +1,26 @@
+#!/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";
diff --git a/cpan/parent/t/parent.t b/cpan/parent/t/parent.t
new file mode 100644
index 0000000000..401fe39d5d
--- /dev/null
+++ b/cpan/parent/t/parent.t
@@ -0,0 +1,81 @@
+#!/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' );
+}
+