Ouch. Upgrading to base 2.0 made the threads tests very unhappy

both in blead and maint, lots of "Attempt to free non-existent
shared string" and "Unbalanced string table refcount" errors.
Retract #20960 (and #20963).

p4raw-id: //depot/perl@20965

6 files changed, 0 insertions, 1235 deletions

diff --git a/lib/base/t/base.t b/lib/base/t/base.t
deleted file mode 100644
index 1e4d413df6..0000000000
--- a/lib/base/t/base.t
+++ /dev/null
@@ -1,183 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-use strict;
-
-use vars qw($Total_tests);
-
-my $loaded;
-my $test_num = 1;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
-use base;
-$loaded = 1;
-print "ok $test_num - Compiled\n";
-$test_num++;
-######################### End of black magic.
-
-# 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 = 17 }
-
-use vars qw( $W );
-BEGIN {
-    $W = 0;
-    $SIG{__WARN__} = sub {
-        if ($_[0] =~ /^Hides field '.*?' in base class/) {
-            $W++;
-        }
-        else {
-            warn $_[0];
-        }
-    };
-}
-
-package B1;
-use fields qw(b1 b2 b3);
-
-package B2;
-use fields '_b1';
-use fields qw(b1 _b2 b2);
-
-sub new { bless [], 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));
-};
-::ok($@ =~ /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);
-
-package main;
-
-my %EXPECT = (
-              B1 => [qw(b1 b2 b3)],
-              B2 => [qw(_b1 b1 _b2 b2)],
-              B3 => [qw(b4 _b5 b6 _b7)],
-              D1 => [qw(d1 d2 d3 b1 b2 b3)],
-              D2 => [qw(b1 b2 b3 _d1 _d2 d1 d2)],
-              D3 => [qw(b1 b2 d1 _b1 _d1)],
-              D4 => [qw(b1 b2 d1 _d3 d3)],
-              M  => [qw()],
-              D5 => [qw(b1 b2)],
-              '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 = keys %{$class.'::FIELDS'};
-    
-    ::ok( eqarray([sort @$efields], [sort @fields]), 
-                                                  "%FIELDS check:  $class" );
-}
-
-# Did we get the appropriate amount of warnings?
-::ok($W == 1, 'got the right warnings');
-
-
-# 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));
-};
-::ok( $@ && $@ =~ /Can't multiply inherit %FIELDS/i,
-                                               'Again, no multi inherit' );
-
-
-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' );
-
-
-package Test::SIGDIE;
-
-{ 
-    local $SIG{__DIE__} = sub { 
-        ::ok(0, 'sigdie not caught, this test should not run') 
-    };
-    eval {
-      'base'->import(qw(Huh::Boo));
-    };
-
-    ::ok($@ =~ /^Base class package "Huh::Boo" is empty./, 
-         'Base class empty error message');
-
-}
diff --git a/lib/base/t/fb18784.t b/lib/base/t/fb18784.t
deleted file mode 100644
index 03b1ab7442..0000000000
--- a/lib/base/t/fb18784.t
+++ /dev/null
@@ -1,222 +0,0 @@
-#!./perl -w
-
-# This is bleadperl's fields.t test at 18784
-
-# We skip this on anything older than 5.9.0 since some semantics changed
-# when pseudo-hashes were removed.
-if( $] < 5.009 ) {
-    print "1..0 # skip fields.pm changed to restricted hashes in 5.9.0\n";
-    exit;
-}
-
-my $w;
-
-BEGIN {
-   $SIG{__WARN__} = sub {
-       if ($_[0] =~ /^Hides field 'b1' in base class/) {
-           $w++;
-           return;
-       }
-       print STDERR $_[0];
-   };
-}
-
-use strict;
-use warnings;
-use vars qw($DEBUG);
-
-use Test::More;
-
-
-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 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 = (
-    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',
-);
-
-plan tests => keys(%expect) + 17;
-my $testno = 0;
-while (my($class, $exp) = each %expect) {
-   no strict 'refs';
-   my $fstr = fstr(\%{$class."::FIELDS"});
-   is( $fstr, $exp, "\%FIELDS check for $class" );
-}
-
-# Did we get the appropriate amount of warnings?
-is( $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";
-
-# We should get compile time failures field name typos
-eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-like $@, qr/^Attempt to access disallowed key 'notthere' in a restricted hash/;
-
-# Slices
-@$obj1{"_b1", "b1"} = (17, 29);
-is_deeply($obj1, { b1 => 29, _b1 => 17 });
-
-@$obj1{'_b1', 'b1'} = (44,28);
-is_deeply($obj1, { b1 => 28, _b1 => 44 });
-
-eval { fields::phash };
-like $@, qr/^Pseudo-hashes have been removed from Perl/;
-
-#fields::_dump();
-
-# check if fields autovivify
-{
-    package Foo;
-    use fields qw(foo bar);
-    sub new { fields::new($_[0]) }
-
-    package main;
-    my Foo $a = Foo->new();
-    $a->{foo} = ['a', 'ok', 'c'];
-    $a->{bar} = { A => 'ok' };
-    is( $a->{foo}[1],    'ok' );
-    is( $a->{bar}->{A},, 'ok' );
-}
-
-# 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' };
-    is( $a->{foo}[1], 'ok' );
-    is( $a->{bar}->{A}, 'ok' );
-}
-
-
-# Test $VERSION bug
-package No::Version;
-
-use vars qw($Foo);
-sub VERSION { 42 }
-
-package Test::Version;
-
-use base qw(No::Version);
-::like( $No::Version::VERSION, qr/set by base.pm/ );
-
-# 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;
-
-our $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');
-
-BEGIN { $Has::Version_0::VERSION = 0 }
-
-package Test::Version3;
-
-use base qw(Has::Version_0);
-::is( $Has::Version_0::VERSION, 0, '$VERSION==0 preserved' );
-
diff --git a/lib/base/t/fb20922.t b/lib/base/t/fb20922.t
deleted file mode 100644
index 2a09b72ec6..0000000000
--- a/lib/base/t/fb20922.t
+++ /dev/null
@@ -1,246 +0,0 @@
-#!./perl -w
-
-# This is bleadperl's fields.t test @20100.
-
-# We skip this on anything older than 5.9.0 since some semantics changed
-# when pseudo-hashes were removed.
-if( $] < 5.009 ) {
-    print "1..0 # skip fields.pm changed to restricted hashes in 5.9.0\n";
-    exit;
-}
-
-my $w;
-
-BEGIN {
-   $SIG{__WARN__} = sub {
-       if ($_[0] =~ /^Hides field 'b1' in base class/) {
-           $w++;
-           return;
-       }
-       print STDERR $_[0];
-   };
-}
-
-use strict;
-use warnings;
-use vars qw($DEBUG);
-
-use Test::More;
-
-
-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 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 = (
-    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',
-);
-
-plan tests => keys(%expect) + 21;
-
-my $testno = 0;
-
-while (my($class, $exp) = each %expect) {
-   no strict 'refs';
-   my $fstr = fstr(\%{$class."::FIELDS"});
-   is( $fstr, $exp, "\%FIELDS check for $class" );
-}
-
-# Did we get the appropriate amount of warnings?
-is( $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";
-
-# We should get compile time failures field name typos
-eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = "");
-like $@, qr/^Attempt to access disallowed key 'notthere' in a restricted hash/;
-
-# Slices
-@$obj1{"_b1", "b1"} = (17, 29);
-is_deeply($obj1, { b1 => 29, _b1 => 17 });
-
-@$obj1{'_b1', 'b1'} = (44,28);
-is_deeply($obj1, { b1 => 28, _b1 => 44 });
-
-eval { fields::phash };
-like $@, qr/^Pseudo-hashes have been removed from Perl/;
-
-#fields::_dump();
-
-# check if fields autovivify
-{
-    package Foo;
-    use fields qw(foo bar);
-    sub new { fields::new($_[0]) }
-
-    package main;
-    my Foo $a = Foo->new();
-    $a->{foo} = ['a', 'ok', 'c'];
-    $a->{bar} = { A => 'ok' };
-    is( $a->{foo}[1],    'ok' );
-    is( $a->{bar}->{A},, 'ok' );
-}
-
-# 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' };
-    is( $a->{foo}[1], 'ok' );
-    is( $a->{bar}->{A}, 'ok' );
-}
-
-
-# Test $VERSION bug
-package No::Version;
-
-use vars qw($Foo);
-sub VERSION { 42 }
-
-package Test::Version;
-
-use base qw(No::Version);
-::like( $No::Version::VERSION, qr/set by base.pm/ );
-
-# 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;
-
-our $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');
-
-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 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');
-    is(scalar keys %$x, 2, 'x has two fields');
-}
-
-
diff --git a/lib/base/t/fields.t b/lib/base/t/fields.t
deleted file mode 100644
index 1deb602ae5..0000000000
--- a/lib/base/t/fields.t
+++ /dev/null
@@ -1,105 +0,0 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-my $Has_PH = $] < 5.009;
-
-$SIG{__WARN__} = sub { return if $_[0] =~ /^Pseudo-hashes are deprecated/ };
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-use strict;
-
-use vars qw($Total_tests);
-
-my $loaded;
-my $test_num = 1;
-BEGIN { $| = 1; $^W = 1; }
-END {print "not ok $test_num\n" unless $loaded;}
-print "1..$Total_tests\n";
-use fields;
-$loaded = 1;
-print "ok $test_num\n";
-$test_num++;
-######################### End of black magic.
-
-# 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 = 10 }
-
-
-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;
-
-ok( eqarray( [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;
-}
-
-ok( eqarray( [sort &show_fields('Foo', fields::PUBLIC)],
-             [sort qw(Pants who what)]) );
-ok( eqarray( [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} = "");
-
-my $error = $Has_PH ? 'No such(?: [\w-]+)? field "notthere"'
-                    : q[Attempt to access disallowed key 'notthere' in a ].
-                      q[restricted hash at ];
-ok( $@ && $@ =~ /^$error/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) {
-        ok($obj->{$k} eq $v);
-    }
-}
diff --git a/lib/base/t/fp560.t b/lib/base/t/fp560.t
deleted file mode 100644
index a068090dcc..0000000000
--- a/lib/base/t/fp560.t
+++ /dev/null
@@ -1,233 +0,0 @@
-# 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;
-       }
-       if ($_[0] =~ /^Pseudo-hashes are deprecated/ &&
-	   ($] >= 5.008 && $] < 5.009)) {
-	   print "# $_[0]"; # Yes, we know they are deprecated.
-	   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/lib/base/t/fp580.t b/lib/base/t/fp580.t
deleted file mode 100644
index c25e04158e..0000000000
--- a/lib/base/t/fp580.t
+++ /dev/null
@@ -1,246 +0,0 @@
-#!/usr/bin/perl -w
-
-$SIG{__WARN__} = sub { return if $_[0] =~ /^Pseudo-hashes are deprecated/ };
-
-# 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 {
-   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";
-
-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;
-
-our $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";
-