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

p4raw-id: //depot/perl@31540

12 files changed, 308 insertions, 159 deletions

diff --git a/MANIFEST b/MANIFEST
index a134634bec..062c0288a9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1456,9 +1456,13 @@ lib/AutoSplit.t			See if AutoSplit works
 lib/autouse.pm			Load and call a function only when it's used
 lib/autouse.t			See if autouse works
 lib/base.pm			Establish IS-A relationship at compile time
+lib/base/Changes		base.pm changelog
 lib/base/t/base.t		See if base works
 lib/base/t/fields-base.t	See if fields work
 lib/base/t/fields.t		See if fields work
+lib/base/t/sigdie.t		See if base works with SIGDIE
+lib/base/t/version.t		See if base works with versions
+lib/base/t/warnings.t		See if base works with warnings
 lib/Benchmark.pm		Measure execution time
 lib/Benchmark.t			See if Benchmark works
 lib/bigfloat.pl			An arbitrary precision floating point package
@@ -3443,6 +3447,7 @@ t/lib/contains_pod.xr		Pod-Parser test file
 t/lib/cygwin.t			Builtin cygwin function tests
 t/lib/Devel/switchd.pm		Module for t/run/switchd.t
 t/lib/Dev/Null.pm		Module for testing Test::Harness
+t/lib/Dummy.pm			Module for testing base.pm
 t/lib/dprof/test1_t		Perl code profiler tests
 t/lib/dprof/test1_v		Perl code profiler tests
 t/lib/dprof/test2_t		Perl code profiler tests
@@ -3470,6 +3475,7 @@ t/lib/Filter/Simple/FilterOnlyTest.pm	Helper file for Filter::Simple tests
 t/lib/Filter/Simple/FilterTest.pm	Helper file for Filter::Simple tests
 t/lib/Filter/Simple/ImportTest.pm	Helper file for Filter::Simple tests
 t/lib/filter-util.pl		See if Filter::Util::Call works
+t/lib/HasSigDie.pm		Module for testing base.pm
 t/lib/h2ph.h			Test header file for h2ph
 t/lib/h2ph.pht			Generated output from h2ph.h by h2ph, for comparison
 t/lib/locale/latin1		Part of locale.t in Latin 1
diff --git a/lib/base.pm b/lib/base.pm
index f1644a8d85..76e235d8ca 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -2,7 +2,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.10';
+$VERSION = '2.12';
 
 # constant.pm is slow
 sub SUCCESS () { 1 }
@@ -40,23 +40,23 @@ sub get_attr {
 
 if ($] < 5.009) {
     *get_fields = sub {
-	# Shut up a possible typo warning.
-	() = \%{$_[0].'::FIELDS'};
-	my $f = \%{$_[0].'::FIELDS'};
+        # Shut up a possible typo warning.
+        () = \%{$_[0].'::FIELDS'};
+        my $f = \%{$_[0].'::FIELDS'};
 
-	# should be centralized in fields? perhaps
-	# fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
-	# is used here anyway, it doesn't matter.
-	bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
+        # should be centralized in fields? perhaps
+        # fields::mk_FIELDS_be_OK. Peh. As long as %{ $package . '::FIELDS' }
+        # is used here anyway, it doesn't matter.
+        bless $f, 'pseudohash' if (ref($f) ne 'pseudohash');
 
-	return $f;
+        return $f;
     }
 }
 else {
     *get_fields = sub {
-	# Shut up a possible typo warning.
-	() = \%{$_[0].'::FIELDS'};
-	return \%{$_[0].'::FIELDS'};
+        # Shut up a possible typo warning.
+        () = \%{$_[0].'::FIELDS'};
+        return \%{$_[0].'::FIELDS'};
     }
 }
 
