Upgrade to base and fields 2.12, mostly by Michael G Schwern

p4raw-id: //depot/perl@31540

6 files changed, 98 insertions, 30 deletions

diff --git a/lib/base/t/base.t b/lib/base/t/base.t
index 7a707ded43..8d32064cc1 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 => 12;
+use Test::More tests => 11;
 
 use_ok('base');
 
@@ -63,31 +63,21 @@ like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty./,
                                           '  self-inheriting');
 }
 
-BEGIN { $Has::Version_0::VERSION = 0 }
-
-package Test::Version3;
-
-use base qw(Has::Version_0);
-::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+{
+    BEGIN { $Has::Version_0::VERSION = 0 }
 
+    package Test::Version3;
 
-package Test::SIGDIE;
+    use base qw(Has::Version_0);
+    ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+}
 
-{ 
-    local $SIG{__DIE__} = sub { 
-        ::fail('sigdie not caught, this test should not run') 
-    };
-    eval {
-      'base'->import(qw(Huh::Boo));
-    };
 
-    ::like($@, qr/^Base class package "Huh::Boo" is empty/, 
-         'Base class empty error message');
+{
+    package Schlozhauer;
+    use constant FIELDS => 6;
 
+    package Basilisco;
+    eval q{ use base 'Schlozhauer' };
+    ::is( $@, '', 'Can coexist with a FIELDS constant' );
 }
-
-package Schlozhauer;
-use constant FIELDS => 6;
-package Basilisco;
-eval q{ use base 'Schlozhauer' };
-::is( $@, '', 'Can coexist with a FIELDS constant' );
diff --git a/lib/base/t/fields-base.t b/lib/base/t/fields-base.t
index da4b5c7d62..ab4daf5ee9 100644
--- a/lib/base/t/fields-base.t
+++ b/lib/base/t/fields-base.t
@@ -64,8 +64,8 @@ use base qw(M B2);
 # Test that multiple inheritance fails.
 package D6;
 eval { 'base'->import(qw(B2 M B3)); };
-::like($@, qr/can't multiply inherit %FIELDS/i, 
-                                        'No multiple field inheritance');
+::like($@, qr/can't multiply inherit fields/i, 
+    'No multiple field inheritance');
 
 package Foo::Bar;
 use base 'B1';
@@ -197,7 +197,7 @@ eval {
     require base;
     'base'->import(qw(E1 E2));
 };
-::like( $@, qr/Can't multiply inherit %FIELDS/i, 'Again, no multi inherit' );
+::like( $@, qr/Can't multiply inherit fields/i, 'Again, no multi inherit' );
 
 
 # Test that a package with no fields can inherit from a package with
diff --git a/lib/base/t/fields.t b/lib/base/t/fields.t
index 4d29d8dfc3..4999cfed14 100644
--- a/lib/base/t/fields.t
+++ b/lib/base/t/fields.t
@@ -39,11 +39,9 @@ is_deeply( [sort &show_fields('Foo', fields::PRIVATE)],
            [sort qw(_no _up_yours)]);
 
 # We should get compile time failures field name typos
-eval q(return; my Foo $obj = Foo->new; $obj->{notthere} = "");
+eval q(my Foo $obj = Foo->new; $obj->{notthere} = "");
 
-my $error = $Has_PH ? qr/No such(?: [\w-]+)? field "notthere"/
-    : qr/No such class field "notthere" in variable \$obj of type Foo/;
-like( $@, $error );
+like $@, qr/^No such .*field "notthere"/i;
 
 
 foreach (Foo->new) {
diff --git a/lib/base/t/sigdie.t b/lib/base/t/sigdie.t
new file mode 100644
index 0000000000..9237463907
--- /dev/null
+++ b/lib/base/t/sigdie.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+   if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = qw(../lib ../t/lib);
+    }
+}
+
+use strict;
+use Test::More tests => 2;
+
+use base;
+
+{
+    package Test::SIGDIE;
+
+    local $SIG{__DIE__} = sub { 
+        ::fail('sigdie not caught, this test should not run') 
+    };
+    eval {
+      'base'->import(qw(Huh::Boo));
+    };
+
+    ::like($@, qr/^Base class package "Huh::Boo" is empty/, 
+         'Base class empty error message');
+}
+
+
+{
+    use lib 't/lib';
+    
+    local $SIG{__DIE__};
+    base->import(qw(HasSigDie));
+    ok $SIG{__DIE__}, 'base.pm does not mask SIGDIE';
+}
diff --git a/lib/base/t/version.t b/lib/base/t/version.t
new file mode 100644
index 0000000000..f2d7b73bef
--- /dev/null
+++ b/lib/base/t/version.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+   if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = qw(../lib ../t/lib);
+    }
+}
+
+use strict;
+
+use Test::More tests => 1;
+
+# Here we emulate a bug with base.pm not finding the Exporter version
+# for some reason.
+use lib qw(t/lib);
+use base qw(Dummy);
+
+is( $Dummy::VERSION, 5.562,       "base.pm doesn't confuse the version" );
diff --git a/lib/base/t/warnings.t b/lib/base/t/warnings.t
new file mode 100644
index 0000000000..51e91741ea
--- /dev/null
+++ b/lib/base/t/warnings.t
@@ -0,0 +1,25 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 1;
+
+my $warnings;
+BEGIN {
+    $SIG{__WARN__} = sub { $warnings = join '', @_ };
+}
+
+{
+    package Foo;
+    use fields qw(thing);
+}
+
+{
+    package Bar;
+    use fields qw(stuff);
+    use base qw(Foo);
+}
+
+::like $warnings,
+       '/^Bar is inheriting from Foo but already has its own fields!/',
+       'Inheriting from a base with protected fields warns';