Move base from ext/ to dist/

17 files changed, 1785 insertions, 0 deletions

diff --git a/dist/base/Changes b/dist/base/Changes
new file mode 100644
index 0000000000..12d615c0e0
--- /dev/null
+++ b/dist/base/Changes
@@ -0,0 +1,62 @@
+2.14
+    - fix problem with SIGDIE on perls < 5.10
+    - Make @INC available in base.pm's error message when
+      a module can't be found. See CPAN bug #28582.
+    - Fix obscure bug introduced in 2.13 (Michael G Schwern)
+
+2.13
+    - push all classes at once in @ISA
+
+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/dist/base/MANIFEST b/dist/base/MANIFEST
new file mode 100644
index 0000000000..76a94603f9
--- /dev/null
+++ b/dist/base/MANIFEST
@@ -0,0 +1,18 @@
+Changes
+lib/base.pm
+lib/fields.pm
+Makefile.PL
+MANIFEST
+META.yml			Module meta-data (added by MakeMaker)
+t/base.t
+t/compile-time.t
+t/fields-5.6.0.t
+t/fields-5.8.0.t
+t/fields-base.t
+t/fields.t
+t/isa.t
+t/lib/Dummy.pm
+t/lib/HasSigDie.pm
+t/sigdie.t
+t/version.t
+t/warnings.t
diff --git a/dist/base/META.yml b/dist/base/META.yml
new file mode 100644
index 0000000000..df139a1ef3
--- /dev/null
+++ b/dist/base/META.yml
@@ -0,0 +1,13 @@
+--- #YAML:1.0
+name:                base
+version:             2.14
+abstract:            ~
+license:             ~
+author:              ~
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
+    Test::More:                    0.4
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3
diff --git a/dist/base/lib/base.pm b/dist/base/lib/base.pm
new file mode 100644
index 0000000000..574925fb60
--- /dev/null
+++ b/dist/base/lib/base.pm
@@ -0,0 +1,265 @@
+package base;
+
+use strict 'vars';
+use vars qw($VERSION);
+$VERSION = '2.14';
+$VERSION = eval $VERSION;
+
+# constant.pm is slow
+sub SUCCESS () { 1 }
+
+sub PUBLIC     () { 2**0  }
+sub PRIVATE    () { 2**1  }
+sub INHERITED  () { 2**2  }
+sub PROTECTED  () { 2**3  }
+
+
+my $Fattr = \%fields::attr;
+
+sub has_fields {
+    my($base) = shift;
+    my $fglob = ${"$base\::"}{FIELDS};
+    return( ($fglob && 'GLOB' eq ref($fglob) && *$fglob{HASH}) ? 1 : 0 );
+}
+
+sub has_version {
+    my($base) = shift;
+    my $vglob = ${$base.'::'}{VERSION};
+    return( ($vglob && *$vglob{SCALAR}) ? 1 : 0 );
+}
+
+sub has_attr {
+    my($proto) = shift;
+    my($class) = ref $proto || $proto;
+    return exists $Fattr->{$class};
+}
+
+sub get_attr {
+    $Fattr->{$_[0]} = [1] unless $Fattr->{$_[0]};
+    return $Fattr->{$_[0]};
+}
+
+if ($] < 5.009) {
+    *get_fields = sub {
+        # 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');
+
+        return $f;
+    }
+}
+else {
+    *get_fields = sub {
+        # Shut up a possible typo warning.
+        () = \%{$_[0].'::FIELDS'};
+        return \%{$_[0].'::FIELDS'};
+    }
+}
+
+sub import {
+    my $class = shift;
+
+    return SUCCESS unless @_;
+
+    # List of base classes from which we will inherit %FIELDS.
+    my $fields_base;
+
+    my $inheritor = caller(0);
+    my @isa_classes;
+
+    my @bases;
+    foreach my $base (@_) {
+        if ( $inheritor eq $base ) {
+            warn "Class '$inheritor' tried to inherit from itself\n";
+        }
+
+        next if grep $_->isa($base), ($inheritor, @bases);
+
+        if (has_version($base)) {
+            ${$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;
+                    local $" = " ";
+                    Carp::croak(<<ERROR);
+Base class package "$base" is empty.
+    (Perhaps you need to 'use' the module which defines that package first,
+    or make that module available in \@INC (\@INC contains: @INC).
+ERROR
+                }
+                $sigdie = $SIG{__DIE__} || undef;
+            }
+            # 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 @bases, $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;
+            }
+        }
+    }
+    # Save this until the end so it's all or nothing if the above loop croaks.
+    push @{"$inheritor\::ISA"}, @isa_classes;
+
+    push @{"$inheritor\::ISA"}, @bases;
+
+    if( defined $fields_base ) {
+        inherit_fields($inheritor, $fields_base);
+    }
+}
+
+
+sub inherit_fields {
+    my($derived, $base) = @_;
+
+    return SUCCESS unless $base;
+
+    my $battr = get_attr($base);
+    my $dattr = get_attr($derived);
+    my $dfields = get_fields($derived);
+    my $bfields = get_fields($base);
+
+    $dattr->[0] = @$battr;
+
+    if( keys %$dfields ) {
+        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
+    # ones to the derived class.  Hang on to the original attribute
+    # (Public, Private, etc...) and add Inherited.
+    # 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( $battr->[$v] & PRIVATE ) {
+            $dattr->[$v] = PRIVATE | INHERITED;
+        }
+        else {
+            $dattr->[$v] = INHERITED | $battr->[$v];
+            $dfields->{$k} = $v;
+        }
+    }
+
+    foreach my $idx (1..$#{$battr}) {
+        next if defined $dattr->[$idx];
+        $dattr->[$idx] = $battr->[$idx] & INHERITED;
+    }
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+base - Establish an ISA relationship with base classes at compile time
+
+=head1 SYNOPSIS
+
+    package Baz;
+    use base qw(Foo Bar);
+
+=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
+
+    package Baz;
+    BEGIN {
+        require Foo;
+        require Bar;
+        push @ISA, qw(Foo Bar);
+    }
+
+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.
+
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item Base class package "%s" is empty.
+
+base.pm was unable to require the base package, because it was not
+found in your path.
+
+=item Class 'Foo' tried to inherit from itself
+
+Attempting to inherit from yourself generates a warning.
+
+    use Foo;
+    use base 'Foo';
+
+=back
+
+=head1 HISTORY
+
+This module was introduced with Perl 5.004_04.
+
+=head1 CAVEATS
+
+Due to the limitations of the implementation, you must use
+base I<before> you declare any of your own fields.
+
+
+=head1 SEE ALSO
+
+L<fields>
+
+=cut
diff --git a/dist/base/lib/fields.pm b/dist/base/lib/fields.pm
new file mode 100644
index 0000000000..c90bc0a16c
--- /dev/null
+++ b/dist/base/lib/fields.pm
@@ -0,0 +1,327 @@
+package fields;
+
+require 5.005;
+use strict;
+no strict 'refs';
+unless( eval q{require warnings::register; warnings::register->import; 1} ) {
+    *warnings::warnif = sub { 
+        require Carp;
+        Carp::carp(@_);
+    }
+}
+use vars qw(%attr $VERSION);
+
+$VERSION = '2.14';
+
+# constant.pm is slow
+sub PUBLIC     () { 2**0  }
+sub PRIVATE    () { 2**1  }
+sub INHERITED  () { 2**2  }
+sub PROTECTED  () { 2**3  }
+
+
+# The %attr hash holds the attributes of the currently assigned fields
+# per class.  The hash is indexed by class names and the hash value is
+# an array reference.  The first element in the array is the lowest field
+# number not belonging to a base class.  The remaining elements' indices
+# are the field numbers.  The values are integer bit masks, or undef
+# in the case of base class private fields (which occupy a slot but are
+# otherwise irrelevant to the class).
+
+sub import {
+    my $class = shift;
+    return unless @_;
+    my $package = caller(0);
+    # avoid possible typo warnings
+    %{"$package\::FIELDS"} = () unless %{"$package\::FIELDS"};
+    my $fields = \%{"$package\::FIELDS"};
+    my $fattr = ($attr{$package} ||= [1]);
+    my $next = @$fattr;
+
+    # Quiet pseudo-hash deprecation warning for uses of fields::new.
+    bless \%{"$package\::FIELDS"}, 'pseudohash';
+
+    if ($next > $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];
+    }
+    foreach my $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;
+            if ($fno < $fattr->[0]) {
+              if ($] < 5.006001) {
+                warn("Hides field '$f' in base class") if $^W;
+              } else {
+                warnings::warnif("Hides field '$f' in base class") ;
+              }
+            } else {
+                Carp::croak("Field name '$f' already in use");
+            }
+        }
+        $fields->{$f} = $next;
+        $fattr->[$next] = ($f =~ /^_/) ? PRIVATE : PUBLIC;
+        $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");
+    }
+}
+
+sub inherit {
+    require base;
+    goto &base::inherit_fields;
+}
+
+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";
+        }
+    }
+}
+
+if ($] < 5.009) {
+  *new = sub {
+    my $class = shift;
+    $class = ref $class if ref $class;
+    return bless [\%{$class . "::FIELDS"}], $class;
+  }
+} else {
+  *new = sub {
+    my $class = shift;
+    $class = ref $class if ref $class;
+    require Hash::Util;
+    my $self = bless {}, $class;
+
+    # The lock_keys() prototype won't work since we require Hash::Util :(
+    &Hash::Util::lock_keys(\%$self, _accessible_keys($class));
+    return $self;
+  }
+}
+
+sub _accessible_keys {
+    my ($class) = @_;
+    return (
+        keys %{$class.'::FIELDS'},
+        map(_accessible_keys($_), @{$class.'::ISA'}),
+    );
+}
+
+sub phash {
+    die "Pseudo-hashes have been removed from Perl" if $] >= 5.009;
+    my $h;
+    my $v;
+    if (@_) {
+       if (ref $_[0] eq 'ARRAY') {
+           my $a = shift;
+           @$h{@$a} = 1 .. @$a;
+           if (@_) {
+               $v = shift;
+               unless (! @_ and ref $v eq 'ARRAY') {
+                   require Carp;
+                   Carp::croak ("Expected at most two array refs\n");
+               }
+           }
+       }
+       else {
+           if (@_ % 2) {
+               require Carp;
+               Carp::croak ("Odd number of elements initializing pseudo-hash\n");
+           }
+           my $i = 0;
+           @$h{grep ++$i % 2, @_} = 1 .. @_ / 2;
+           $i = 0;
+           $v = [grep $i++ % 2, @_];
+       }
+    }
+    else {
+       $h = {};
+       $v = [];
+    }
+    [ $h, @$v ];
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+fields - compile-time class fields
+
+=head1 SYNOPSIS
+
+    {
+        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;
+        }
+    }
+
+    my $var = Foo->new;
+    $var->{foo} = 42;
+
+    # this will generate an error
+    $var->{zap} = 42;
+
+    # subclassing
+    {
+        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;
+        }
+    }
+
+=head1 DESCRIPTION
+
+The C<fields> pragma enables compile-time verified class fields.
+
+NOTE: The current implementation keeps the declared fields in the %FIELDS
+hash of the calling package, but this may change in future versions.
+Do B<not> update the %FIELDS hash directly, because it must be created
+at compile-time for it to be fully useful, as is done by this pragma.
+
+B<Only valid for perl before 5.9.0:>
+
+If a typed lexical variable holding a reference is used to access a
+hash element and a package with the same name as the type has
+declared class fields using this pragma, then the operation is
+turned into an array access at compile time.
+
+
+The related C<base> pragma will combine fields from base classes and any
+fields declared using the C<fields> pragma.  This enables field
+inheritance to work properly.
+
+Field names that start with an underscore character are made private to
+the class and are not visible to subclasses.  Inherited fields can be
+overridden but will generate a warning if used together with the C<-w>
+switch.
+
+B<Only valid for perls before 5.9.0:>
+
+The effect of all this is that you can have objects with named
+fields which are as compact and as fast arrays to access. This only
+works as long as the objects are accessed through properly typed
+variables. If the objects are not typed, access is only checked at
+run time.
+
+
+The following functions are supported:
+
+=over 4
+
+=item new
+
+B< perl before 5.9.0: > fields::new() creates and blesses a
+pseudo-hash comprised of the fields declared using the C<fields>
+pragma into the specified class.
+
+B< perl 5.9.0 and higher: > fields::new() creates and blesses a
+restricted-hash comprised of the fields declared using the C<fields>
+pragma into the specified class.
+
+This function is usable with or without pseudo-hashes.  It is the
+recommended way to construct a fields-based object.
+
+This makes it possible to write a constructor like this:
+
+    package Critter::Sounds;
+    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;
+    }
+
+=item phash
+
+B< before perl 5.9.0: > 
+
+fields::phash() can be used to create and initialize a plain (unblessed)
+pseudo-hash.  This function should always be used instead of creating
+pseudo-hashes directly.
+
+If the first argument is a reference to an array, the pseudo-hash will
+be created with keys from that array.  If a second argument is supplied,
+it must also be a reference to an array whose elements will be used as
+the values.  If the second array contains less elements than the first,
+the trailing elements of the pseudo-hash will not be initialized.
+This makes it particularly useful for creating a pseudo-hash from
+subroutine arguments:
+
+    sub dogtag {
+       my $tag = fields::phash([qw(name rank ser_num)], [@_]);
+    }
+
+fields::phash() also accepts a list of key-value pairs that will
+be used to construct the pseudo hash.  Examples:
+
+    my $tag = fields::phash(name => "Joe",
+                            rank => "captain",
+                            ser_num => 42);
+
+    my $pseudohash = fields::phash(%args);
+
+B< perl 5.9.0 and higher: >
+
+Pseudo-hashes have been removed from Perl as of 5.10.  Consider using
+restricted hashes or fields::new() instead.  Using fields::phash()
+will cause an error.
+
+=back
+
+=head1 SEE ALSO
+
+L<base>
+
+=cut
diff --git a/dist/base/t/base.t b/dist/base/t/base.t
new file mode 100644
index 0000000000..19a2817341
--- /dev/null
+++ b/dist/base/t/base.t
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 11;
+
+use_ok('base');
+
+
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use base qw(No::Version);
+::ok( $No::Version::VERSION =~ /set by base\.pm/,          '$VERSION bug' );
+
+# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
+package Has::Version;
+
+BEGIN { $Has::Version::VERSION = '42' };
+
+package Test::Version2;
+
+use base qw(Has::Version);
+::is( $Has::Version::VERSION, 42 );
+
+package main;
+
+my $eval1 = q{
+  {
+    package Eval1;
+    {
+      package Eval2;
+      use base 'Eval1';
+      $Eval2::VERSION = "1.02";
+    }
+    $Eval1::VERSION = "1.01";
+  }
+};
+
+eval $eval1;
+is( $@, '' );
+
+is( $Eval1::VERSION, 1.01 );
+
+is( $Eval2::VERSION, 1.02 );
+
+
+eval q{use base 'reallyReAlLyNotexists'};
+like( $@, qr/^Base class package "reallyReAlLyNotexists" is empty\./,
+                                          'base with empty package');
+
+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 }
+
+    package Test::Version3;
+
+    use base qw(Has::Version_0);
+    ::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
+}
+
+
+{
+    package Schlozhauer;
+    use constant FIELDS => 6;
+
+    package Basilisco;
+    eval q{ use base 'Schlozhauer' };
+    ::is( $@, '', 'Can coexist with a FIELDS constant' );
+}
diff --git a/dist/base/t/compile-time.t b/dist/base/t/compile-time.t
new file mode 100644
index 0000000000..2be51f9de5
--- /dev/null
+++ b/dist/base/t/compile-time.t
@@ -0,0 +1,42 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More tests => 3;
+
+my $Has_PH = $] < 5.009;
+my $Field = $Has_PH ? "pseudo-hash field" : "class field";
+
+{
+    package Parent;
+    use fields qw(this that);
+    sub new { fields::new(shift) }
+}
+
+{
+    package Child;
+    use base qw(Parent);
+}
+
+my Child $obj = Child->new;
+
+eval q(return; my Child $obj3 = $obj; $obj3->{notthere} = "");
+like $@, 
+    qr/^No such .*field "notthere" in variable \$obj3 of type Child/,
+    "Compile failure of undeclared fields (helem)";
+
+# Slices
+# We should get compile time failures field name typos
+SKIP: {
+    skip("Pseudo-hashes do not support compile-time slice checks", 2)
+        if $Has_PH;
+
+    eval q(return; my Child $obj3 = $obj; my $k; @$obj3{$k,'notthere'} = ());
+    like $@, 
+        qr/^No such .*field "notthere" in variable \$obj3 of type Child/,
+        "Compile failure of undeclared fields (hslice)";
+
+    eval q(return; my Child $obj3 = $obj; my $k; @{$obj3}{$k,'notthere'} = ());
+    like 
+        $@, qr/^No such .*field "notthere" in variable \$obj3 of type Child/,
+        "Compile failure of undeclared fields (hslice (block form))";
+}
diff --git a/dist/base/t/fields-5.6.0.t b/dist/base/t/fields-5.6.0.t
new file mode 100644
index 0000000000..93bca34e2e
--- /dev/null
+++ b/dist/base/t/fields-5.6.0.t
@@ -0,0 +1,228 @@
+# The fields.pm and base.pm regression tests from 5.6.0
+
+# We skip this on 5.9.0 and up since pseudohashes were removed and a lot
+# of it won't work.
+if( $] >= 5.009 ) { 
+    print "1..0 # skip pseudo-hashes removed in 5.9.0\n";
+    exit;
+}
+
+use strict;
+use vars qw($Total_tests);
+
+my $test_num = 1;
+BEGIN { $| = 1; $^W = 1; }
+print "1..$Total_tests\n";
+use fields;
+use base;
+print "ok $test_num\n";
+$test_num++;
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+sub ok {
+    my($test, $name) = @_;
+    print "not " unless $test;
+    print "ok $test_num";
+    print " - $name" if defined $name;
+    print "\n";
+    $test_num++;
+}
+
+sub eqarray  {
+    my($a1, $a2) = @_;
+    return 0 unless @$a1 == @$a2;
+    my $ok = 1;
+    for (0..$#{$a1}) { 
+        unless($a1->[$_] eq $a2->[$_]) {
+            $ok = 0;
+            last;
+        }
+    }
+    return $ok;
+}
+
+# Change this to your # of ok() calls + 1
+BEGIN { $Total_tests = 14 }
+
+
+my $w;
+
+BEGIN {
+   $^W = 1;
+
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+           return;
+       }
+       print $_[0];
+   };
+}
+
+use strict;
+use vars qw($DEBUG);
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { bless [], shift }
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+use base qw(M B2);
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package main;
+
+sub fstr {
+   my $h = shift;
+   my @tmp;
+   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
+	my $v = $h->{$k};
+        push(@tmp, "$k:$v");
+   }
+   my $str = join(",", @tmp);
+   print "$h => $str\n" if $DEBUG;
+   $str;
+}
+
+my %expect;
+BEGIN {
+    %expect = (
+               B1 => "b1:1,b2:2,b3:3",
+               B2 => "_b1:1,b1:2,_b2:3,b2:4",
+               D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
+               D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
+               D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
+               D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
+               D5 => "b1:2,b2:4",
+               'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
+              );
+    $Total_tests += int(keys %expect);
+}
+my $testno = 0;
+while (my($class, $exp) = each %expect) {
+   no strict 'refs';
+   my $fstr = fstr(\%{$class."::FIELDS"});
+   ok( $fstr eq $exp, "'$fstr' eq '$exp'" );
+}
+
+# Did we get the appropriate amount of warnings?
+ok( $w == 1 );
+
+# A simple object creation and AVHV attribute access test
+my B2 $obj1 = D3->new;
+$obj1->{b1} = "B2";
+my D3 $obj2 = $obj1;
+$obj2->{b1} = "D3";
+
+ok( $obj1->[2] eq "B2" && $obj1->[5] eq "D3" );
+
+# We should get compile time failures field name typos
+eval q{ my D3 $obj3 = $obj2; $obj3->{notthere} = "" };
+ok( $@ && $@ =~ /^No such pseudo-hash field "notthere"/,
+                                 'compile error -- field name typos' );
+
+
+# Slices
+if( $] >= 5.006 ) {
+    @$obj1{"_b1", "b1"} = (17, 29);
+    ok( "@$obj1[1,2]" eq "17 29" );
+
+    @$obj1[1,2] = (44,28);
+    ok( "@$obj1{'b1','_b1','b1'}" eq "28 44 28" );
+}
+else {
+    ok( 1, 'test skipped for perl < 5.6.0' );
+    ok( 1, 'test skipped for perl < 5.6.0' );
+}
+
+my $ph = fields::phash(a => 1, b => 2, c => 3);
+ok( fstr($ph) eq 'a:1,b:2,c:3' );
+
+$ph = fields::phash([qw/a b c/], [1, 2, 3]);
+ok( fstr($ph) eq 'a:1,b:2,c:3' );
+
+# The way exists() works with psuedohashes changed from 5.005 to 5.6
+$ph = fields::phash([qw/a b c/], [1]);
+if( $] > 5.006 ) {
+    ok( !( exists $ph->{b} or exists $ph->{c} or !exists $ph->{a} ) );
+}
+else {
+    ok( !( defined $ph->{b} or defined $ph->{c} or !defined $ph->{a} ) );
+}
+
+eval { $ph = fields::phash("odd") };
+ok( $@ && $@ =~ /^Odd number of/ );
+
+
+# check if fields autovivify
+if ( $] > 5.006 ) {
+    package Foo;
+    use fields qw(foo bar);
+    sub new { bless [], $_[0]; }
+
+    package main;
+    my Foo $a = Foo->new();
+    $a->{foo} = ['a', 'ok', 'c'];
+    $a->{bar} = { A => 'ok' };
+    ok( $a->{foo}[1]   eq 'ok' );
+    ok( $a->{bar}->{A} eq 'ok' );
+}
+else {
+    ok( 1, 'test skipped for perl < 5.6.0' );
+    ok( 1, 'test skipped for perl < 5.6.0' );
+}
+
+# check if fields autovivify
+{
+    package Bar;
+    use fields qw(foo bar);
+    sub new { return fields::new($_[0]) }
+
+    package main;
+    my Bar $a = Bar::->new();
+    $a->{foo} = ['a', 'ok', 'c'];
+    $a->{bar} = { A => 'ok' };
+    ok( $a->{foo}[1]   eq 'ok' );
+    ok( $a->{bar}->{A} eq 'ok' );
+}
diff --git a/dist/base/t/fields-5.8.0.t b/dist/base/t/fields-5.8.0.t
new file mode 100644
index 0000000000..2da141274f
--- /dev/null
+++ b/dist/base/t/fields-5.8.0.t
@@ -0,0 +1,254 @@
+#!/usr/bin/perl -w
+
+# We skip this on 5.9.0 and up since pseudohashes were removed and a lot of
+# it won't work.
+if( $] >= 5.009 ) { 
+    print "1..0 # skip pseudo-hashes removed in 5.9.0\n";
+    exit;
+}
+
+
+my $w;
+
+BEGIN {
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+       }
+       else {
+	 print STDERR $_[0];
+       }
+   };
+}
+
+use strict;
+use vars qw($DEBUG);
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { bless [], shift }
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+use base qw(M B2);
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package main;
+
+sub fstr {
+    local $SIG{__WARN__} = sub { 
+        return if $_[0] =~ /^Pseudo-hashes are deprecated/ 
+    };
+
+   my $h = shift;
+   my @tmp;
+   for my $k (sort {$h->{$a} <=> $h->{$b}} keys %$h) {
+	my $v = $h->{$k};
+        push(@tmp, "$k:$v");
+   }
+   my $str = join(",", @tmp);
+   print "$h => $str\n" if $DEBUG;
+   $str;
+}
+
+my %expect = (
+    B1 => "b1:1,b2:2,b3:3",
+    B2 => "_b1:1,b1:2,_b2:3,b2:4",
+    D1 => "b1:1,b2:2,b3:3,d1:4,d2:5,d3:6",
+    D2 => "b1:1,b2:2,b3:3,_d1:4,_d2:5,d1:6,d2:7",
+    D3 => "b2:4,b1:5,d1:6,_b1:7,_d1:8",
+    D4 => "b2:4,b1:5,d1:6,_d3:9,d3:10",
+    D5 => "b1:2,b2:4",
+    'Foo::Bar::Baz' => 'b1:1,b2:2,b3:3,foo:4,bar:5,baz:6',
+);
+
+print "1..", int(keys %expect)+21, "\n";
+my $testno = 0;
+while (my($class, $exp) = each %expect) {
+   no strict 'refs';
+   my $fstr = fstr(\%{$class."::FIELDS"});
+   print "EXP: $exp\nGOT: $fstr\nnot " unless $fstr eq $exp;
+   print "ok ", ++$testno, "\n";
+}
+
+# Did we get the appropriate amount of warnings?
+print "not " unless $w == 1;
+print "ok ", ++$testno, "\n";
+
+# A simple object creation and AVHV attribute access test
+my B2 $obj1 = D3->new;
+$obj1->{b1} = "B2";
+my D3 $obj2 = $obj1;
+$obj2->{b1} = "D3";
+
+print "not " unless $obj1->[2] eq "B2" && $obj1->[5] eq "D3";
+print "ok ", ++$testno, "\n";
+
+# We should get compile time failures field name typos
+eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
+print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/;
+print "ok ", ++$testno, "\n";
+
+# Slices
+@$obj1{"_b1", "b1"} = (17, 29);
+print "not " unless "@$obj1[1,2]" eq "17 29";
+print "ok ", ++$testno, "\n";
+@$obj1[1,2] = (44,28);
+print "not " unless "@$obj1{'b1','_b1','b1'}" eq "28 44 28";
+print "ok ", ++$testno, "\n";
+
+{
+    local $SIG{__WARN__} = sub { 
+        return if $_[0] =~ /^Pseudo-hashes are deprecated/ 
+    };
+
+    my $ph = fields::phash(a => 1, b => 2, c => 3);
+    print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+    print "ok ", ++$testno, "\n";
+
+    $ph = fields::phash([qw/a b c/], [1, 2, 3]);
+    print "not " unless fstr($ph) eq 'a:1,b:2,c:3';
+    print "ok ", ++$testno, "\n";
+
+    $ph = fields::phash([qw/a b c/], [1]);
+    print "not " if exists $ph->{b} or exists $ph->{c} or !exists $ph->{a};
+    print "ok ", ++$testno, "\n";
+
+    eval '$ph = fields::phash("odd")';
+    print "not " unless $@ && $@ =~ /^Odd number of/;
+    print "ok ", ++$testno, "\n";
+}
+
+#fields::_dump();
+
+# check if fields autovivify
+{
+    package Foo;
+    use fields qw(foo bar);
+    sub new { bless [], $_[0]; }
+
+    package main;
+    my Foo $a = Foo->new();
+    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+    $a->{bar} = { A => 'ok ' . ++$testno };
+    print $a->{foo}[1], "\n";
+    print $a->{bar}->{A}, "\n";
+}
+
+# check if fields autovivify
+{
+    package Bar;
+    use fields qw(foo bar);
+    sub new { return fields::new($_[0]) }
+
+    package main;
+    my Bar $a = Bar::->new();
+    $a->{foo} = ['a', 'ok ' . ++$testno, 'c'];
+    $a->{bar} = { A => 'ok ' . ++$testno };
+    print $a->{foo}[1], "\n";
+    print $a->{bar}->{A}, "\n";
+}
+
+
+# Test $VERSION bug
+package No::Version;
+
+use vars qw($Foo);
+sub VERSION { 42 }
+
+package Test::Version;
+
+use base qw(No::Version);
+print "# $No::Version::VERSION\nnot " unless $No::Version::VERSION =~ /set by base\.pm/;
+print "ok ", ++$testno ,"\n";
+
+# Test Inverse of $VERSION bug base.pm should not clobber existing $VERSION
+package Has::Version;
+
+BEGIN { $Has::Version::VERSION = '42' };
+
+package Test::Version2;
+
+use base qw(Has::Version);
+print "#$Has::Version::VERSION\nnot " unless $Has::Version::VERSION eq '42';
+print "ok ", ++$testno ," # Has::Version\n";
+
+package main;
+
+my $eval1 = q{
+  {
+    package Eval1;
+    {
+      package Eval2;
+      use base 'Eval1';
+      $Eval2::VERSION = "1.02";
+    }
+    $Eval1::VERSION = "1.01";
+  }
+};
+
+eval $eval1;
+printf "# %s\nnot ", $@ if $@;
+print "ok ", ++$testno ," # eval1\n";
+
+print "# $Eval1::VERSION\nnot " unless $Eval1::VERSION == 1.01;
+print "ok ", ++$testno ," # Eval1::VERSION\n";
+
+print "# $Eval2::VERSION\nnot " unless $Eval2::VERSION == 1.02;
+print "ok ", ++$testno ," # Eval2::VERSION\n";
+
+
+eval q{use base reallyReAlLyNotexists;};
+print "not " unless $@;
+print "ok ", ++$testno, " # really not I\n";
+
+eval q{use base reallyReAlLyNotexists;};
+print "not " unless $@;
+print "ok ", ++$testno, " # really not II\n";
+
+BEGIN { $Has::Version_0::VERSION = 0 }
+
+package Test::Version3;
+
+use base qw(Has::Version_0);
+print "#$Has::Version_0::VERSION\nnot " unless $Has::Version_0::VERSION == 0;
+print "ok ", ++$testno ," # Version_0\n";
+
diff --git a/dist/base/t/fields-base.t b/dist/base/t/fields-base.t
new file mode 100644
index 0000000000..500486bf86
--- /dev/null
+++ b/dist/base/t/fields-base.t
@@ -0,0 +1,285 @@
+#!/usr/bin/perl -w
+
+my ($Has_PH, $Field);
+BEGIN { 
+    $Has_PH = $] < 5.009;
+    $Field = $Has_PH ? "pseudo-hash field" : "class field";
+}
+
+my $W;
+
+BEGIN {
+    $W = 0;
+    $SIG{__WARN__} = sub {
+        if ($_[0] =~ /^Hides field '.*?' in base class/) {
+            $W++;
+        }
+        else {
+            warn $_[0];
+        }
+    };
+}
+
+use strict;
+use Test::More tests => 29;
+
+BEGIN { use_ok('base'); }
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { fields::new(shift) }
+
+package B3;
+use fields qw(b4 _b5 b6 _b7);
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+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');
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+# Test repeatability for when modules get reloaded.
+package B1;
+use fields qw(b1 b2 b3);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+
+# Test that a package with only private fields gets inherited properly
+package B7;
+use fields qw(_b1);
+
+package D7;
+use base qw(B7);
+use fields qw(b1);
+
+
+# Test that an intermediate package with no fields doesn't cause a problem.
+package B8;
+use fields qw(_b1);
+
+package D8;
+use base qw(B8);
+
+package D8A;
+use base qw(D8);
+use fields qw(b1);
+
+
+package main;
+
+my %EXPECT = (
+              B1 => [qw(b1 b2 b3)],
+              D1 => [qw(b1 b2 b3 d1 d2 d3)],
+              D2 => [qw(b1 b2 b3 _d1 _d2 d1 d2)],
+
+              M  => [qw()],
+              B2 => [qw(_b1 b1 _b2 b2)],
+              D3 => [(undef,undef,undef,
+                                qw(b2 b1 d1 _b1 _d1))],     # b1 is hidden
+              D4 => [(undef,undef,undef,
+                                qw(b2 b1 d1),undef,undef,qw(_d3 d3))],
+
+              D5 => [undef, 'b1', undef, 'b2'],
+
+              B3 => [qw(b4 _b5 b6 _b7)],
+
+              B7 => [qw(_b1)],
+              D7 => [undef, 'b1'],
+
+              B8  => [qw(_b1)],
+              D8  => [undef],
+              D8A => [undef, 'b1'],
+
+              'Foo::Bar'        => [qw(b1 b2 b3)],
+              'Foo::Bar::Baz'   => [qw(b1 b2 b3 foo bar baz)],
+             );
+
+while(my($class, $efields) = each %EXPECT) {
+    no strict 'refs';
+    my %fields = %{$class.'::FIELDS'};
+    my %expected_fields;
+    foreach my $idx (1..@$efields) {
+        my $key = $efields->[$idx-1];
+        next unless $key;
+        $expected_fields{$key} = $idx;
+    }
+
+    ::is_deeply(\%fields, \%expected_fields, "%FIELDS check:  $class");
+}
+
+# Did we get the appropriate amount of warnings?
+is( $W, 1, 'right warnings' );
+
+
+# A simple object creation and attribute access test
+my B2 $obj1 = D3->new;
+$obj1->{b1} = "B2";
+my D3 $obj2 = $obj1;
+$obj2->{b1} = "D3";
+
+# We should get compile time failures field name typos
+eval q(return; my D3 $obj3 = $obj2; $obj3->{notthere} = "");
+like $@, 
+    qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+    "Compile failure of undeclared fields (helem)";
+
+SKIP: {
+    # Slices
+    # We should get compile time failures field name typos
+    skip "Doesn't work before 5.9", 2 if $] < 5.009;
+    eval q(return; my D3 $obj3 = $obj2; my $k; @$obj3{$k,'notthere'} = ());
+    like $@, 
+	qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+	"Compile failure of undeclared fields (hslice)";
+    eval q(return; my D3 $obj3 = $obj2; my $k; @{$obj3}{$k,'notthere'} = ());
+    like 
+	$@, qr/^No such $Field "notthere" in variable \$obj3 of type D3/,
+	"Compile failure of undeclared fields (hslice (block form))";
+}
+
+@$obj1{"_b1", "b1"} = (17, 29);
+is( $obj1->{_b1}, 17 );
+is( $obj1->{b1},  29 );
+
+@$obj1{'_b1', 'b1'} = (44,28);
+is( $obj1->{_b1}, 44 );
+is( $obj1->{b1},  28 );
+
+
+
+# Break multiple inheritance with a field name clash.
+package E1;
+use fields qw(yo this _lah meep 42);
+
+package E2;
+use fields qw(_yo ahhh this);
+
+eval {
+    package Broken;
+
+    # The error must occur at run time for the eval to catch it.
+    require base;
+    'base'->import(qw(E1 E2));
+};
+::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
+# fields, and that pseudohash messages don't show up
+
+package B9;
+use fields qw(b1);
+
+sub _mk_obj { fields::new($_[0])->{'b1'} };
+
+package D9;
+use base qw(B9);
+
+package main;
+
+{
+    my $w = 0;
+    local $SIG{__WARN__} = sub { $w++ };
+    
+    B9->_mk_obj();
+    # used tp emit a warning that pseudohashes are deprecated, because
+    # %FIELDS wasn't blessed.
+    D9->_mk_obj();
+    
+    is ($w, 0, "pseudohash warnings in derived class with no fields of it's own");	
+}
+
+# [perl #31078] an intermediate class with no additional fields caused
+# hidden fields in base class to get stomped on
+
+{
+    package X;
+    use fields qw(X1 _X2);
+    sub new {
+	my X $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->{X1} = "x1";
+	# FIXME. This code is dead on blead becase the test is skipped.
+	# The test states that it's being skipped because restricted hashes
+	# don't support a feature. Presumably we need to make that feature
+	# supported. Bah.
+	# use Devel::Peek; Dump($self);
+	$self->{_X2} = "_x2";
+	return $self;
+    }
+    sub get_X2 { my X $self = shift; $self->{_X2} }
+
+    package Y;
+    use base qw(X);
+
+    sub new {
+	my Y $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->SUPER::new();
+	return $self;
+    }
+
+
+    package Z;
+    use base qw(Y);
+    use fields qw(Z1);
+
+    sub new {
+	my Z $self = shift;
+	$self = fields::new($self) unless ref $self;
+	$self->SUPER::new();
+	$self->{Z1} = 'z1';
+	return $self;
+    }
+
+    package main;
+
+    if ($Has_PH) {
+	my Z $c = Z->new();
+	is($c->get_X2, '_x2', "empty intermediate class");
+    }
+    else {
+	SKIP: {
+	    skip "restricted hashes don't support private fields properly", 1;
+	}
+    }
+}
diff --git a/dist/base/t/fields.t b/dist/base/t/fields.t
new file mode 100644
index 0000000000..4999cfed14
--- /dev/null
+++ b/dist/base/t/fields.t
@@ -0,0 +1,109 @@
+#!/usr/bin/perl -w
+
+my $Has_PH;
+BEGIN {
+    $Has_PH = $] < 5.009;
+}
+
+use strict;
+use Test::More tests => 16;
+
+BEGIN { use_ok('fields'); }
+
+
+package Foo;
+
+use fields qw(_no Pants who _up_yours);
+use fields qw(what);
+
+sub new { fields::new(shift) }
+sub magic_new { bless [] }  # Doesn't 100% work, perl's problem.
+
+package main;
+
+is_deeply( [sort keys %Foo::FIELDS], 
+           [sort qw(_no Pants who _up_yours what)]
+);
+
+sub show_fields {
+    my($base, $mask) = @_;
+    no strict 'refs';
+    my $fields = \%{$base.'::FIELDS'};
+    return grep { ($fields::attr{$base}[$fields->{$_}] & $mask) == $mask} 
+                keys %$fields;
+}
+
+is_deeply( [sort &show_fields('Foo', fields::PUBLIC)],
+           [sort qw(Pants who what)]);
+is_deeply( [sort &show_fields('Foo', fields::PRIVATE)],
+           [sort qw(_no _up_yours)]);
+
+# We should get compile time failures field name typos
+eval q(my Foo $obj = Foo->new; $obj->{notthere} = "");
+
+like $@, qr/^No such .*field "notthere"/i;
+
+
+foreach (Foo->new) {
+    my Foo $obj = $_;
+    my %test = ( Pants => 'Whatever', _no => 'Yeah',
+                 what  => 'Ahh',      who => 'Moo',
+                 _up_yours => 'Yip' );
+
+    $obj->{Pants} = 'Whatever';
+    $obj->{_no}   = 'Yeah';
+    @{$obj}{qw(what who _up_yours)} = ('Ahh', 'Moo', 'Yip');
+
+    while(my($k,$v) = each %test) {
+        is($obj->{$k}, $v);
+    }
+}
+
+{
+    local $SIG{__WARN__} = sub {
+        return if $_[0] =~ /^Pseudo-hashes are deprecated/ 
+    };
+    my $phash;
+    eval { $phash = fields::phash(name => "Joe", rank => "Captain") };
+    if( $Has_PH ) {
+        is( $phash->{rank}, "Captain" );
+    }
+    else {
+        like $@, qr/^Pseudo-hashes have been removed from Perl/;
+    }
+}
+
+
+# check if fields autovivify
+{
+    package Foo::Autoviv;
+    use fields qw(foo bar);
+    sub new { fields::new($_[0]) }
+
+    package main;
+    my Foo::Autoviv $a = Foo::Autoviv->new();
+    $a->{foo} = ['a', 'ok', 'c'];
+    $a->{bar} = { A => 'ok' };
+    is( $a->{foo}[1],    'ok' );
+    is( $a->{bar}->{A},, 'ok' );
+}
+
+package Test::FooBar;
+
+use fields qw(a b c);
+
+sub new {
+    my $self = fields::new(shift);
+    %$self = @_ if @_;
+    $self;
+}
+
+package main;
+
+{
+    my $x = Test::FooBar->new( a => 1, b => 2);
+
+    is(ref $x, 'Test::FooBar', 'x is a Test::FooBar');
+    ok(exists $x->{a}, 'x has a');
+    ok(exists $x->{b}, 'x has b');
+}
diff --git a/dist/base/t/isa.t b/dist/base/t/isa.t
new file mode 100644
index 0000000000..bd5ee7fc3c
--- /dev/null
+++ b/dist/base/t/isa.t
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+
+# Regression test some quirky behavior of base.pm.
+
+use strict;
+use Test::More tests => 1;
+
+{
+    package Parent;
+
+    sub foo { 42 }
+
+    package Middle;
+
+    use base qw(Parent);
+
+    package Child;
+
+    base->import(qw(Middle Parent));
+}
+
+is_deeply [@Child::ISA], [qw(Middle)],
+          'base.pm will not add to @ISA if you already are-a';
diff --git a/dist/base/t/lib/Dummy.pm b/dist/base/t/lib/Dummy.pm
new file mode 100644
index 0000000000..504330f8b1
--- /dev/null
+++ b/dist/base/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/dist/base/t/lib/HasSigDie.pm b/dist/base/t/lib/HasSigDie.pm
new file mode 100644
index 0000000000..3368e04995
--- /dev/null
+++ b/dist/base/t/lib/HasSigDie.pm
@@ -0,0 +1,6 @@
+package HasSigDie;
+
+$SIG{__DIE__} = sub { "Die, Bart, Die!" };
+
+1;
+
diff --git a/dist/base/t/sigdie.t b/dist/base/t/sigdie.t
new file mode 100644
index 0000000000..eba75aecc4
--- /dev/null
+++ b/dist/base/t/sigdie.t
@@ -0,0 +1,29 @@
+#!/usr/bin/perl -w
+
+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/dist/base/t/version.t b/dist/base/t/version.t
new file mode 100644
index 0000000000..73d15e6b3f
--- /dev/null
+++ b/dist/base/t/version.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl -w
+
+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/dist/base/t/warnings.t b/dist/base/t/warnings.t
new file mode 100644
index 0000000000..51e91741ea
--- /dev/null
+++ b/dist/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';