@@ -78,41 +78,41 @@ sub import {
         next if $inheritor->isa($base);
 
         if (has_version($base)) {
-	    ${$base.'::VERSION'} = '-1, set by base.pm' 
-	      unless defined ${$base.'::VERSION'};
+            ${$base.'::VERSION'} = '-1, set by base.pm' 
+              unless defined ${$base.'::VERSION'};
         }
         else {
-	    my $sigdie;
-	    {
-		local $SIG{__DIE__};
-		eval "require $base";
-		# Only ignore "Can't locate" errors from our eval require.
-		# Other fatal errors (syntax etc) must be reported.
-		die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
-		unless (%{"$base\::"}) {
-		    require Carp;
-		    Carp::croak(<<ERROR);
+            my $sigdie;
+            {
+                local $SIG{__DIE__};
+                eval "require $base";
+                # Only ignore "Can't locate" errors from our eval require.
+                # Other fatal errors (syntax etc) must be reported.
+                die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
+                unless (%{"$base\::"}) {
+                    require Carp;
+                    Carp::croak(<<ERROR);
 Base class package "$base" is empty.
     (Perhaps you need to 'use' the module which defines that package first.)
 ERROR
-		}
-		$sigdie = $SIG{__DIE__};
-	    }
-	    # Make sure a global $SIG{__DIE__} makes it out of the localization.
-	    $SIG{__DIE__} = $sigdie if defined $sigdie;
+                }
+                $sigdie = $SIG{__DIE__};
+            }
+            # Make sure a global $SIG{__DIE__} makes it out of the localization.
+            $SIG{__DIE__} = $sigdie if defined $sigdie;
             ${$base.'::VERSION'} = "-1, set by base.pm"
               unless defined ${$base.'::VERSION'};
         }
         push @{"$inheritor\::ISA"}, $base;
 
         if ( has_fields($base) || has_attr($base) ) {
-	    # No multiple fields inheritance *suck*
-	    if ($fields_base) {
-		require Carp;
-		Carp::croak("Can't multiply inherit %FIELDS");
-	    } else {
-		$fields_base = $base;
-	    }
+            # No multiple fields inheritance *suck*
+            if ($fields_base) {
+                require Carp;
+                Carp::croak("Can't multiply inherit fields");
+            } else {
+                $fields_base = $base;
+            }
         }
     }
 
@@ -135,10 +135,11 @@ sub inherit_fields {
     $dattr->[0] = @$battr;
 
     if( keys %$dfields ) {
-        warn "$derived is inheriting from $base but already has its own ".
-             "fields!\n".
-             "This will cause problems.\n".
-             "Be sure you use base BEFORE declaring fields\n";
+        warn <<"END";
+$derived is inheriting from $base but already has its own fields!
+This will cause problems.  Be sure you use base BEFORE declaring fields.
+END
+
     }
 
     # Iterate through the base's fields adding all the non-private
@@ -147,10 +148,10 @@ sub inherit_fields {
     # This is all too complicated to do efficiently with add_fields().
     while (my($k,$v) = each %$bfields) {
         my $fno;
-	if ($fno = $dfields->{$k} and $fno != $v) {
-	    require Carp;
-	    Carp::croak ("Inherited %FIELDS can't override existing %FIELDS");
-	}
+        if ($fno = $dfields->{$k} and $fno != $v) {
+            require Carp;
+            Carp::croak ("Inherited fields can't override existing fields");
+        }
 
         if( $battr->[$v] & PRIVATE ) {
             $dattr->[$v] = PRIVATE | INHERITED;
@@ -162,8 +163,8 @@ sub inherit_fields {
     }
 
     foreach my $idx (1..$#{$battr}) {
-	next if defined $dattr->[$idx];
-	$dattr->[$idx] = $battr->[$idx] & INHERITED;
+        next if defined $dattr->[$idx];
+        $dattr->[$idx] = $battr->[$idx] & INHERITED;
     }
 }
 
@@ -174,7 +175,7 @@ __END__
 
 =head1 NAME
 
-base - Establish IS-A relationship with base classes at compile time
+base - Establish an ISA relationship with base classes at compile time
 
 =head1 SYNOPSIS
 
@@ -193,18 +194,29 @@ those modules at the same time.  Roughly similar in effect to
         push @ISA, qw(Foo Bar);
     }
 
-If any of the listed modules are not loaded yet, I<base> silently attempts to
-C<require> them (and silently continues if the C<require> failed).  Whether to
-C<require> a base class module is determined by the absence of a global variable
-$VERSION in the base package.  If $VERSION is not detected even after loading
-it, <base> will define $VERSION in the base package, setting it to the string
-C<-1, set by base.pm>.
+C<base> employs some heuristics to determine if a module has already been
+loaded, if it has it doesn't try again. If C<base> tries to C<require> the
+module it will not die if it cannot find the module's file, but will die on any
+other error. After all this, should your base class be empty, containing no
+symbols, it will die. This is useful for inheriting from classes in the same
+file as yourself, like so:
+
+        package Foo;
+        sub exclaim { "I can have such a thing?!" }
+        
+        package Bar;
+        use base "Foo";
+
+If $VERSION is not detected even after loading it, <base> will define $VERSION
+in the base package, setting it to the string C<-1, set by base.pm>.
+
+C<base> will also initialize the fields if one of the base classes has it.
+Multiple inheritance of fields is B<NOT> supported, if two or more base classes
+each have inheritable fields the 'base' pragma will croak. See L<fields>,
+L<public> and L<protected> for a description of this feature.
+
+The base class' C<import> method is B<not> called.
 
-Will also initialize the fields if one of the base classes has it.
-Multiple inheritance of fields is B<NOT> supported, if two or more
-base classes each have inheritable fields the 'base' pragma will
-croak.  See L<fields>, L<public> and L<protected> for a description of
-this feature.
 
 =head1 DIAGNOSTICS
 
@@ -215,18 +227,18 @@ this feature.
 base.pm was unable to require the base package, because it was not
 found in your path.
 
-=back
+=item Class 'Foo' tried to inherit from itself
 
-=head1 HISTORY
+Attempting to inherit from yourself generates a warning.
 
-This module was introduced with Perl 5.004_04.
+    use Foo;
+    use base 'Foo';
 
-Attempting to inherit from yourself generates a warning:
+=back
 
- use Foo;
- use base 'Foo';
+=head1 HISTORY
 
- # Class 'Foo' tried to inherit from itself
+This module was introduced with Perl 5.004_04.
 
 =head1 CAVEATS
 
diff --git a/lib/base/Changes b/lib/base/Changes
new file mode 100644
index 0000000000..b86a7bd648
--- /dev/null
+++ b/lib/base/Changes
@@ -0,0 +1,53 @@
+2.12  Fri Jul  6 00:57:15 PDT 2007
+    Test Features
+    - Test that base.pm preserves $VERSION after real module loading.
+
+    Bug Fixes
+    - Last version broke the warning about inheriting fields.
+
+2.11  Mon Jul  2 03:30:03 PDT 2007
+    New Features
+    - Inheriting from yourself causes a warning [bleadperl 29090]
+
+    Bug Fixes
+    - Silenced warning when a class with no fields inherits from a class with
+      fields. [bleadperl 22208]
+    - An intermediate class with no fields messes up private fields
+      in the base class. [bleadperl 23266] [bleadperl 23267]
+    * Loading a module via base.pm would mask a global $SIG{__DIE__} in
+      that module. [bleadperl 31163]
+    - A constant named FIELDS in a base class would confuse base.pm
+      [bleadperl 31420]
+
+    Documentation Improvements
+    - Added a DIAGNOSTICS section [bleadperl 22748]
+    - Minor typos [bleadperl 25261]
+    - Better explain how base goes about loading classes.
+    - State explicitly that non-file classes can be based on.
+    - Document that import() is not called.
+
+    Test Fixes
+    - Fix tests for new disallowed hash key access error message in blead.
+
+2.04 through 2.10 were only released with perl.
+
+2.03 Sun Sep 14 20:01:48 PDT 2003
+    * phashes produced via fields::new() will now not warn when used for
+      forward compatiblity purposes
+    - Reformatting the docs to make them a bit more readable
+    - Making it clear that fields::new() is usable with or without
+      pseudohashes
+    * Fixing inheritence from classes which have only private fields
+    * Fixing inheritence when an intermediate class has no fields.
+      [perlbug 20020326.004]
+    - Removing uses of 'our' from tests for backwards compat.
+
+2.02 Wed Sep  3 20:40:13 PDT 2003
+    - Merging the core fields.t test and my own long ago forked base.t test
+      into fields-base.t combining all tests
+
+2.01 Thu Aug 28 13:39:32 PDT 2003
+    - Forgot to set the INSTALLDIRS to 'perl'
+
+2.0  Wed Aug 27 21:47:51 PDT 2003
+    * Seperated from Class::Fields
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';
diff --git a/lib/fields.pm b/lib/fields.pm
index cca778f905..44a68c57f8 100644
--- a/lib/fields.pm
+++ b/lib/fields.pm
@@ -3,7 +3,7 @@ package fields;
 require 5.005;
 use strict;
 no strict 'refs';
-unless( eval q{require warnings::register; warnings::register->import} ) {
+unless( eval q{require warnings::register; warnings::register->import; 1} ) {
     *warnings::warnif = sub { 
         require Carp;
         Carp::carp(@_);
@@ -11,7 +11,7 @@ unless( eval q{require warnings::register; warnings::register->import} ) {
 }
 use vars qw(%attr $VERSION);
 
-$VERSION = '2.03';
+$VERSION = '2.12';
 
 # constant.pm is slow
 sub PUBLIC     () { 2**0  }
@@ -42,19 +42,19 @@ sub import {
     bless \%{"$package\::FIELDS"}, 'pseudohash';
 
     if ($next > $fattr->[0]
-	and ($fields->{$_[0]} || 0) >= $fattr->[0])
+        and ($fields->{$_[0]} || 0) >= $fattr->[0])
     {
-	# There are already fields not belonging to base classes.
-	# Looks like a possible module reload...
-	$next = $fattr->[0];
+        # There are already fields not belonging to base classes.
+        # Looks like a possible module reload...
+        $next = $fattr->[0];
     }
     foreach my $f (@_) {
-	my $fno = $fields->{$f};
+        my $fno = $fields->{$f};
 
-	# Allow the module to be reloaded so long as field positions
-	# have not changed.
-	if ($fno and $fno != $next) {
-	    require Carp;
+        # Allow the module to be reloaded so long as field positions
+        # have not changed.
+        if ($fno and $fno != $next) {
+            require Carp;
             if ($fno < $fattr->[0]) {
               if ($] < 5.006001) {
                 warn("Hides field '$f' in base class") if $^W;
@@ -64,19 +64,19 @@ sub import {
             } else {
                 Carp::croak("Field name '$f' already in use");
             }
-	}
-	$fields->{$f} = $next;
+        }
+        $fields->{$f} = $next;
         $fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
-	$next += 1;
+        $next += 1;
     }
     if (@$fattr > $next) {
-	# Well, we gave them the benefit of the doubt by guessing the
-	# module was reloaded, but they appear to be declaring fields
-	# in more than one place.  We can't be sure (without some extra
-	# bookkeeping) that the rest of the fields will be declared or
-	# have the same positions, so punt.
-	require Carp;
-	Carp::croak ("Reloaded module must declare all fields at once");
+        # Well, we gave them the benefit of the doubt by guessing the
+        # module was reloaded, but they appear to be declaring fields
+        # in more than one place.  We can't be sure (without some extra
+        # bookkeeping) that the rest of the fields will be declared or
+        # have the same positions, so punt.
+        require Carp;
+        Carp::croak ("Reloaded module must declare all fields at once");
     }
 }
 
@@ -88,25 +88,25 @@ sub inherit {
 sub _dump  # sometimes useful for debugging
 {
     for my $pkg (sort keys %attr) {
-	print "\n$pkg";
-	if (@{"$pkg\::ISA"}) {
-	    print " (", join(", ", @{"$pkg\::ISA"}), ")";
-	}
-	print "\n";
-	my $fields = \%{"$pkg\::FIELDS"};
-	for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
-	    my $no = $fields->{$f};
-	    print "   $no: $f";
-	    my $fattr = $attr{$pkg}[$no];
-	    if (defined $fattr) {
-		my @a;
-		push(@a, "public")    if $fattr & PUBLIC;
-		push(@a, "private")   if $fattr & PRIVATE;
-		push(@a, "inherited") if $fattr & INHERITED;
-		print "\t(", join(", ", @a), ")";
-	    }
-	    print "\n";
-	}
+        print "\n$pkg";
+        if (@{"$pkg\::ISA"}) {
+            print " (", join(", ", @{"$pkg\::ISA"}), ")";
+        }
+        print "\n";
+        my $fields = \%{"$pkg\::FIELDS"};
+        for my $f (sort {$fields->{$a} <=> $fields->{$b}} keys %$fields) {
+            my $no = $fields->{$f};
+            print "   $no: $f";
+            my $fattr = $attr{$pkg}[$no];
+            if (defined $fattr) {
+                my @a;
+                push(@a, "public")    if $fattr & PUBLIC;
+                push(@a, "private")   if $fattr & PRIVATE;
+                push(@a, "inherited") if $fattr & INHERITED;
+                print "\t(", join(", ", @a), ")";
+            }
+            print "\n";
+        }
     }
 }
 
@@ -177,16 +177,16 @@ fields - compile-time class fields
     {
         package Foo;
         use fields qw(foo bar _Foo_private);
-	sub new {
-	    my Foo $self = shift;
-	    unless (ref $self) {
-		$self = fields::new($self);
-		$self->{_Foo_private} = "this is Foo's secret";
-	    }
-	    $self->{foo} = 10;
-	    $self->{bar} = 20;
-	    return $self;
-	}
+        sub new {
+            my Foo $self = shift;
+            unless (ref $self) {
+                $self = fields::new($self);
+                $self->{_Foo_private} = "this is Foo's secret";
+            }
+            $self->{foo} = 10;
+            $self->{bar} = 20;
+            return $self;
+        }
     }
 
     my $var = Foo->new;
@@ -199,15 +199,15 @@ fields - compile-time class fields
     {
         package Bar;
         use base 'Foo';
-        use fields qw(baz _Bar_private);	# not shared with Foo
-	sub new {
-	    my $class = shift;
-	    my $self = fields::new($class);
-	    $self->SUPER::new();		# init base fields
-	    $self->{baz} = 10;			# init own fields
-	    $self->{_Bar_private} = "this is Bar's secret";
-	    return $self;
-	}
+        use fields qw(baz _Bar_private);        # not shared with Foo
+        sub new {
+            my $class = shift;
+            my $self = fields::new($class);
+            $self->SUPER::new();                # init base fields
+            $self->{baz} = 10;                  # init own fields
+            $self->{_Bar_private} = "this is Bar's secret";
+            return $self;
+        }
     }
 
 =head1 DESCRIPTION
@@ -268,11 +268,11 @@ This makes it possible to write a constructor like this:
     use fields qw(cat dog bird);
 
     sub new {
-	my $self = shift;
-	$self = fields::new($self) unless ref $self;
-	$self->{cat} = 'meow';				# scalar element
-	@$self{'dog','bird'} = ('bark','tweet');	# slice
-	return $self;
+        my $self = shift;
+        $self = fields::new($self) unless ref $self;
+        $self->{cat} = 'meow';                          # scalar element
+        @$self{'dog','bird'} = ('bark','tweet');        # slice
+        return $self;
     }
 
 =item phash
diff --git a/t/lib/Dummy.pm b/t/lib/Dummy.pm
new file mode 100644
index 0000000000..504330f8b1
--- /dev/null
+++ b/t/lib/Dummy.pm
@@ -0,0 +1,4 @@
+package Dummy;
+
+# Attempt to emulate a bug with finding the version in Exporter.
+$VERSION = '5.562';
diff --git a/t/lib/HasSigDie.pm b/t/lib/HasSigDie.pm
new file mode 100644
index 0000000000..3368e04995
--- /dev/null
+++ b/t/lib/HasSigDie.pm
@@ -0,0 +1,6 @@
+package HasSigDie;
+
+$SIG{__DIE__} = sub { "Die, Bart, Die!" };
+
+1;
+