The Grand Trek: move the *.t files from t/ to lib/ and ext/.

No doubt I made some mistakes like missed some files or
misnamed some files.  The naming rules were more or less:
(1) if the module is from CPAN, follows its ways, be it
    t/*.t or test.pl.
(2) otherwise if there are multiple tests for a module
    put them in a t/
(3) otherwise if there's only one test put it in Module.t
(4) helper files go to module/ (locale, strict, warnings)
(5) use longer filenames now that we can (but e.g. the
    compat-0.6.t and the Text::Balanced test files still
    were renamed to be more civil against the 8.3 people)
installperl was updated appropriately not to install the
*.t files or the help files from under lib.

TODO: some helper files still remain under t/ that could
follow their 'masters'.  UPDATE: On second thoughts, why
should they.  They can continue to live under t/lib, and
in fact the locale/strict/warnings helpers that were moved
could be moved back.  This way the amount of non-installable
stuff under lib/ stays smaller.

p4raw-id: //depot/perl@10676

167 files changed, 26370 insertions, 1 deletions

diff --git a/lib/AnyDBM_File.t b/lib/AnyDBM_File.t
new file mode 100755
index 0000000000..30b3c7ac14
--- /dev/null
+++ b/lib/AnyDBM_File.t
@@ -0,0 +1,155 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
+      print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n";
+      exit 0;
+    }
+}
+require AnyDBM_File;
+use Fcntl;
+
+print "1..12\n";
+
+$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' or $^O eq 'dos' or
+	      $^O eq 'os2' or $^O eq 'mint');
+
+unlink <Op_dbmx*>;
+
+umask(0);
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640)
+       ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op_dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op_dbmx*>;
+}
+if ($Is_Dosish || $^O eq 'MacOS') {
+    print "ok 2 # Skipped: different file permission semantics\n";
+}
+else {
+    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+     $blksize,$blocks) = stat($Dfile);
+    print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+}
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3 # i=$i\n\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+untie(%h);
+print (tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+$h{'foo'} = '';
+$h{''} = 'bar';
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
+
+print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
+if ($h{''} eq 'bar') {
+   print "ok 12\n" ;
+}
+else {
+   if ($AnyDBM_File::ISA[0] eq 'DB_File' && $DB_File::db_ver >= 2.004010) {
+     ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ;
+     $major =~ s/^0+// ;
+     $minor =~ s/^0+// ;
+     $patch =~ s/^0+// ;
+     $compact = "$major.$minor.$patch" ;
+     #
+     # anydbm.t test 12 will fail when AnyDBM_File uses the combination of
+     # DB_File and Berkeley DB 2.4.10 (or greater). 
+     # You are using DB_File $DB_File::VERSION and Berkeley DB $compact
+     #
+     # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys.
+     # This feature will be reenabled in a future version of Berkeley DB.
+     #
+     print "ok 12 # skipped: db v$compact, no null key support\n" ;
+   }
+   else {
+     print "not ok 12\n" ;
+   }
+}
+
+untie %h;
+if ($^O eq 'VMS') {
+  unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+  unlink 'Op_dbmx.dir', $Dfile;  
+}
diff --git a/lib/Attribute/Handlers.t b/lib/Attribute/Handlers.t
new file mode 100644
index 0000000000..5056fa833f
--- /dev/null
+++ b/lib/Attribute/Handlers.t
@@ -0,0 +1,130 @@
+# 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.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+END {print "not ok 1\n" unless $loaded;}
+use v5.6.0;
+use Attribute::Handlers;
+$loaded = 1;
+
+######################### 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 { $::count++; push @::results, [$_[1], $_[0]?"":"not "]; }
+
+END { print "1..$::count\n";
+      print map "$_->[1]ok $_->[0]\n", sort {$a->[0]<=>$b->[0]} @::results }
+
+package Test;
+use warnings;
+no warnings 'redefine';
+
+sub UNIVERSAL::Okay :ATTR { ::ok @{$_[4]} }
+
+sub Dokay :ATTR(SCALAR) { ::ok @{$_[4]} }
+sub Dokay :ATTR(HASH)   { ::ok @{$_[4]} }
+sub Dokay :ATTR(ARRAY)  { ::ok @{$_[4]} }
+sub Dokay :ATTR(CODE)   { ::ok @{$_[4]} }
+
+sub Vokay :ATTR(VAR)    { ::ok @{$_[4]} }
+
+sub Aokay :ATTR(ANY)    { ::ok @{$_[4]} }
+
+package main;
+use warnings;
+
+my $x1 :Okay(1,1);
+my @x1 :Okay(1=>2);
+my %x1 :Okay(1,3);
+sub x1 :Okay(1,4) {}
+
+my Test $x2 :Dokay(1,5);
+
+package Test;
+my $x3 :Dokay(1,6);
+my Test $x4 :Dokay(1,7);
+sub x3 :Dokay(1,8) {}
+
+my $y1 :Okay(1,9);
+my @y1 :Okay(1,10);
+my %y1 :Okay(1,11);
+sub y1 :Okay(1,12) {}
+
+my $y2 :Vokay(1,13);
+my @y2 :Vokay(1,14);
+my %y2 :Vokay(1,15);
+# BEGIN {eval 'sub y2 :Vokay(0,16) {}; 1' or
+::ok(1,16);
+# }
+
+my $z :Aokay(1,17);
+my @z :Aokay(1,18);
+my %z :Aokay(1,19);
+sub z :Aokay(1,20) {};
+
+package DerTest;
+use base 'Test';
+use warnings;
+
+my $x5 :Dokay(1,21);
+my Test $x6 :Dokay(1,22);
+sub x5 :Dokay(1,23);
+
+my $y3 :Okay(1,24);
+my @y3 :Okay(1,25);
+my %y3 :Okay(1,26);
+sub y3 :Okay(1,27) {}
+
+package Unrelated;
+
+BEGIN { eval 'my $x7 :Dokay(0,28)' or ::ok(1,28); }
+my Test $x8 :Dokay(1,29);
+eval 'sub x7 :Dokay(0,30) {}' or ::ok(1,30);
+
+
+package Tie::Loud;
+
+sub TIESCALAR { ::ok(1,31); bless {}, $_[0] }
+sub FETCH { ::ok(1,32); return 1 }
+sub STORE { ::ok(1,33); return 1 }
+
+package Tie::Noisy;
+
+sub TIEARRAY { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,35); return 1 }
+sub STORE { ::ok(1,36); return 1 }
+sub FETCHSIZE { 100 }
+
+package Tie::Rowdy;
+
+sub TIEHASH { ::ok(1,$_[1]); bless {}, $_[0] }
+sub FETCH { ::ok(1,38); return 1 }
+sub STORE { ::ok(1,39); return 1 }
+
+package main;
+
+use Attribute::Handlers autotie => {      Other::Loud => Tie::Loud,
+				                Noisy => Tie::Noisy,
+				     UNIVERSAL::Rowdy => Tie::Rowdy,
+                                   };
+
+my Other $loud : Loud;
+$loud++;
+
+my @noisy : Noisy(34);
+$noisy[0]++;
+
+my %rowdy : Rowdy(37);
+$rowdy{key}++;
diff --git a/lib/AutoLoader.t b/lib/AutoLoader.t
new file mode 100755
index 0000000000..f2fae7f309
--- /dev/null
+++ b/lib/AutoLoader.t
@@ -0,0 +1,128 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') {
+	$dir = ":auto-$$";
+	$sep = ":";
+    } else {
+	$dir = "auto-$$";
+	$sep = "/";
+    }
+    @INC = $dir;
+    push @INC, '../lib';
+}
+
+print "1..11\n";
+
+# First we must set up some autoloader files
+mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+mkdir "$dir${sep}auto", 0755     or die "Can't mkdir: $!";
+mkdir "$dir${sep}auto${sep}Foo", 0755 or die "Can't mkdir: $!";
+
+open(FOO, ">$dir${sep}auto${sep}Foo${sep}foo.al") or die;
+print FOO <<'EOT';
+package Foo;
+sub foo { shift; shift || "foo" }
+1;
+EOT
+close(FOO);
+
+open(BAR, ">$dir${sep}auto${sep}Foo${sep}bar.al") or die;
+print BAR <<'EOT';
+package Foo;
+sub bar { shift; shift || "bar" }
+1;
+EOT
+close(BAR);
+
+open(BAZ, ">$dir${sep}auto${sep}Foo${sep}bazmarkhian.al") or die;
+print BAZ <<'EOT';
+package Foo;
+sub bazmarkhianish { shift; shift || "baz" }
+1;
+EOT
+close(BAZ);
+
+# Let's define the package
+package Foo;
+require AutoLoader;
+@ISA=qw(AutoLoader);
+
+sub new { bless {}, shift };
+
+package main;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo';  # autoloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo';  # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+    $foo->will_fail;
+};
+print "not " unless $@ =~ /^Can't locate/;
+print "ok 3\n";
+
+# Used to be trouble with this
+eval {
+    my $foo = new Foo;
+    die "oops";
+};
+print "not " unless $@ =~ /oops/;
+print "ok 4\n";
+
+# Pass regular expression variable to autoloaded function.  This used
+# to go wrong because AutoLoader used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# test recursive autoloads
+open(F, ">$dir${sep}auto${sep}Foo${sep}a.al") or die;
+print F <<'EOT';
+package Foo;
+BEGIN { b() }
+sub a { print "ok 11\n"; }
+1;
+EOT
+close(F);
+
+open(F, ">$dir${sep}auto${sep}Foo${sep}b.al") or die;
+print F <<'EOT';
+package Foo;
+sub b { print "ok 10\n"; }
+1;
+EOT
+close(F);
+Foo::a();
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}auto${sep}Foo${sep}foo.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bar.al";
+unlink "$dir${sep}auto${sep}Foo${sep}bazmarkhian.al";
+unlink "$dir${sep}auto${sep}Foo${sep}a.al";
+unlink "$dir${sep}auto${sep}Foo${sep}b.al";
+rmdir "$dir${sep}auto${sep}Foo";
+rmdir "$dir${sep}auto";
+rmdir "$dir";
+}
diff --git a/lib/Benchmark.t b/lib/Benchmark.t
new file mode 100755
index 0000000000..be711f1330
--- /dev/null
+++ b/lib/Benchmark.t
@@ -0,0 +1,88 @@
+#!perl
+
+BEGIN {
+    chdir( 't' ) if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){
+      print "1..0 # Skip: Devel::DProf was not built\n";
+      exit 0;
+    }
+}
+
+END {
+    while(-e 'tmon.out' && unlink 'tmon.out') {}
+    while(-e 'err' && unlink 'err') {}
+}
+
+use Benchmark qw( timediff timestr );
+use Getopt::Std 'getopts';
+getopts('vI:p:');
+
+# -v   Verbose
+# -I   Add to @INC
+# -p   Name of perl binary
+
+@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>);  # glob-sort, for OS/2
+
+$path_sep = $Config{path_sep} || ':';
+$perl5lib = $opt_I || join( $path_sep, @INC );
+$perl = $opt_p || $^X;
+
+if( $opt_v ){
+	print "tests: @tests\n";
+	print "perl: $perl\n";
+	print "perl5lib: $perl5lib\n";
+}
+if( $perl =~ m|^\./| ){
+	# turn ./perl into ../perl, because of chdir(t) above.
+	$perl = ".$perl";
+}
+if( ! -f $perl ){ die "Where's Perl?" }
+
+sub profile {
+	my $test = shift;
+	my @results;
+	local $ENV{PERL5LIB} = $perl5lib;
+	my $opt_d = '-d:DProf';
+
+	my $t_start = new Benchmark;
+        open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n";
+	@results = <R>;
+	close R;
+	my $t_total = timediff( new Benchmark, $t_start );
+
+	if( $opt_v ){
+		print "\n";
+		print @results
+	}
+
+        print '# ',timestr( $t_total, 'nop' ), "\n";
+}
+
+
+sub verify {
+	my $test = shift;
+
+	my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test;
+	$command .= ' -v' if $opt_v;
+	$command .= ' -p '. $perl;
+	system $command;
+}
+
+
+$| = 1;
+print "1..18\n";
+while( @tests ){
+	$test = shift @tests;
+        $test =~ s/\.$// if $^O eq 'VMS';
+	if( $test =~ /_t$/i ){
+		print "# $test" . '.' x (20 - length $test);
+		profile $test;
+	}
+	else{
+		verify $test;
+	}
+}
+
+unlink("tmon.out");
diff --git a/lib/CGI/t/form.t b/lib/CGI/t/form.t
new file mode 100755
index 0000000000..2922903499
--- /dev/null
+++ b/lib/CGI/t/form.t
@@ -0,0 +1,90 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..17\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') { 
+    $CRLF = "\n";  # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+    $CRLF = "\r\n";
+}
+
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+
+test(2,start_form(-action=>'foobar',-method=>'get') eq 
+     qq(<form method="get" action="foobar" enctype="application/x-www-form-urlencoded">\n),
+     "start_form()");
+
+test(3,submit() eq qq(<input type="submit" name=".submit" />),"submit()");
+test(4,submit(-name=>'foo',-value=>'bar') eq qq(<input type="submit" name="foo" value="bar" />),"submit(-name,-value)");
+test(5,submit({-name=>'foo',-value=>'bar'}) eq qq(<input type="submit" name="foo" value="bar" />),"submit({-name,-value})");
+test(6,textfield(-name=>'weather') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name})");
+test(7,textfield(-name=>'weather',-value=>'nice') eq qq(<input type="text" name="weather" value="dull" />),"textfield({-name,-value})");
+test(8,textfield(-name=>'weather',-value=>'nice',-override=>1) eq qq(<input type="text" name="weather" value="nice" />),
+     "textfield({-name,-value,-override})");
+test(9,checkbox(-name=>'weather',-value=>'nice') eq qq(<input type="checkbox" name="weather" value="nice" />weather),
+     "checkbox()");
+test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
+     qq(<input type="checkbox" name="weather" value="nice" />forecast),
+     "checkbox()");
+test(11,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast',-checked=>1,-override=>1) eq 
+     qq(<input type="checkbox" name="weather" value="nice" checked />forecast),
+     "checkbox()");
+test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
+     qq(<input type="checkbox" name="weather" value="dull" checked />forecast),
+     "checkbox()");
+
+test(13,radio_group(-name=>'game') eq 
+     qq(<input type="radio" name="game" value="chess" checked />chess <input type="radio" name="game" value="checkers" />checkers),
+     'radio_group()');
+test(14,radio_group(-name=>'game',-labels=>{'chess'=>'ping pong'}) eq 
+     qq(<input type="radio" name="game" value="chess" checked />ping pong <input type="radio" name="game" value="checkers" />checkers),
+     'radio_group()');
+
+test(15, checkbox_group(-name=>'game',-Values=>[qw/checkers chess cribbage/]) eq 
+     qq(<input type="checkbox" name="game" value="checkers" checked />checkers <input type="checkbox" name="game" value="chess" checked />chess <input type="checkbox" name="game" value="cribbage" />cribbage),
+     'checkbox_group()');
+
+test(16, checkbox_group(-name=>'game',-values=>[qw/checkers chess cribbage/],-defaults=>['cribbage'],-override=>1) eq 
+     qq(<input type="checkbox" name="game" value="checkers" />checkers <input type="checkbox" name="game" value="chess" />chess <input type="checkbox" name="game" value="cribbage" checked />cribbage),
+     'checkbox_group()');
+test(17, popup_menu(-name=>'game',-values=>[qw/checkers chess cribbage/],-default=>'cribbage',-override=>1) eq <<END,'checkbox_group()');
+<select name="game">
+<option  value="checkers">checkers</option>
+<option  value="chess">chess</option>
+<option selected value="cribbage">cribbage</option>
+</select>
+END
+
diff --git a/lib/CGI/t/function.t b/lib/CGI/t/function.t
new file mode 100755
index 0000000000..b670e33cd7
--- /dev/null
+++ b/lib/CGI/t/function.t
@@ -0,0 +1,111 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..27\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI (':standard','keywords');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+my $CRLF = "\015\012";
+
+# A peculiarity of sending "\n" through MBX|Socket|web-server on VMS 
+# is that a CR character gets inserted automatically in the web server 
+# case but not internal to perl's double quoted strings "\n".  This
+# test would need to be modified to use the "\015\012" on VMS if it
+# were actually run through a web server.
+# Thanks to Peter Prymmer for this
+
+if ($^O eq 'VMS') { $CRLF = "\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+
+# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
+# translation hence CRLF is used as \r\n within CGI.pm on such machines.
+
+if (ord("\t") != 9) { $CRLF = "\r\n"; }
+ 
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}='GET';
+$ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}     ='/somewhere/else';
+$ENV{PATH_TRANSLATED} ='/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}   ='/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT} = 8080;
+$ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
+$ENV{HTTP_LOVE} = 'true';
+
+test(2,request_method() eq 'GET',"CGI::request_method()");
+test(3,query_string() eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(4,param() == 2,"CGI::param()");
+test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
+test(6,param('game') eq 'chess',"CGI::param()");
+test(7,param('weather') eq 'dull',"CGI::param()");
+test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
+test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
+test(11,query_string() eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(12,http('love') eq 'true',"CGI::http()");
+test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(15,self_url() eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     "CGI::url()");
+test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(19,url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+Delete('foo');
+test(20,!param('foo'),'CGI::delete()');
+
+CGI::_reset_globals();
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
+test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+
+CGI::_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(23,param('weather') eq 'nice',"CGI::param() from POST");
+  test(24,(url_param('big_balls') eq 'basketball'),"CGI::url_param()");
+} else {
+  print "ok 23 # Skip\n";
+  print "ok 24 # Skip\n";
+}
+test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+my $h = redirect(-Location=>'http://somewhere.else',-Type=>'text/html');
+test(26,$h eq "Status: 302 Moved${CRLF}location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
diff --git a/lib/CGI/t/html.t b/lib/CGI/t/html.t
new file mode 100755
index 0000000000..93e5dac648
--- /dev/null
+++ b/lib/CGI/t/html.t
@@ -0,0 +1,95 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..24\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') { 
+  $CRLF = "\n";  # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+  $CRLF = "\r\n";
+}
+
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1 />',"single tag");
+test(3,h1('fred') eq '<h1>fred</h1>',"open/close tag");
+test(4,h1('fred','agnes','maura') eq '<h1>fred agnes maura</h1>',"open/close tag multiple");
+test(5,h1({-align=>'CENTER'},'fred') eq '<h1 align="CENTER">fred</h1>',"open/close tag with attribute");
+test(6,h1({-align=>undef},'fred') eq '<h1 align>fred</h1>',"open/close tag with orphan attribute");
+test(7,h1({-align=>'CENTER'},['fred','agnes']) eq 
+     '<h1 align="CENTER">fred</h1> <h1 align="CENTER">agnes</h1>',
+     "distributive tag with attribute");
+{
+    local($") = '-'; 
+    test(8,h1('fred','agnes','maura') eq '<h1>fred-agnes-maura</h1>',"open/close tag \$\" interpolation");
+}
+test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${CRLF}Content-Type: image/gif${CRLF}${CRLF}","header()");
+test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
+test(13,start_html() ."\n" eq <<END,"start_html()");
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html
+	PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+	"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
+END
+    ;
+test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
+<!DOCTYPE html
+	PUBLIC "-//IETF//DTD HTML 3.2//FR">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+</head><body>
+END
+    ;
+test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE html
+	PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+	"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
+</head><body>
+END
+    ;
+test(16,($cookie=cookie(-name=>'fred',-value=>['chocolate','chip'],-path=>'/')) eq 'fred=chocolate&chip; path=/',"cookie()");
+my $h = header(-Cookie=>$cookie);
+test(17,$h =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${CRLF}Date:.*${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!s, 
+  "header(-cookie)");
+test(18,start_h3 eq '<h3>');
+test(19,end_h3 eq '</h3>');
+test(20,start_table({-border=>undef}) eq '<table border>');
+test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; &#139;right&#155;</h1>');
+charset('utf-8');
+if (ord("\t") == 9) {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; �right�</h1>');
+}
+else {
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt; �right�</h1>');
+}
+test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
+my $q = new CGI;
+test(24,$q->h1('hi') eq '<h1>hi</h1>');
diff --git a/lib/CGI/t/pretty.t b/lib/CGI/t/pretty.t
new file mode 100755
index 0000000000..14f6447033
--- /dev/null
+++ b/lib/CGI/t/pretty.t
@@ -0,0 +1,41 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI::Pretty (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1>',"single tag");
+test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
+test(4,p('hi',pre('there'),'frog') eq 
+'<p>
+	hi <pre>there</pre>
+	 frog
+</p>
+',"<pre> tags");
+test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
+'<p>
+	hi <a href="frog">there</a>
+	 frog
+</p>
+',"as-is");
diff --git a/lib/CGI/t/request.t b/lib/CGI/t/request.t
new file mode 100755
index 0000000000..fde3fd04cf
--- /dev/null
+++ b/lib/CGI/t/request.t
@@ -0,0 +1,103 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..33\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI ();
+use Config;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# Set up a CGI environment
+$ENV{REQUEST_METHOD}  = 'GET';
+$ENV{QUERY_STRING}    = 'game=chess&game=checkers&weather=dull';
+$ENV{PATH_INFO}       = '/somewhere/else';
+$ENV{PATH_TRANSLATED} = '/usr/local/somewhere/else';
+$ENV{SCRIPT_NAME}     = '/cgi-bin/foo.cgi';
+$ENV{SERVER_PROTOCOL} = 'HTTP/1.0';
+$ENV{SERVER_PORT}     = 8080;
+$ENV{SERVER_NAME}     = 'the.good.ship.lollypop.com';
+$ENV{REQUEST_URI}     = "$ENV{SCRIPT_NAME}$ENV{PATH_INFO}?$ENV{QUERY_STRING}";
+$ENV{HTTP_LOVE}       = 'true';
+
+$q = new CGI;
+test(2,$q,"CGI::new()");
+test(3,$q->request_method eq 'GET',"CGI::request_method()");
+test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
+test(5,$q->param() == 2,"CGI::param()");
+test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
+test(7,$q->param('game') eq 'chess',"CGI::param()");
+test(8,$q->param('weather') eq 'dull',"CGI::param()");
+test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
+test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
+test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
+test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
+test(13,$q->http('love') eq 'true',"CGI::http()");
+test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
+test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
+test(16,$q->self_url eq 
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     "CGI::url()");
+test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
+test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
+test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
+test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
+     'CGI::url(-relative=>1,-path=>1,-query=>1)');
+$q->delete('foo');
+test(21,!$q->param('foo'),'CGI::delete()');
+
+$q->_reset_globals;
+$ENV{QUERY_STRING}='mary+had+a+little+lamb';
+test(22,$q=new CGI,"CGI::new() redux");
+test(23,join(' ',$q->keywords) eq 'mary had a little lamb','CGI::keywords');
+test(24,join(' ',$q->param('keywords')) eq 'mary had a little lamb','CGI::keywords');
+test(25,$q=new CGI('foo=bar&foo=baz'),"CGI::new() redux");
+test(26,$q->param('foo') eq 'bar','CGI::param() redux');
+test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
+test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
+
+# test tied interface
+my $p = $q->Vars;
+test(29,$p->{bar} eq 'froz',"tied interface fetch");
+$p->{bar} = join("\0",qw(foo bar baz));
+test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+
+# test posting
+$q->_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(31,$q=new CGI,"CGI::new() from POST");
+  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
+  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+} else {
+  print "ok 31 # Skip\n";
+  print "ok 32 # Skip\n";
+  print "ok 33 # Skip\n";
+}
diff --git a/lib/CGI/t/util.t b/lib/CGI/t/util.t
new file mode 100644
index 0000000000..f0471cfed3
--- /dev/null
+++ b/lib/CGI/t/util.t
@@ -0,0 +1,56 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to escape() and unescape() punctuation characters
+# except for qw(- . _).
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..59\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI::Util qw(escape unescape);
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# ASCII order, ASCII codepoints, ASCII repertoire
+
+my %punct = (
+    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
+    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
+    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
+    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
+    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
+    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
+    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
+    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
+         );
+
+# The sort order may not be ASCII on EBCDIC machines:
+
+my $i = 1;
+
+foreach(sort(keys(%punct))) { 
+    $i++;
+    my $escape = "AbC\%$punct{$_}dEF";
+    my $cgi_escape = escape("AbC$_" . "dEF");
+    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+    $i++;
+    my $unescape = "AbC$_" . "dEF";
+    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
+    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+}
+
diff --git a/lib/CPAN/t/loadme.t b/lib/CPAN/t/loadme.t
new file mode 100644
index 0000000000..dce7e1081d
--- /dev/null
+++ b/lib/CPAN/t/loadme.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+BEGIN {
+    print "1..1\n";
+}
+use strict;
+use CPAN;
+use CPAN::FirstTime;
+
+print "ok 1\n";
+
diff --git a/lib/CPAN/t/vcmp.t b/lib/CPAN/t/vcmp.t
new file mode 100644
index 0000000000..290fc3d206
--- /dev/null
+++ b/lib/CPAN/t/vcmp.t
@@ -0,0 +1,62 @@
+# -*- Mode: cperl; coding: utf-8; -*-
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use strict;
+use CPAN;
+use vars qw($D $N);
+
+while (<DATA>) {
+  next if /^v/ && $]<5.006; # v-string tests are not for pre-5.6.0
+  chomp;
+  s/\s*#.*//;
+  push @$D, [ split ];
+}
+
+$N = scalar @$D;
+print "1..$N\n";
+
+while (@$D) {
+  my($l,$r,$exp) = @{shift @$D};
+  my $res = CPAN::Version->vcmp($l,$r);
+  if ($res != $exp){
+    print "# l[$l]r[$r]exp[$exp]res[$res]\n";
+    print "not ";
+  }
+  print "ok ", $N-@$D, "\n";
+}
+
+__END__
+0 0 0
+1 0 1
+0 1 -1
+1 1 0
+1.1 0.0a 1
+1.1a 0.0 1
+1.2.3 1.1.1 1
+v1.2.3 v1.1.1 1
+v1.2.3 v1.2.1 1
+v1.2.3 v1.2.11 -1
+1.2.3 1.2.11 1 # not what they wanted
+1.9 1.10 1
+VERSION VERSION 0
+0.02 undef 1
+1.57_00 1.57 1
+1.5700 1.57 1
+1.57_01 1.57 1
+0.2.10 0.2 1
+20000000.00 19990108 1
+1.00 0.96 1
+0.7.02 0.7 1
+1.3a5 1.3 1
+undef 1.00 -1
+v1.0 undef 1
+v0.2.4 0.24 -1
+v1.0.22 122 -1
+5.00556 v5.5.560 0
+5.005056 v5.5.56 0
+5.00557 v5.5.560 1
+5.00056 v5.0.561 -1
diff --git a/lib/Carp.t b/lib/Carp.t
new file mode 100644
index 0000000000..a318c19751
--- /dev/null
+++ b/lib/Carp.t
@@ -0,0 +1,53 @@
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use Carp qw(carp cluck croak confess);
+
+print "1..7\n";
+
+print "ok 1\n";
+
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+	if $_[0] =~ m!ok (\d+)$! };
+
+carp  "ok 2\n";
+	
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+	if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
+
+carp 3;
+
+sub sub_4 {
+
+$SIG{__WARN__} = sub {
+    print "ok $1\n"
+	if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
+
+cluck 4;
+
+}
+
+sub_4;
+
+$SIG{__DIE__} = sub {
+    print "ok $1\n"
+	if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
+
+eval { croak 5 };
+
+sub sub_6 {
+    $SIG{__DIE__} = sub {
+	print "ok $1\n"
+	    if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at .+\b(?i:carp\.t) line \d+$! };
+
+    eval { confess 6 };
+}
+
+sub_6;
+
+print "ok 7\n";
+
diff --git a/lib/Class/ISA/test.pl b/lib/Class/ISA/test.pl
new file mode 100644
index 0000000000..b09e2a94a9
--- /dev/null
+++ b/lib/Class/ISA/test.pl
@@ -0,0 +1,40 @@
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Class::ISA;
+$loaded = 1;
+print "ok 1\n";
+
+######################### 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):
+
+  @Food::Fishstick::ISA = qw(Food::Fish  Life::Fungus  Chemicals);
+  @Food::Fish::ISA = qw(Food);
+  @Food::ISA = qw(Matter);
+  @Life::Fungus::ISA = qw(Life);
+  @Chemicals::ISA = qw(Matter);
+  @Life::ISA = qw(Matter);
+  @Matter::ISA = qw();
+
+  use Class::ISA;
+  my @path = Class::ISA::super_path('Food::Fishstick');
+  my $flat_path = join ' ', @path;
+  print "# Food::Fishstick path is:\n# $flat_path\n";
+  print "not " unless
+   "Food::Fish Food Matter Life::Fungus Life Chemicals" eq $flat_path;
+  print "ok 2\n";
diff --git a/lib/Class/Struct.t b/lib/Class/Struct.t
new file mode 100644
index 0000000000..2dfaf85e6d
--- /dev/null
+++ b/lib/Class/Struct.t
@@ -0,0 +1,76 @@
+#!./perl -w
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+print "1..10\n";
+
+package aClass;
+
+sub new { bless {}, shift }
+
+sub meth { 42 }
+
+package MyObj;
+
+use Class::Struct;
+use Class::Struct 'struct'; # test out both forms
+
+use Class::Struct SomeClass => { SomeElem => '$' };
+
+struct( s => '$', a => '@', h => '%', c => 'aClass' );
+
+my $obj = MyObj->new;
+
+$obj->s('foo');
+
+print "not " unless $obj->s() eq 'foo';
+print "ok 1\n";
+
+my $arf = $obj->a;
+
+print "not " unless ref $arf eq 'ARRAY';
+print "ok 2\n";
+
+$obj->a(2, 'secundus');
+
+print "not " unless $obj->a(2) eq 'secundus';
+print "ok 3\n";
+
+my $hrf = $obj->h;
+
+print "not " unless ref $hrf eq 'HASH';
+print "ok 4\n";
+
+$obj->h('x', 10);
+
+print "not " unless $obj->h('x') == 10;
+print "ok 5\n";
+
+my $orf = $obj->c;
+
+print "not " unless ref $orf eq 'aClass';
+print "ok 6\n";
+
+print "not " unless $obj->c->meth() == 42;
+print "ok 7\n";
+
+my $obk = SomeClass->new();
+
+$obk->SomeElem(123);
+
+print "not " unless $obk->SomeElem() == 123;
+print "ok 8\n";
+
+$obj->a([4,5,6]);
+
+print "not " unless $obj->a(1) == 5;
+print "ok 9\n";
+
+$obj->h({h=>7,r=>8,f=>9});
+
+print "not " unless $obj->h('r') == 8;
+print "ok 10\n";
+
diff --git a/lib/Devel/SelfStubber.t b/lib/Devel/SelfStubber.t
new file mode 100644
index 0000000000..2e74a022d6
--- /dev/null
+++ b/lib/Devel/SelfStubber.t
@@ -0,0 +1,285 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+use Devel::SelfStubber;
+
+my $runperl = "$^X \"-I../lib\"";
+
+# ensure correct output ordering for system() calls
+
+select STDERR; $| = 1; select STDOUT; $| = 1;
+
+print "1..12\n";
+
+my @cleanup;
+
+END {
+  foreach my $file (reverse @cleanup) {
+    unlink $file or warn "unlink $file failed: $!" while -f $file;
+    rmdir $file or warn "rmdir $file failed: $!" if -d $file;
+  }
+}
+
+my $inlib = "SSI-$$";
+mkdir $inlib, 0777 or die $!;
+push @cleanup, $inlib;
+
+while (<DATA>) {
+  if (/^\#{16,}\s+(.*)/) {
+    my $file = "$inlib/$1";
+    push @cleanup, $file;
+    open FH, ">$file" or die $!;
+  } else {
+    print FH;
+  }
+}
+close FH;
+
+{
+  my $file = "A-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Child', $inlib);
+  select STDOUT;
+  print "ok 1\n";
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @A = <FH>;
+
+  if (@A == 1 && $A[0] =~ /^\s*sub\s+Child::foo\s*;\s*$/) {
+    print "ok 2\n";
+  } else {
+    print "not ok 2\n";
+    print "# $_" foreach (@A);
+  }
+}
+
+{
+  my $file = "B-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Proto', $inlib);
+  select STDOUT;
+  print "ok 3\n"; # Checking that we did not die horribly.
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @B = <FH>;
+
+  if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) {
+    print "ok 4\n";
+  } else {
+    print "not ok 4\n";
+    print "# $_" foreach (@B);
+  }
+
+  close FH or die $!;
+}
+
+{
+  my $file = "C-$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  Devel::SelfStubber->stub('Attribs', $inlib);
+  select STDOUT;
+  print "ok 5\n"; # Checking that we did not die horribly.
+  close FH or die $!;
+
+  open FH, $file or die $!;
+  my @C = <FH>;
+
+  if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/
+      && $C[1] =~ /^\s*sub\s+Attribs::lv\s+:\s*lvalue\s*:\s*method\s*;\s*$/) {
+    print "ok 6\n";
+  } else {
+    print "not ok 6\n";
+    print "# $_" foreach (@C);
+  }
+
+  close FH or die $!;
+}
+
+# "wrong" and "right" may change if SelfLoader is changed.
+my %wrong = ( Parent => 'Parent', Child => 'Parent' );
+my %right = ( Parent => 'Parent', Child => 'Child' );
+if ($^O eq 'VMS') {
+    # extra line feeds for MBX IPC
+    %wrong = ( Parent => "Parent\n", Child => "Parent\n" );
+    %right = ( Parent => "Parent\n", Child => "Child\n" );
+}
+my @module = qw(Parent Child)
+;
+sub fail {
+  my ($left, $right) = @_;
+  while (my ($key, $val) = each %$left) {
+    # warn "$key $val $$right{$key}";
+    return 1
+      unless $val eq $$right{$key};
+  }
+  return;
+}
+
+sub faildump {
+  my ($expect, $got) = @_;
+  foreach (sort keys %$expect) {
+    print "# $_ expect '$$expect{$_}' got '$$got{$_}'\n";
+  }
+}
+
+# Now test that the module tree behaves "wrongly" as expected
+
+foreach my $module (@module) {
+  my $file = "$module--$$";
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  print FH "use $module;
+print ${module}->foo;
+";
+  close FH or die $!;
+}
+
+{
+  my %output;
+  foreach my $module (@module) {
+    print "# $runperl \"-I$inlib\" $module--$$\n";
+    ($output{$module} = `$runperl "-I$inlib" $module--$$`)
+      =~ s/\'s foo//;
+  }
+
+  if (&fail (\%wrong, \%output)) {
+    print "not ok 7\n", &faildump (\%wrong, \%output);
+  } else {
+    print "ok 7\n";
+  }
+}
+
+my $lib="SSO-$$";
+mkdir $lib, 0777 or die $!;
+push @cleanup, $lib;
+$Devel::SelfStubber::JUST_STUBS=0;
+
+undef $/;
+foreach my $module (@module, 'Data', 'End') {
+  my $file = "$lib/$module.pm";
+  open FH, "$inlib/$module.pm" or die $!;
+  my $contents = <FH>;
+  close FH or die $!;
+  push @cleanup, $file;
+  open FH, ">$file" or die $!;
+  select FH;
+  if ($contents =~ /__DATA__/) {
+    # This will die for any module with no  __DATA__
+    Devel::SelfStubber->stub($module, $inlib);
+  } else {
+    print $contents;
+  }
+  select STDOUT;
+  close FH or die $!;
+}
+print "ok 8\n";
+
+{
+  my %output;
+  foreach my $module (@module) {
+    print "# $runperl \"-I$lib\" $module--$$\n";
+    ($output{$module} = `$runperl "-I$lib" $module--$$`)
+      =~ s/\'s foo//;
+  }
+
+  if (&fail (\%right, \%output)) {
+    print "not ok 9\n", &faildump (\%right, \%output);
+  } else {
+    print "ok 9\n";
+  }
+}
+
+# Check that the DATA handle stays open
+system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\"";
+
+# Possibly a pointless test as this doesn't really verify that it's been
+# stubbed.
+system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\"";
+
+# But check that the documentation after the __END__ survived.
+open FH, "$lib/End.pm" or die $!;
+$_ = <FH>;
+close FH or die $!;
+
+if (/Did the documentation here survive\?/) {
+  print "ok 12\n";
+} else {
+  print "not ok 12 # information after an __END__ token seems to be lost\n";
+}
+
+__DATA__
+################ Parent.pm
+package Parent;
+
+sub foo {
+  return __PACKAGE__;
+}
+1;
+__END__
+################ Child.pm
+package Child;
+require Parent;
+@ISA = 'Parent';
+use SelfLoader;
+
+1;
+__DATA__
+sub foo {
+  return __PACKAGE__;
+}
+__END__
+################ Proto.pm
+package Proto;
+use SelfLoader;
+
+1;
+__DATA__
+sub bar ($$) {
+}
+################ Attribs.pm
+package Attribs;
+use SelfLoader;
+
+1;
+__DATA__
+sub baz : locked {
+}
+sub lv : lvalue : method {
+  my $a;
+  \$a;
+}
+################ Data.pm
+package Data;
+use SelfLoader;
+
+1;
+__DATA__
+sub ok {
+  print <DATA>;
+}
+__END__ DATA
+ok 10
+################ End.pm
+package End;
+use SelfLoader;
+
+1;
+__DATA__
+sub lime {
+  print "ok 11\n";
+}
+__END__
+Did the documentation here survive?
diff --git a/lib/Digest.t b/lib/Digest.t
new file mode 100644
index 0000000000..5741b777fe
--- /dev/null
+++ b/lib/Digest.t
@@ -0,0 +1,26 @@
+print "1..3\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Digest;
+
+my $hexdigest = "900150983cd24fb0d6963f7d28e17f72";
+if (ord('A') == 193) { # EBCDIC
+    $hexdigest = "fe4ea0d98f9cd8d1d27f102a93cb0bb0"; # IBM-1047
+}
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 1\n";
+
+print "not " unless Digest->MD5->add("abc")->hexdigest eq $hexdigest;
+print "ok 2\n";
+
+eval {
+    print "not " unless Digest->new("HMAC-MD5" => "Jefe")->add("what do ya want for nothing?")->hexdigest eq "750c783e6ab0b503eaa86e310a5db738";
+    print "ok 3\n";
+};
+print "ok 3\n" if $@ && $@ =~ /^Can't locate/;
+
diff --git a/lib/DirHandle.t b/lib/DirHandle.t
new file mode 100755
index 0000000000..e83ea13496
--- /dev/null
+++ b/lib/DirHandle.t
@@ -0,0 +1,34 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (not $Config{'d_readdir'}) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DirHandle;
+
+print "1..5\n";
+
+$dot = new DirHandle ($^O eq 'MacOS' ? ':' : '.');
+
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = sort <*>;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+
+@b = sort($first, (grep {/^[^.]/} $dot->read));
+print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+
+$dot->rewind;
+@c = sort grep {/^[^.]/} $dot->read;
+print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+
+$dot->close;
+$dot->rewind;
+print defined($dot->read) ? "not ok" : "ok", " 5\n";
diff --git a/lib/English.t b/lib/English.t
new file mode 100755
index 0000000000..459dc3b539
--- /dev/null
+++ b/lib/English.t
@@ -0,0 +1,65 @@
+#!./perl
+
+print "1..22\n";
+
+BEGIN { @INC = '../lib' }
+use English qw( -no_match_vars ) ;
+use Config;
+my $threads = $Config{'use5005threads'} || 0;
+
+print $PID == $$ ? "ok 1\n" : "not ok 1\n";
+
+$_ = 1;
+print $ARG == $_  || $threads ? "ok 2\n" : "not ok 2\n";
+
+sub foo {
+    print $ARG[0] == $_[0] || $threads ? "ok 3\n" : "not ok 3\n";
+}
+&foo(1);
+
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 4\n" ;
+print ! $MATCH     ? "" : "not ", "ok 5\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 6\n" ;
+
+$OFS = " ";
+$ORS = "\n";
+print 'ok',7;
+undef $OUTPUT_FIELD_SEPARATOR;
+
+if ($threads) { $" = "\n" } else { $LIST_SEPARATOR = "\n" };
+@foo = ("ok 8", "ok 9");
+print "@foo";
+undef $OUTPUT_RECORD_SEPARATOR;
+
+eval 'NO SUCH FUNCTION';
+print "ok 10\n" if $EVAL_ERROR =~ /method/ || $threads;
+
+print $UID == $< ? "ok 11\n" : "not ok 11\n";
+print $GID == $( ? "ok 12\n" : "not ok 12\n";
+print $EUID == $> ? "ok 13\n" : "not ok 13\n";
+print $EGID == $) ? "ok 14\n" : "not ok 14\n";
+
+print $PROGRAM_NAME eq $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
+
+package B ;
+
+use English ;
+
+"abc" =~ /b/;
+
+print $PREMATCH  ? "" : "not ", "ok 17\n" ;
+print $MATCH     ? "" : "not ", "ok 18\n" ;
+print $POSTMATCH ? "" : "not ", "ok 19\n" ;
+
+package C ;
+
+use English qw( -no_match_vars ) ;
+
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 20\n" ;
+print ! $MATCH     ? "" : "not ", "ok 21\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 22\n" ;
diff --git a/lib/Env/array.t b/lib/Env/array.t
new file mode 100755
index 0000000000..ff6af2edb8
--- /dev/null
+++ b/lib/Env/array.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+	$ENV{FOO} = "foo";
+	$ENV{BAR} = "bar";
+}
+
+use Env qw(FOO $BAR);
+
+$FOO .= "/bar";
+$BAR .= "/baz";
+
+print "1..2\n";
+
+print "not " if $FOO ne 'foo/bar';
+print "ok 1\n";
+
+print "not " if $BAR ne 'bar/baz';
+print "ok 2\n";
+
diff --git a/lib/Env/env.t b/lib/Env/env.t
new file mode 100755
index 0000000000..c5068fda14
--- /dev/null
+++ b/lib/Env/env.t
@@ -0,0 +1,100 @@
+#!./perl
+
+$| = 1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+if ($^O eq 'VMS') {
+    print "1..11\n";
+    foreach (1..11) { print "ok $_ # skipped for VMS\n"; }
+    exit 0;
+}
+
+use Env  qw(@FOO);
+use vars qw(@BAR);
+
+sub array_equal
+{
+    my ($a, $b) = @_;
+    return 0 unless scalar(@$a) == scalar(@$b);
+    for my $i (0..scalar(@$a) - 1) {
+	return 0 unless $a->[$i] eq $b->[$i];
+    }
+    return 1;
+}
+
+sub test
+{
+    my ($desc, $code) = @_;
+
+    &$code;
+
+    print "# $desc...\n";
+    print "#    FOO = (", join(", ", @FOO), ")\n";
+    print "#    BAR = (", join(", ", @BAR), ")\n";
+
+    if (defined $check) { print "not " unless &$check; }
+    else { print "not " unless array_equal(\@FOO, \@BAR); }
+
+    print "ok ", ++$i, "\n";
+}
+
+print "1..11\n";
+
+test "Assignment", sub {
+    @FOO = qw(a B c);
+    @BAR = qw(a B c);
+};
+
+test "Storing", sub {
+    $FOO[1] = 'b';
+    $BAR[1] = 'b';
+};
+
+test "Truncation", sub {
+    $#FOO = 0;
+    $#BAR = 0;
+};
+
+test "Push", sub {
+    push @FOO, 'b', 'c';
+    push @BAR, 'b', 'c';
+};
+
+test "Pop", sub {
+    pop @FOO;
+    pop @BAR;
+};
+
+test "Shift", sub {
+    shift @FOO;
+    shift @BAR;
+};
+
+test "Push", sub {
+    push @FOO, 'c';
+    push @BAR, 'c';
+};
+
+test "Unshift", sub {
+    unshift @FOO, 'a';
+    unshift @BAR, 'a';
+};
+
+test "Reverse", sub {
+    @FOO = reverse @FOO;
+    @BAR = reverse @BAR;
+};
+
+test "Sort", sub {
+    @FOO = sort @FOO;
+    @BAR = sort @BAR;
+};
+
+test "Splice", sub {
+    splice @FOO, 1, 1, 'B';
+    splice @BAR, 1, 1, 'B';
+};
diff --git a/lib/Exporter.t b/lib/Exporter.t
new file mode 100644
index 0000000000..a0028feb23
--- /dev/null
+++ b/lib/Exporter.t
@@ -0,0 +1,145 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Utility testing functions.
+my $test_num = 1;
+sub ok ($;$) {
+    my($test, $name) = @_;
+    print "not " unless $test;
+    print "ok $test_num";
+    print " - $name" if (defined $name && ! $^O eq 'VMS');
+    print "\n";
+    $test_num++;
+}
+
+
+my $loaded;
+BEGIN { $| = 1; $^W = 1; }
+END {print "not ok $test_num\n" unless $loaded;}
+print "1..$Total_tests\n";
+use Exporter;
+$loaded = 1;
+ok(1, 'compile');
+
+
+BEGIN {
+    # Methods which Exporter says it implements.
+    @Exporter_Methods = qw(import
+                           export_to_level
+                           require_version
+                           export_fail
+                          );
+}
+
+BEGIN { $Total_tests = 14 + @Exporter_Methods }
+
+package Testing;
+require Exporter;
+@ISA = qw(Exporter);
+
+# Make sure Testing can do everything its supposed to.
+foreach my $meth (@::Exporter_Methods) {
+    ::ok( Testing->can($meth), "subclass can $meth()" );
+}
+
+%EXPORT_TAGS = (
+                This => [qw(stuff %left)],
+                That => [qw(Above the @wailing)],
+                tray => [qw(Fasten $seatbelt)],
+               );
+@EXPORT    = qw(lifejacket);
+@EXPORT_OK = qw(under &your $seat);
+$VERSION = '1.05';
+
+::ok( Testing->require_version(1.05),   'require_version()' );
+eval { Testing->require_version(1.11); 1 };
+::ok( $@,                               'require_version() fail' );
+::ok( Testing->require_version(0),      'require_version(0)' );
+
+sub lifejacket  { 'lifejacket'  }
+sub stuff       { 'stuff'       }
+sub Above       { 'Above'       }
+sub the         { 'the'         }
+sub Fasten      { 'Fasten'      }
+sub your        { 'your'        }
+sub under       { 'under'       }
+use vars qw($seatbelt $seat @wailing %left);
+$seatbelt = 'seatbelt';
+$seat     = 'seat';
+@wailing = qw(AHHHHHH);
+%left = ( left => "right" );
+
+
+Exporter::export_ok_tags;
+
+my %tags     = map { $_ => 1 } map { @$_ } values %EXPORT_TAGS;
+my %exportok = map { $_ => 1 } @EXPORT_OK;
+my $ok = 1;
+foreach my $tag (keys %tags) {
+    $ok = exists $exportok{$tag};
+}
+::ok( $ok, 'export_ok_tags()' );
+
+
+package Foo;
+Testing->import;
+
+::ok( defined &lifejacket,      'simple import' );
+
+
+package Bar;
+my @imports = qw($seatbelt &Above stuff @wailing %left);
+Testing->import(@imports);
+
+::ok( (!grep { eval "!defined $_" } map({ /^\w/ ? "&$_" : $_ } @imports)),
+      'import by symbols' );
+
+
+package Yar;
+my @tags = qw(:This :tray);
+Testing->import(@tags);
+
+::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
+             map { @$_ } @{$Testing::EXPORT_TAGS{@tags}}),
+      'import by tags' );
+
+
+package Arrr;
+Testing->import(qw(!lifejacket));
+
+::ok( !defined &lifejacket,     'deny import by !' );
+
+
+package Mars;
+Testing->import('/e/');
+
+::ok( (!grep { eval "!defined $_" } map { /^\w/ ? "&$_" : $_ }
+            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
+      'import by regex');
+
+
+package Venus;
+Testing->import('!/e/');
+
+::ok( (!grep { eval "defined $_" } map { /^\w/ ? "&$_" : $_ }
+            grep { /e/ } @Testing::EXPORT, @Testing::EXPORT_OK),
+      'deny import by regex');
+::ok( !defined &lifejacket, 'further denial' );
+
+
+package More::Testing;
+@ISA = qw(Exporter);
+$VERSION = 0;
+eval { More::Testing->require_version(0); 1 };
+::ok(!$@,       'require_version(0) and $VERSION = 0');
+
+
+package Yet::More::Testing;
+@ISA = qw(Exporter);
+$VERSION = 0;
+eval { Yet::More::Testing->require_version(10); 1 };
+::ok($@ !~ /\(undef\)/,       'require_version(10) and $VERSION = 0');
diff --git a/lib/ExtUtils.t b/lib/ExtUtils.t
new file mode 100644
index 0000000000..50a9fe44f0
--- /dev/null
+++ b/lib/ExtUtils.t
@@ -0,0 +1,483 @@
+#!./perl -w
+
+print "1..27\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use strict;
+use ExtUtils::MakeMaker;
+use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
+use Config;
+use File::Spec::Functions;
+use File::Spec;
+# Because were are going to be changing directory before running Makefile.PL
+my $perl = File::Spec->rel2abs( $^X );
+# ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to
+# compare output to ensure that it is the same. We were probably run as ./perl
+# whereas we will run the child with the full path in $perl. So make $^X for
+# us the same as our child will see.
+$^X = $perl;
+
+print "# perl=$perl\n";
+my $runperl = "$perl -x \"-I../../lib\"";
+
+$| = 1;
+
+my $dir = "ext-$$";
+my @files;
+
+print "# $dir being created...\n";
+mkdir $dir, 0777 or die "mkdir: $!\n";
+
+
+END {
+    use File::Path;
+    print "# $dir being removed...\n";
+    rmtree($dir);
+}
+
+my $package = "ExtTest";
+
+# Test the code that generates 1 and 2 letter name comparisons.
+my %compass = (
+N => 0, NE => 45, E => 90, SE => 135, S => 180, SW => 225, W => 270, NW => 315
+);
+
+my $parent_rfc1149 =
+  'A Standard for the Transmission of IP Datagrams on Avian Carriers';
+
+my @names = ("FIVE", {name=>"OK6", type=>"PV",},
+             {name=>"OK7", type=>"PVN",
+              value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
+             {name => "FARTHING", type=>"NV"},
+             {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"},
+             {name => "OPEN", type=>"PV", value=>'"/*"', macro=>1},
+             {name => "CLOSE", type=>"PV", value=>'"*/"',
+              macro=>["#if 1\n", "#endif\n"]},
+             {name => "ANSWER", default=>["UV", 42]}, "NOTDEF",
+             {name => "Yes", type=>"YES"},
+             {name => "No", type=>"NO"},
+             {name => "Undef", type=>"UNDEF"},
+# OK. It wasn't really designed to allow the creation of dual valued constants.
+# It was more for INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+             {name=>"RFC1149", type=>"SV", value=>"sv_2mortal(temp_sv)",
+              pre=>"SV *temp_sv = newSVpv(RFC1149, 0); "
+              	   . "(void) SvUPGRADE(temp_sv,SVt_PVIV); SvIOK_on(temp_sv); "
+                   . "SvIVX(temp_sv) = 1149;"},
+);
+
+push @names, $_ foreach keys %compass;
+
+my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
+
+my $types = {};
+my $constant_types = constant_types(); # macro defs
+my $C_constant = join "\n",
+  C_constant ($package, undef, "IV", $types, undef, undef, @names);
+my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant
+
+################ Header
+my $header = catfile($dir, "test.h");
+push @files, "test.h";
+open FH, ">$header" or die "open >$header: $!\n";
+print FH <<"EOT";
+#define FIVE 5
+#define OK6 "ok 6\\n"
+#define OK7 1
+#define FARTHING 0.25
+#define NOT_ZERO 1
+#define Yes 0
+#define No 1
+#define Undef 1
+#define RFC1149 "$parent_rfc1149"
+#undef NOTDEF
+
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+  print FH "#define $point $bearing\n"
+}
+close FH or die "close $header: $!\n";
+
+################ XS
+my $xs = catfile($dir, "$package.xs");
+push @files, "$package.xs";
+open FH, ">$xs" or die "open >$xs: $!\n";
+
+print FH <<'EOT';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+EOT
+
+print FH "#include \"test.h\"\n\n";
+print FH $constant_types;
+print FH $C_constant, "\n";
+print FH "MODULE = $package		PACKAGE = $package\n";
+print FH "PROTOTYPES: ENABLE\n";
+print FH $XS_constant;
+close FH or die "close $xs: $!\n";
+
+################ PM
+my $pm = catfile($dir, "$package.pm");
+push @files, "$package.pm";
+open FH, ">$pm" or die "open >$pm: $!\n";
+print FH "package $package;\n";
+print FH "use $];\n";
+
+print FH <<'EOT';
+
+use strict;
+use warnings;
+use Carp;
+
+require Exporter;
+require DynaLoader;
+use vars qw ($VERSION @ISA @EXPORT_OK);
+
+$VERSION = '0.01';
+@ISA = qw(Exporter DynaLoader);
+@EXPORT_OK = qw(
+EOT
+
+print FH "\t$_\n" foreach (@names_only);
+print FH ");\n";
+print FH autoload ($package, $]);
+print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
+close FH or die "close $pm: $!\n";
+
+################ test.pl
+my $testpl = catfile($dir, "test.pl");
+push @files, "test.pl";
+open FH, ">$testpl" or die "open >$testpl: $!\n";
+
+print FH "use strict;\n";
+print FH "use $package qw(@names_only);\n";
+print FH <<'EOT';
+
+# IV
+my $five = FIVE;
+if ($five == 5) {
+  print "ok 5\n";
+} else {
+  print "not ok 5 # $five\n";
+}
+
+# PV
+print OK6;
+
+# PVN containing embedded \0s
+$_ = OK7;
+s/.*\0//s;
+print;
+
+# NV
+my $farthing = FARTHING;
+if ($farthing == 0.25) {
+  print "ok 8\n";
+} else {
+  print "not ok 8 # $farthing\n";
+}
+
+# UV
+my $not_zero = NOT_ZERO;
+if ($not_zero > 0 && $not_zero == ~0) {
+  print "ok 9\n";
+} else {
+  print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
+}
+
+# Value includes a "*/" in an attempt to bust out of a C comment.
+# Also tests custom cpp #if clauses
+my $close = CLOSE;
+if ($close eq '*/') {
+  print "ok 10\n";
+} else {
+  print "not ok 10 # \$close='$close'\n";
+}
+
+# Default values if macro not defined.
+my $answer = ANSWER;
+if ($answer == 42) {
+  print "ok 11\n";
+} else {
+  print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
+}
+
+# not defined macro
+my $notdef = eval { NOTDEF; };
+if (defined $notdef) {
+  print "not ok 12 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
+  print "not ok 12 # \$@='$@'\n";
+} else {
+  print "ok 12\n";
+}
+
+# not a macro
+my $notthere = eval { &ExtTest::NOTTHERE; };
+if (defined $notthere) {
+  print "not ok 13 # \$notthere='$notthere'\n";
+} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
+  chomp $@;
+  print "not ok 13 # \$@='$@'\n";
+} else {
+  print "ok 13\n";
+}
+
+# Truth
+my $yes = Yes;
+if ($yes) {
+  print "ok 14\n";
+} else {
+  print "not ok 14 # $yes='\$yes'\n";
+}
+
+# Falsehood
+my $no = No;
+if (defined $no and !$no) {
+  print "ok 15\n";
+} else {
+  print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
+}
+
+# Undef
+my $undef = Undef;
+unless (defined $undef) {
+  print "ok 16\n";
+} else {
+  print "not ok 16 # \$undef='$undef'\n";
+}
+
+
+# invalid macro (chosen to look like a mix up between No and SW)
+$notdef = eval { &ExtTest::So };
+if (defined $notdef) {
+  print "not ok 17 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
+  print "not ok 17 # \$@='$@'\n";
+} else {
+  print "ok 17\n";
+}
+
+# invalid defined macro
+$notdef = eval { &ExtTest::EW };
+if (defined $notdef) {
+  print "not ok 18 # \$notdef='$notdef'\n";
+} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
+  print "not ok 18 # \$@='$@'\n";
+} else {
+  print "ok 18\n";
+}
+
+my %compass = (
+EOT
+
+while (my ($point, $bearing) = each %compass) {
+  print FH "$point => $bearing, "
+}
+
+print FH <<'EOT';
+
+);
+
+my $fail;
+while (my ($point, $bearing) = each %compass) {
+  my $val = eval $point;
+  if ($@) {
+    print "# $point: \$@='$@'\n";
+    $fail = 1;
+  } elsif (!defined $bearing) {
+    print "# $point: \$val=undef\n";
+    $fail = 1;
+  } elsif ($val != $bearing) {
+    print "# $point: \$val=$val, not $bearing\n";
+    $fail = 1;
+  }
+}
+if ($fail) {
+  print "not ok 19\n";
+} else {
+  print "ok 19\n";
+}
+
+EOT
+
+print FH <<"EOT";
+my \$rfc1149 = RFC1149;
+if (\$rfc1149 ne "$parent_rfc1149") {
+  print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
+} else {
+  print "ok 20\n";
+}
+
+if (\$rfc1149 != 1149) {
+  printf "not ok 21 # %d != 1149\n", \$rfc1149;
+} else {
+  print "ok 21\n";
+}
+
+EOT
+
+print FH <<'EOT';
+# test macro=>1
+my $open = OPEN;
+if ($open eq '/*') {
+  print "ok 22\n";
+} else {
+  print "not ok 22 # \$open='$open'\n";
+}
+EOT
+close FH or die "close $testpl: $!\n";
+
+################ Makefile.PL
+# We really need a Makefile.PL because make test for a no dynamic linking perl
+# will run Makefile.PL again as part of the "make perl" target.
+my $makefilePL = catfile($dir, "Makefile.PL");
+push @files, "Makefile.PL";
+open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
+print FH <<"EOT";
+#!$perl -w
+use ExtUtils::MakeMaker;
+WriteMakefile(
+              'NAME'		=> "$package",
+              'VERSION_FROM'	=> "$package.pm", # finds \$VERSION
+              (\$] >= 5.005 ?
+               (#ABSTRACT_FROM => "$package.pm", # XXX add this
+                AUTHOR     => "$0") : ())
+             );
+EOT
+
+close FH or die "close $makefilePL: $!\n";
+
+chdir $dir or die $!; push @INC,  '../../lib';
+END {chdir ".." or warn $!};
+
+my @perlout = `$runperl Makefile.PL`;
+if ($?) {
+  print "not ok 1 # $runperl Makefile.PL failed: $?\n";
+  print "# $_" foreach @perlout;
+  exit($?);
+} else {
+  print "ok 1\n";
+}
+
+
+my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile');
+my $makefile_ext = ($^O eq 'VMS' ? '.mms' : '');
+if (-f "$makefile$makefile_ext") {
+  print "ok 2\n";
+} else {
+  print "not ok 2\n";
+}
+my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
+push @files, "$makefile$makefile_rename"; # Renamed by make clean
+
+my $make = $Config{make};
+
+$make = $ENV{MAKE} if exists $ENV{MAKE};
+
+my $makeout;
+
+print "# make = '$make'\n";
+$makeout = `$make`;
+if ($?) {
+  print "not ok 3 # $make failed: $?\n";
+  exit($?);
+} else {
+  print "ok 3\n";
+}
+
+if ($Config{usedl}) {
+  print "ok 4\n";
+} else {
+  push @files, "perl$Config{exe_ext}";
+  my $makeperl = "$make perl";
+  print "# make = '$makeperl'\n";
+  $makeout = `$makeperl`;
+  if ($?) {
+    print "not ok 4 # $makeperl failed: $?\n";
+    exit($?);
+  } else {
+    print "ok 4\n";
+  }
+}
+
+my $test = 23;
+my $maketest = "$make test";
+print "# make = '$maketest'\n";
+$makeout = `$maketest`;
+
+# echo of running the test script
+$makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
+$makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS';
+
+# GNU make babblings
+$makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
+
+# Hopefully gets most make's babblings
+# make -f Makefile.aperl perl
+$makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig;
+# make[1]: `perl' is up to date.
+$makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig;
+
+print $makeout;
+
+if ($?) {
+  print "not ok $test # $maketest failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+my $regen = `$runperl $package.xs`;
+if ($?) {
+  print "not ok $test # $runperl $package.xs failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+my $expect = $constant_types . $C_constant .
+  "\n#### XS Section:\n" . $XS_constant;
+
+if ($expect eq $regen) {
+  print "ok $test\n";
+} else {
+  print "not ok $test\n";
+  # open FOO, ">expect"; print FOO $expect;
+  # open FOO, ">regen"; print FOO $regen; close FOO;
+}
+$test++;
+
+my $makeclean = "$make clean";
+print "# make = '$makeclean'\n";
+$makeout = `$makeclean`;
+if ($?) {
+  print "not ok $test # $make failed: $?\n";
+} else {
+  print "ok $test\n";
+}
+$test++;
+
+foreach (@files) {
+  unlink $_ or warn "unlink $_: $!";
+}
+
+my $fail;
+opendir DIR, "." or die "opendir '.': $!";
+while (defined (my $entry = readdir DIR)) {
+  next if $entry =~ /^\.\.?$/;
+  print "# Extra file '$entry'\n";
+  $fail = 1;
+}
+closedir DIR or warn "closedir '.': $!";
+if ($fail) {
+  print "not ok $test\n";
+} else {
+  print "ok $test\n";
+}
diff --git a/lib/Fatal.t b/lib/Fatal.t
new file mode 100755
index 0000000000..f00b8766e8
--- /dev/null
+++ b/lib/Fatal.t
@@ -0,0 +1,36 @@
+#!./perl -w
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   print "1..15\n";
+}
+
+use strict;
+use Fatal qw(open close :void opendir);
+
+my $i = 1;
+eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " unless $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
+
+my $foo = 'FOO';
+for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
+    eval qq{ open $_, '<$0' };
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+
+    print "not " if $@ or scalar(<$foo>) !~ m|^#!./perl|;
+    print "ok $i\n"; ++$i;
+    eval qq{ close FOO };
+    print "not " if $@;
+    print "ok $i\n"; ++$i;
+}
+
+eval { opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " unless $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
+
+eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
+print "not " if $@ =~ /^Can't open/;
+print "ok $i\n"; ++$i;
diff --git a/lib/File/Basename.t b/lib/File/Basename.t
new file mode 100755
index 0000000000..9bee1bfb8b
--- /dev/null
+++ b/lib/File/Basename.t
@@ -0,0 +1,144 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Basename qw(fileparse basename dirname);
+
+print "1..41\n";
+
+# import correctly?
+print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
+        '' : 'not '),"ok 1\n";
+
+# set fstype -- should replace non-null default
+print +(length(File::Basename::fileparse_set_fstype('unix')) ?
+        '' : 'not '),"ok 2\n";
+
+# Unix syntax tests
+($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') {
+  print "ok 3\n";
+}
+else {
+  print "not ok 3	|$base|$path|$type|\n";
+}
+print +(basename('/arma/virumque.cano') eq 'virumque.cano' ?
+        '' : 'not '),"ok 4\n";
+print +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n";
+print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n";
+print +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n";
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
+        '' : 'not '),"ok 8\n";
+
+# VMS syntax tests
+($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') {
+  print "ok 9\n";
+}
+else {
+  print "not ok 9	|$base|$path|$type|\n";
+}
+print +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 10\n";
+print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
+        '' : 'not '),"ok 11\n";
+print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
+        '' : 'not '),"ok 12\n";
+print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
+$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
+print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
+print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ?
+        '' : 'not '),"ok 16\n";
+
+# MSDOS syntax tests
+($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') {
+  print "ok 17\n";
+}
+else {
+  print "not ok 17	|$base|$path|$type|\n";
+}
+print +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 18\n";
+print +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ?
+        '' : 'not '),"ok 19\n";
+print +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n";
+print +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n";
+
+# Yes "/" is a legal path separator under MSDOS
+basename("lib/File/Basename.pm") eq "Basename.pm" or print "not ";
+print "ok 22\n";
+
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
+        '' : 'not '),"ok 23\n";
+
+# MacOS syntax tests
+($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+');
+if ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') {
+  print "ok 24\n";
+}
+else {
+  print "not ok 24	|$base|$path|$type|\n";
+}
+print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
+        '' : 'not '),"ok 25\n";
+print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
+        '' : 'not '),"ok 26\n";
+print +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n";
+print +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n";
+print +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n";
+print +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n";
+print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n";
+print +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n";
+print +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n";
+
+
+# Check quoting of metacharacters in suffix arg by basename()
+print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
+        '' : 'not '),"ok 34\n";
+print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
+        '' : 'not '),"ok 35\n";
+
+# extra tests for a few specific bugs
+
+File::Basename::fileparse_set_fstype 'MSDOS';
+# perl5.003_18 gives C:/perl/.\
+print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n";
+# perl5.003_18 gives C:\perl\
+print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n";
+
+File::Basename::fileparse_set_fstype 'UNIX';
+# perl5.003_18 gives '.'
+print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n";
+# perl5.003_18 gives '/perl/lib'
+print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n";
+
+#   The empty tainted value, for tainting strings
+my $TAINT = substr($^X, 0, 0);
+# How to identify taint when you see it
+sub any_tainted (@) {
+    not eval { join("",@_), kill 0; 1 };
+}
+sub tainted ($) {
+    any_tainted @_;
+}
+sub all_tainted (@) {
+    for (@_) { return 0 unless tainted $_ }
+    1;
+}
+
+print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n";
+print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
+		? '' : 'not '), "ok 41\n";
diff --git a/lib/File/CheckTree.t b/lib/File/CheckTree.t
new file mode 100755
index 0000000000..b445af4992
--- /dev/null
+++ b/lib/File/CheckTree.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::CheckTree;
+
+# We assume that we run from the perl "t" directory.
+
+validate q{
+    lib  -d || die
+    TEST -f || die
+};
+
+print "ok 1\n";
diff --git a/lib/File/Compare.t b/lib/File/Compare.t
new file mode 100644
index 0000000000..aedc32323e
--- /dev/null
+++ b/lib/File/Compare.t
@@ -0,0 +1,114 @@
+#!./perl
+
+BEGIN {
+  chdir 't' if -d 't';
+  @INC = '../lib';
+}
+
+BEGIN {
+  our @TEST = stat "TEST";
+  our @README = stat "README";
+  unless (@TEST && @README) {
+    print "1..0 # Skip: no file TEST or README\n";
+    exit 0;
+  }
+}
+
+print "1..12\n";
+
+use File::Compare qw(compare compare_text);
+
+print "ok 1\n";
+
+# named files, same, existing but different, cause an error
+print "not " unless compare("README","README") == 0;
+print "ok 2\n";
+
+print "not " unless compare("TEST","README") == 1;
+print "ok 3\n";
+
+print "not " unless compare("README","HLAGHLAG") == -1;
+                               # a file which doesn't exist
+print "ok 4\n";
+
+# compare_text, the same file, different but existing files
+# cause error, test sub form.
+print "not " unless compare_text("README","README") == 0;
+print "ok 5\n";
+
+print "not " unless compare_text("TEST","README") == 1;
+print "ok 6\n";
+
+print "not " unless compare_text("TEST","HLAGHLAG") == -1;
+print "ok 7\n";
+
+print "not " unless
+  compare_text("README","README",sub {$_[0] ne $_[1]}) == 0;
+print "ok 8\n";
+
+# filehandle and same file
+{
+  my $fh;
+  open ($fh, "<README") or print "not ";
+  binmode($fh);
+  print "not " unless compare($fh,"README") == 0;
+  print "ok 9\n";
+  close $fh;
+}
+
+# filehandle and different (but existing) file.
+{
+  my $fh;
+  open ($fh, "<README") or print "not ";
+  binmode($fh);
+  print "not " unless compare_text($fh,"TEST") == 1;
+  print "ok 10\n";
+  close $fh;
+}
+
+# Different file with contents of known file,
+# will use File::Temp to do this, skip rest of
+# tests if this doesn't seem to work
+
+my @donetests;
+eval {
+  require File::Spec; import File::Spec;
+  require File::Path; import File::Path;
+  require File::Temp; import File::Temp qw/ :mktemp unlink0 /;
+
+  my $template = File::Spec->catfile(File::Spec->tmpdir, 'fcmpXXXX');
+  my($tfh,$filename) = mkstemp($template);
+  {
+    local $/; #slurp
+    my $fh;
+    open($fh,'README');
+    binmode($fh);
+    my $data = <$fh>;
+    print $tfh $data;
+    close($fh);
+  }
+  seek($tfh,0,0);
+  $donetests[0] = compare($tfh, 'README');
+  $donetests[1] = compare($filename, 'README');
+  unlink0($tfh,$filename);
+};
+print "# problems when testing with a tempory file\n" if $@;
+
+if (@donetests == 2) {
+  print "not " unless $donetests[0] == 0;
+  print "ok 11\n";
+  if ($^O eq 'VMS') {
+    # The open attempt on FROM in File::Compare::compare should fail
+    # on this OS since files are not shared by default.
+    print "not " unless $donetests[1] == -1;
+    print "ok 12\n";
+  }
+  else {
+    print "not " unless $donetests[1] == 0;
+    print "ok 12\n";
+  }
+}
+else {
+  print "ok 11# Skip\nok 12 # Skip Likely due to File::Temp\n";
+}
+
diff --git a/lib/File/Copy.t b/lib/File/Copy.t
new file mode 100755
index 0000000000..44b5827e72
--- /dev/null
+++ b/lib/File/Copy.t
@@ -0,0 +1,147 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    push @INC, "::lib:$MacPerl::Architecture" if $^O eq 'MacOS';
+}
+
+$| = 1;
+
+my @pass = (0,1);
+my $tests = $^O eq 'MacOS' ? 14 : 11;
+printf "1..%d\n", $tests * scalar(@pass);
+
+use File::Copy;
+
+for my $pass (@pass) {
+
+  my $loopconst = $pass*$tests;
+
+  # First we create a file
+  open(F, ">file-$$") or die;
+  binmode F; # for DOSISH platforms, because test 3 copies to stdout
+  printf F "ok %d\n", 3 + $loopconst;
+  close F;
+
+  copy "file-$$", "copy-$$";
+
+  open(F, "copy-$$") or die;
+  $foo = <F>;
+  close(F);
+
+  print "not " if -s "file-$$" != -s "copy-$$";
+  printf "ok %d\n", 1 + $loopconst;
+
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 2+$loopconst;
+
+  binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode
+  copy "copy-$$", \*STDOUT;
+  unlink "copy-$$" or die "unlink: $!";
+
+  open(F,"file-$$");
+  copy(*F, "copy-$$");
+  open(R, "copy-$$") or die "open copy-$$: $!"; $foo = <R>; close(R);
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 4+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+  open(F,"file-$$");
+  copy(\*F, "copy-$$");
+  close(F) or die "close: $!";
+  open(R, "copy-$$") or die; $foo = <R>; close(R) or die "close: $!";
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 5+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+
+  require IO::File;
+  $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!";
+  binmode $fh or die;
+  copy("file-$$",$fh);
+  $fh->close or die "close: $!";
+  open(R, "copy-$$") or die; $foo = <R>; close(R);
+  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 6+$loopconst;
+  unlink "copy-$$" or die "unlink: $!";
+  require FileHandle;
+  my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!";
+  binmode $fh or die;
+  copy("file-$$",$fh);
+  $fh->close;
+  open(R, "copy-$$") or die; $foo = <R>; close(R);
+  print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 7+$loopconst;
+  unlink "file-$$" or die "unlink: $!";
+
+  print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
+  print "# target disappeared.\nnot " if not -e "copy-$$";
+  printf "ok %d\n", 8+$loopconst;
+
+  move "copy-$$", "file-$$" or print "# move did not succeed.\n";
+  print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$";
+  open(R, "file-$$") or die; $foo = <R>; close(R);
+  print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+  printf "ok %d\n", 9+$loopconst;
+
+  if ($^O eq 'MacOS') {
+	
+    copy "file-$$", "lib";	
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 10+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+	
+    copy "file-$$", ":lib";	
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 11+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+	
+    copy "file-$$", ":lib:";	
+    open(R, ":lib:file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 12+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+	
+    unless (-e 'lib:') { # make sure there's no volume called 'lib'
+	undef $@;
+	eval { (copy "file-$$", "lib:") || die "'lib:' is not a volume name"; };
+	print "# Died: $@";
+	print "not " unless ( $@ =~ m|'lib:' is not a volume name| );
+    }
+    printf "ok %d\n", 13+$loopconst;
+
+    move "file-$$", ":lib:";
+    open(R, ":lib:file-$$") or die "open :lib:file-$$: $!"; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
+        and not -e "file-$$";;
+    printf "ok %d\n", 14+$loopconst;
+    unlink ":lib:file-$$" or die "unlink: $!";
+  
+  } else {
+    
+    copy "file-$$", "lib";
+    open(R, "lib/file-$$") or die; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst;
+    printf "ok %d\n", 10+$loopconst;
+    unlink "lib/file-$$" or die "unlink: $!";
+
+    move "file-$$", "lib";
+    open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = <R>; close(R);
+    print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst)
+        and not -e "file-$$";;
+    printf "ok %d\n", 11+$loopconst;
+    unlink "lib/file-$$" or die "unlink: $!";
+  
+  }
+}
+
+
+END {
+    1 while unlink "file-$$";
+    if ($^O eq 'MacOS') {
+        1 while unlink ":lib:file-$$";
+    } else {
+        1 while unlink "lib/file-$$";
+    }
+}
diff --git a/lib/File/DosGlob.t b/lib/File/DosGlob.t
new file mode 100755
index 0000000000..31e36e24dc
--- /dev/null
+++ b/lib/File/DosGlob.t
@@ -0,0 +1,111 @@
+#!./perl
+
+#
+# test glob() in File::DosGlob
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..10\n";
+
+# override it in main::
+use File::DosGlob 'glob';
+
+# test if $_ takes as the default
+$_ = "op/a*.t";
+my @r = glob;
+print "not " if $_ ne 'op/a*.t';
+print "ok 1\n";
+print "# |@r|\nnot " if @r < 9;
+print "ok 2\n";
+
+# check if <*/*> works
+@r = <*/a*.t>;
+# atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
+print "not " if @r < 9;
+print "ok 3\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+while (defined($_ = <*/a*.t>)) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 4\n";
+
+# check if list context works
+@r = ();
+for (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+while (<*/a*.t>) {
+    print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 7\n";
+
+# how about in a different package, like?
+package Foo;
+use File::DosGlob 'glob';
+@s = ();
+while (glob '*/a*.t') {
+    print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (<*/b*.t>) {
+        print " $_";
+	$i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
+# how about a global override, hm?
+eval <<'EOT';
+use File::DosGlob 'GLOBAL_glob';
+package Bar;
+@s = ();
+while (<*/a*.t>) {
+    my $i = 0;
+    print "# $_ <";
+    push @s, $_;
+    while (glob '*/b*.t') {
+        print " $_";
+	$i++;
+    }
+    print " >\n";
+}
+print "not " if "@r" ne "@s";
+print "ok 10\n";
+EOT
diff --git a/lib/File/Find/find.t b/lib/File/Find/find.t
new file mode 100755
index 0000000000..cf1b1f8599
--- /dev/null
+++ b/lib/File/Find/find.t
@@ -0,0 +1,734 @@
+#!./perl
+
+
+my %Expect_File = (); # what we expect for $_ 
+my %Expect_Name = (); # what we expect for $File::Find::name/fullname
+my %Expect_Dir  = (); # what we expect for $File::Find::dir
+my $symlink_exists = eval { symlink("",""); 1 };
+my $warn_msg;
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC => '../lib';
+
+    $SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
+}
+
+if ( $symlink_exists ) { print "1..188\n"; }
+else                   { print "1..78\n";  }
+
+use File::Find;
+use File::Spec;
+
+cleanup();
+
+find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; } },
+   File::Spec->curdir);
+
+finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; } },
+	File::Spec->curdir);
+
+my $case = 2;
+my $FastFileTests_OK = 0;
+
+sub cleanup {
+    if (-d dir_path('for_find')) {
+        chdir(dir_path('for_find'));
+    }
+    if (-d dir_path('fa')) {
+        unlink file_path('fa', 'fa_ord'),
+               file_path('fa', 'fsl'),
+               file_path('fa', 'faa', 'faa_ord'),
+               file_path('fa', 'fab', 'fab_ord'),
+               file_path('fa', 'fab', 'faba', 'faba_ord'),
+               file_path('fb', 'fb_ord'),
+               file_path('fb', 'fba', 'fba_ord');
+        rmdir dir_path('fa', 'faa');
+        rmdir dir_path('fa', 'fab', 'faba');
+        rmdir dir_path('fa', 'fab');
+        rmdir dir_path('fa');
+        rmdir dir_path('fb', 'fba');
+        rmdir dir_path('fb');
+        chdir File::Spec->updir;
+        rmdir dir_path('for_find');
+    }
+}
+
+END {
+    cleanup();
+}
+
+sub Check($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else       { print "not ok $case\n"; }
+}
+
+sub CheckDie($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else { print "not ok $case\n $!\n"; exit 0; }
+}
+
+sub touch {
+    CheckDie( open(my $T,'>',$_[0]) );
+}
+
+sub MkDir($$) {
+    CheckDie( mkdir($_[0],$_[1]) );
+}
+
+sub wanted_File_Dir {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    Check( $Expect_File{$_} );
+    if ( $FastFileTests_OK ) {
+        delete $Expect_File{ $_} 
+          unless ( $Expect_Dir{$_} && ! -d _ );
+    } else {
+        delete $Expect_File{$_} 
+          unless ( $Expect_Dir{$_} && ! -d $_ );
+    }
+}
+
+sub wanted_File_Dir_prune {
+    &wanted_File_Dir;
+    $File::Find::prune=1 if  $_ eq 'faba';
+}
+
+sub wanted_Name {
+    my $n = $File::Find::name;
+    $n =~ s#\.$## if ($^O eq 'VMS' && $n ne '.');
+    print "# \$File::Find::name => '$n'\n";
+    my $i = rindex($n,'/');
+    my $OK = exists($Expect_Name{$n});
+    unless ($^O eq 'MacOS') {
+        if ( $OK ) {
+            $OK= exists($Expect_Name{substr($n,0,$i)})  if $i >= 0;    
+        }
+    }
+    Check($OK);
+    delete $Expect_Name{$n};
+}
+
+sub wanted_File {
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    my $i = rindex($_,'/');
+    my $OK = exists($Expect_File{ $_});
+    unless ($^O eq 'MacOS') {
+        if ( $OK ) {
+            $OK= exists($Expect_File{ substr($_,0,$i)})  if $i >= 0;
+        }
+    }
+    Check($OK);
+    delete $Expect_File{ $_};
+}
+
+sub simple_wanted {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+}
+
+sub noop_wanted {}
+
+sub my_preprocess {
+    @files = @_;
+    print "# --preprocess--\n";
+    print "#   \$File::Find::dir => '$File::Find::dir' \n";
+    foreach $file (@files) {
+        print "#   $file \n";
+        delete $Expect_Dir{ $File::Find::dir }->{$file};
+    }
+    print "# --end preprocess--\n";
+    Check(scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0);
+    if (scalar(keys %{$Expect_Dir{ $File::Find::dir }}) == 0) {
+        delete $Expect_Dir{ $File::Find::dir }
+    }
+    return @files;
+}
+
+sub my_postprocess {
+    print "# postprocess: \$File::Find::dir => '$File::Find::dir' \n";
+    delete $Expect_Dir{ $File::Find::dir};
+}
+
+
+# Use dir_path() to specify a directory path that's expected for
+# $File::Find::dir (%Expect_Dir). Also use it in file operations like
+# chdir, rmdir etc.
+#
+# dir_path() concatenates directory names to form a _relative_
+# directory path, independant from the platform it's run on, although
+# there are limitations.  Don't try to create an absolute path,
+# because that may fail on operating systems that have the concept of
+# volume names (e.g. Mac OS). Be careful when you want to create an
+# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
+# names will work best. As a special case, you can pass it a "." as
+# first argument, to create a directory path like "./fa/dir" on
+# operating systems other than Mac OS (actually, Mac OS will ignore
+# the ".", if it's the first argument). If there's no second argument,
+# this function will return the empty string on Mac OS and the string
+# "./" otherwise.
+
+sub dir_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path
+            # with leading ":" and with trailing ":"
+            return File::Spec->catdir("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catdir(@_);
+            # add leading "./"
+            $path = "./$path";
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":" and with trailing ":"
+            return File::Spec->catdir("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catdir($first_item, @_);
+        }
+    }
+}
+
+
+# Use topdir() to specify a directory path that you want to pass to
+#find/finddepth Basically, topdir() does the same as dir_path() (see
+#above), except that there's no trailing ":" on Mac OS.
+
+sub topdir {
+    my $path = dir_path(@_);
+    $path =~ s/:$// if ($^O eq 'MacOS');
+    return $path;
+}
+
+
+# Use file_path() to specify a file path that's expected for $_
+# (%Expect_File).  Also suitable for file operations like unlink etc.
+#
+# file_path() concatenates directory names (if any) and a filename to
+# form a _relative_ file path (the last argument is assumed to be a
+# file). It's independant from the platform it's run on, although
+# there are limitations (see the warnings for dir_path() above). As a
+# special case, you can pass it a "." as first argument, to create a
+# file path like "./fa/file" on operating systems other than Mac OS
+# (actually, Mac OS will ignore the ".", if it's the first
+# argument). If there's no second argument, this function will return
+# the empty string on Mac OS and the string "./" otherwise.
+
+sub file_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path  
+            # with leading ":", but without trailing ":"
+            return File::Spec->catfile("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catfile(@_);
+            # add leading "./" 
+            $path = "./$path"; 
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":", but without trailing ":"
+            return File::Spec->catfile("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catfile($first_item, @_);
+        }
+    }
+}
+
+
+# Use file_path_name() to specify a file path that's expected for
+# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
+# option is in effect, $_ is the same as $File::Find::Name. In that
+# case, also use this function to specify a file path that's expected
+# for $_.
+#
+# Basically, file_path_name() does the same as file_path() (see
+# above), except that there's always a leading ":" on Mac OS, even for
+# plain file/directory names.
+
+sub file_path_name {
+    my $path = file_path(@_);
+    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
+    return $path;
+}
+
+
+
+MkDir( dir_path('for_find'), 0770 );
+CheckDie(chdir( dir_path('for_find')));
+MkDir( dir_path('fa'), 0770 );
+MkDir( dir_path('fb'), 0770  );
+touch( file_path('fb', 'fb_ord') );
+MkDir( dir_path('fb', 'fba'), 0770  );
+touch( file_path('fb', 'fba', 'fba_ord') );
+if ($^O eq 'MacOS') {
+      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
+} else {
+      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
+}
+touch( file_path('fa', 'fa_ord') );
+
+MkDir( dir_path('fa', 'faa'), 0770  );
+touch( file_path('fa', 'faa', 'faa_ord') );
+MkDir( dir_path('fa', 'fab'), 0770  );
+touch( file_path('fa', 'fab', 'fab_ord') );
+MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
+touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
+
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
+                file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+File::Find::find( {wanted => \&wanted_File_Dir_prune}, topdir('fa') ); 
+Check( scalar(keys %Expect_File) == 0 );
+
+
+print "# check re-entrancy\n";
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') => 1,
+                file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+
+File::Find::find( {wanted => sub { wanted_File_Dir_prune();
+                                    File::Find::find( {wanted => sub
+                                    {} }, File::Spec->curdir ); } },
+                                    topdir('fa') );
+
+Check( scalar(keys %Expect_File) == 0 ); 
+
+
+# no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
+
+%Expect_File = (file_path_name('fa') => 1,
+		file_path_name('fa', 'fsl') => 1,
+                file_path_name('fa', 'fa_ord') => 1,
+                file_path_name('fa', 'fab') => 1,
+		file_path_name('fa', 'fab', 'fab_ord') => 1,
+		file_path_name('fa', 'fab', 'faba') => 1,
+		file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+		file_path_name('fa', 'faa') => 1,
+                file_path_name('fa', 'faa', 'faa_ord') => 1,);
+
+delete $Expect_File{ file_path_name('fa', 'fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = (dir_path('fa') => 1,
+	       dir_path('fa', 'faa') => 1,
+               dir_path('fa', 'fab') => 1,
+	       dir_path('fa', 'fab', 'faba') => 1,
+	       dir_path('fb') => 1,
+	       dir_path('fb', 'fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fb', 'fba') }
+    unless $symlink_exists;
+
+File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1},
+		  topdir('fa') ); Check( scalar(keys %Expect_File) == 0 );
+
+
+%Expect_File = ();
+
+%Expect_Name = (File::Spec->curdir => 1,
+		file_path_name('.', 'fa') => 1,
+                file_path_name('.', 'fa', 'fsl') => 1,
+                file_path_name('.', 'fa', 'fa_ord') => 1,
+                file_path_name('.', 'fa', 'fab') => 1,
+                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
+                file_path_name('.', 'fa', 'faa') => 1,
+                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
+                file_path_name('.', 'fb') => 1,
+		file_path_name('.', 'fb', 'fba') => 1,
+		file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
+		file_path_name('.', 'fb', 'fb_ord') => 1);
+
+delete $Expect_Name{ file_path('.', 'fa', 'fsl') } unless $symlink_exists;
+%Expect_Dir = (); 
+File::Find::finddepth( {wanted => \&wanted_Name}, File::Spec->curdir );
+Check( scalar(keys %Expect_Name) == 0 );
+
+
+# no_chdir is in effect, hence we use file_path_name to specify the
+# expected paths for %Expect_File
+
+%Expect_File = (File::Spec->curdir => 1,
+		file_path_name('.', 'fa') => 1,
+                file_path_name('.', 'fa', 'fsl') => 1,
+                file_path_name('.', 'fa', 'fa_ord') => 1,
+                file_path_name('.', 'fa', 'fab') => 1,
+                file_path_name('.', 'fa', 'fab', 'fab_ord') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba') => 1,
+                file_path_name('.', 'fa', 'fab', 'faba', 'faba_ord') => 1,
+                file_path_name('.', 'fa', 'faa') => 1,
+                file_path_name('.', 'fa', 'faa', 'faa_ord') => 1,
+                file_path_name('.', 'fb') => 1,
+		file_path_name('.', 'fb', 'fba') => 1,
+		file_path_name('.', 'fb', 'fba', 'fba_ord') => 1,
+		file_path_name('.', 'fb', 'fb_ord') => 1);
+
+delete $Expect_File{ file_path_name('.', 'fa', 'fsl') } unless $symlink_exists;
+%Expect_Name = ();
+%Expect_Dir = (); 
+
+File::Find::finddepth( {wanted => \&wanted_File, no_chdir => 1},
+		     File::Spec->curdir );
+
+Check( scalar(keys %Expect_File) == 0 );
+
+
+print "# check preprocess\n";
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir = (
+          File::Spec->curdir                 => {fa => 1, fb => 1}, 
+          dir_path('.', 'fa')                => {faa => 1, fab => 1, fa_ord => 1},
+          dir_path('.', 'fa', 'faa')         => {faa_ord => 1},
+          dir_path('.', 'fa', 'fab')         => {faba => 1, fab_ord => 1},
+          dir_path('.', 'fa', 'fab', 'faba') => {faba_ord => 1},
+          dir_path('.', 'fb')                => {fba => 1, fb_ord => 1},
+          dir_path('.', 'fb', 'fba')         => {fba_ord => 1}
+          );
+
+File::Find::find( {wanted => \&noop_wanted,
+		   preprocess => \&my_preprocess}, File::Spec->curdir );
+
+Check( scalar(keys %Expect_Dir) == 0 );
+
+
+print "# check postprocess\n";
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir = (
+          File::Spec->curdir                 => 1,
+          dir_path('.', 'fa')                => 1,
+          dir_path('.', 'fa', 'faa')         => 1,
+          dir_path('.', 'fa', 'fab')         => 1,
+          dir_path('.', 'fa', 'fab', 'faba') => 1,
+          dir_path('.', 'fb')                => 1,
+          dir_path('.', 'fb', 'fba')         => 1
+          );
+
+File::Find::find( {wanted => \&noop_wanted,
+		   postprocess => \&my_postprocess}, File::Spec->curdir );
+
+Check( scalar(keys %Expect_Dir) == 0 );
+
+
+if ( $symlink_exists ) {
+    print "# --- symbolic link tests --- \n";
+    $FastFileTests_OK= 1;
+
+
+    # Verify that File::Find::find will call wanted even if the topdir of
+    # is a symlink to a directory, and it shouldn't follow the link
+    # unless follow is set, which it isn't in this case
+    %Expect_File = ( file_path('fsl') => 1 );
+    %Expect_Name = ();
+    %Expect_Dir = ();
+    File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa', 'fsl') );
+    Check( scalar(keys %Expect_File) == 0 );
+
+ 
+    %Expect_File = (File::Spec->curdir => 1, file_path('fa_ord') => 1,
+                    file_path('fsl') => 1, file_path('fb_ord') => 1,
+                    file_path('fba') => 1, file_path('fba_ord') => 1,
+                    file_path('fab') => 1, file_path('fab_ord') => 1,
+                    file_path('faba') => 1, file_path('faa') => 1,
+                    file_path('faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (File::Spec->curdir => 1, dir_path('fa') => 1,
+                   dir_path('faa') => 1, dir_path('fab') => 1,
+                   dir_path('faba') => 1, dir_path('fb') => 1,
+                   dir_path('fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir_prune,
+		       follow_fast => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );  
+
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+		    file_path_name('fa', 'fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+		   dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+		   dir_path('fa', 'fab', 'faba') => 1,
+		   dir_path('fb') => 1,
+		   dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
+		       no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+
+    %Expect_File = ();
+
+    %Expect_Name = (file_path_name('fa') => 1,
+		    file_path_name('fa', 'fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Dir = ();
+
+    File::Find::finddepth( {wanted => \&wanted_Name,
+			    follow_fast => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_Name) == 0 );
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+		    file_path_name('fa', 'fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+    %Expect_Dir = ();
+
+    File::Find::finddepth( {wanted => \&wanted_File, follow_fast => 1,
+			    no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );     
+
+ 
+    print "# check dangling symbolic links\n";
+    MkDir( dir_path('dangling_dir'), 0770 );
+    CheckDie( symlink( dir_path('dangling_dir'),
+		       file_path('dangling_dir_sl') ) );
+    rmdir dir_path('dangling_dir');
+    touch(file_path('dangling_file'));  
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink('dangling_file', ':fa:dangling_file_sl') );
+    } else {
+        CheckDie( symlink('../dangling_file','fa/dangling_file_sl') );
+    }      
+    unlink file_path('dangling_file');
+
+    { 
+        # these tests should also emit a warning
+	use warnings;
+
+        %Expect_File = (File::Spec->curdir => 1,
+			file_path('fa_ord') => 1,
+                        file_path('fsl') => 1,
+                        file_path('fb_ord') => 1,
+			file_path('fba') => 1,
+                        file_path('fba_ord') => 1,
+			file_path('fab') => 1,
+                        file_path('fab_ord') => 1,
+                        file_path('faba') => 1,
+			file_path('faba_ord') => 1,
+                        file_path('faa') => 1,
+                        file_path('faa_ord') => 1);
+
+        %Expect_Name = ();
+        %Expect_Dir = ();
+        undef $warn_msg;
+
+        File::Find::find( {wanted => \&wanted_File, follow => 1,
+			   dangling_symlinks =>
+			       sub { $warn_msg = "$_[0] is a dangling symbolic link" }
+                           },
+                           topdir('dangling_dir_sl'), topdir('fa') );
+
+        Check( scalar(keys %Expect_File) == 0 );
+        Check( $warn_msg =~ m|dangling_dir_sl is a dangling symbolic link| );  
+        unlink file_path('fa', 'dangling_file_sl'),
+                         file_path('dangling_dir_sl');
+
+    }
+
+
+    print "# check recursion\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:faa',':fa:faa:faa_sl') );
+    } else {
+        CheckDie( symlink('../faa','fa/faa/faa_sl') );
+    }
+    undef $@;
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                             no_chdir => 1}, topdir('fa') ); };
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]faa_sl is a recursive symbolic link| );  
+    unlink file_path('fa', 'faa', 'faa_sl'); 
+
+
+    print "# check follow_skip (file)\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:fa_ord',':fa:fa_ord_sl') ); # symlink to a file
+    } else {
+        CheckDie( symlink('./fa_ord','fa/fa_ord_sl') ); # symlink to a file
+    }
+    undef $@;
+
+    eval {File::Find::finddepth( {wanted => \&simple_wanted,
+                                  follow => 1,
+                                  follow_skip => 0, no_chdir => 1},
+                                  topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]fa_ord encountered a second time| );
+
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+		    file_path_name('fa', 'fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+		   dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+		   dir_path('fa', 'fab', 'faba') => 1,
+		   dir_path('fb') => 1,
+		   dir_path('fb','fba') => 1);
+
+    File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
+                           follow_skip => 1, no_chdir => 1},
+                           topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+    unlink file_path('fa', 'fa_ord_sl');
+
+
+    print "# check follow_skip (directory)\n";
+    if ($^O eq 'MacOS') {
+        CheckDie( symlink(':fa:faa',':fa:faa_sl') ); # symlink to a directory
+    } else {
+        CheckDie( symlink('./faa','fa/faa_sl') ); # symlink to a directory
+    }
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                            follow_skip => 0, no_chdir => 1},
+                            topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );
+
+  
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                            follow_skip => 1, no_chdir => 1},
+                            topdir('fa') );};
+
+    Check( $@ =~ m|for_find[:/]fa[:/]faa[:/]? encountered a second time| );  
+
+    # no_chdir is in effect, hence we use file_path_name to specify
+    # the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+		    file_path_name('fa', 'fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+		   dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+		   dir_path('fa', 'fab', 'faba') => 1,
+		   dir_path('fb') => 1,
+		   dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow => 1,
+		       follow_skip => 2, no_chdir => 1}, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+    unlink file_path('fa', 'faa_sl');
+
+} 
+
diff --git a/lib/File/Find/taint.t b/lib/File/Find/taint.t
new file mode 100644
index 0000000000..5ee1c3dd6d
--- /dev/null
+++ b/lib/File/Find/taint.t
@@ -0,0 +1,388 @@
+#!./perl -T
+
+
+my %Expect_File = (); # what we expect for $_ 
+my %Expect_Name = (); # what we expect for $File::Find::name/fullname
+my %Expect_Dir  = (); # what we expect for $File::Find::dir
+my $symlink_exists = eval { symlink("",""); 1 };
+my $cwd;
+my $cwd_untainted;
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC => '../lib';
+
+    for (keys %ENV) { # untaint ENV
+    ($ENV{$_}) = $ENV{$_} =~ /(.*)/;
+    }
+}
+
+if ( $symlink_exists ) { print "1..45\n"; }
+else                   { print "1..27\n";  }
+
+use File::Find;
+use File::Spec;
+use Cwd;
+
+# Remove insecure directories from PATH
+my @path;
+my $sep = ($^O eq 'MSWin32') ? ';' : ':';
+foreach my $dir (split(/$sep/,$ENV{'PATH'}))
+ {
+  push(@path,$dir) unless -w $dir;
+ }
+$ENV{'PATH'} = join($sep,@path);
+
+cleanup();
+
+find({wanted => sub { print "ok 1\n" if $_ eq 'commonsense.t'; },
+      untaint => 1, untaint_pattern => qr|^(.+)$|}, File::Spec->curdir);
+
+finddepth({wanted => sub { print "ok 2\n" if $_ eq 'commonsense.t'; },
+           untaint => 1, untaint_pattern => qr|^(.+)$|},
+           File::Spec->curdir);
+
+my $case = 2;
+my $FastFileTests_OK = 0;
+
+sub cleanup {
+    if (-d dir_path('for_find')) {
+        chdir(dir_path('for_find'));
+    }
+    if (-d dir_path('fa')) {
+        unlink file_path('fa', 'fa_ord'),
+               file_path('fa', 'fsl'),
+               file_path('fa', 'faa', 'faa_ord'),
+               file_path('fa', 'fab', 'fab_ord'),
+               file_path('fa', 'fab', 'faba', 'faba_ord'),
+               file_path('fb', 'fb_ord'),
+               file_path('fb', 'fba', 'fba_ord');
+        rmdir dir_path('fa', 'faa');
+        rmdir dir_path('fa', 'fab', 'faba');
+        rmdir dir_path('fa', 'fab');
+        rmdir dir_path('fa');
+        rmdir dir_path('fb', 'fba');
+        rmdir dir_path('fb');
+        chdir File::Spec->updir;
+        rmdir dir_path('for_find');
+    }
+}
+
+END {
+    cleanup();
+}
+
+sub Check($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else       { print "not ok $case\n"; }
+}
+
+sub CheckDie($) {
+    $case++;
+    if ($_[0]) { print "ok $case\n"; }
+    else { print "not ok $case\n $!\n"; exit 0; }
+}
+
+sub touch {
+    CheckDie( open(my $T,'>',$_[0]) );
+}
+
+sub MkDir($$) {
+    CheckDie( mkdir($_[0],$_[1]) );
+}
+
+sub wanted_File_Dir {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+    s#\.$## if ($^O eq 'VMS' && $_ ne '.');
+    Check( $Expect_File{$_} );
+    if ( $FastFileTests_OK ) {
+        delete $Expect_File{ $_} 
+          unless ( $Expect_Dir{$_} && ! -d _ );
+    } else {
+        delete $Expect_File{$_} 
+          unless ( $Expect_Dir{$_} && ! -d $_ );
+    }
+}
+
+sub wanted_File_Dir_prune {
+    &wanted_File_Dir;
+    $File::Find::prune=1 if  $_ eq 'faba';
+}
+
+
+sub simple_wanted {
+    print "# \$File::Find::dir => '$File::Find::dir'\n";
+    print "# \$_ => '$_'\n";
+}
+
+
+# Use dir_path() to specify a directory path that's expected for
+# $File::Find::dir (%Expect_Dir). Also use it in file operations like
+# chdir, rmdir etc.
+#
+# dir_path() concatenates directory names to form a _relative_
+# directory path, independant from the platform it's run on, although
+# there are limitations.  Don't try to create an absolute path,
+# because that may fail on operating systems that have the concept of
+# volume names (e.g. Mac OS). Be careful when you want to create an
+# updir path like ../fa (Unix) or ::fa: (Mac OS). Plain directory
+# names will work best. As a special case, you can pass it a "." as
+# first argument, to create a directory path like "./fa/dir" on
+# operating systems other than Mac OS (actually, Mac OS will ignore
+# the ".", if it's the first argument). If there's no second argument,
+# this function will return the empty string on Mac OS and the string
+# "./" otherwise.
+
+sub dir_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path
+            # with leading ":" and with trailing ":"
+            return File::Spec->catdir("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catdir(@_);
+            # add leading "./"
+            $path = "./$path";
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":" and with trailing ":"
+            return File::Spec->catdir("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catdir($first_item, @_);
+        }
+    }
+}
+
+
+# Use topdir() to specify a directory path that you want to pass to
+#find/finddepth Basically, topdir() does the same as dir_path() (see
+#above), except that there's no trailing ":" on Mac OS.
+
+sub topdir {
+    my $path = dir_path(@_);
+    $path =~ s/:$// if ($^O eq 'MacOS');
+    return $path;
+}
+
+
+# Use file_path() to specify a file path that's expected for $_ (%Expect_File).
+# Also suitable for file operations like unlink etc.
+
+# file_path() concatenates directory names (if any) and a filename to
+# form a _relative_ file path (the last argument is assumed to be a
+# file). It's independant from the platform it's run on, although
+# there are limitations (see the warnings for dir_path() above). As a
+# special case, you can pass it a "." as first argument, to create a
+# file path like "./fa/file" on operating systems other than Mac OS
+# (actually, Mac OS will ignore the ".", if it's the first
+# argument). If there's no second argument, this function will return
+# the empty string on Mac OS and the string "./" otherwise.
+
+sub file_path {
+    my $first_item = shift @_;
+
+    if ($first_item eq '.') {
+        if ($^O eq 'MacOS') {
+            return '' unless @_;
+            # ignore first argument; return a relative path  
+            # with leading ":", but without trailing ":"
+            return File::Spec->catfile("", @_); 
+        } else { # other OS
+            return './' unless @_;
+            my $path = File::Spec->catfile(@_);
+            # add leading "./" 
+            $path = "./$path"; 
+            return $path;
+        }
+
+    } else { # $first_item ne '.'
+        return $first_item unless @_; # return plain filename
+        if ($^O eq 'MacOS') {
+            # relative path with leading ":", but without trailing ":"
+            return File::Spec->catfile("", $first_item, @_);
+        } else { # other OS
+            return File::Spec->catfile($first_item, @_);
+        }
+    }
+}
+
+
+# Use file_path_name() to specify a file path that's expected for
+# $File::Find::Name (%Expect_Name). Note: When the no_chdir => 1
+# option is in effect, $_ is the same as $File::Find::Name. In that
+# case, also use this function to specify a file path that's expected
+# for $_.
+#
+# Basically, file_path_name() does the same as file_path() (see
+# above), except that there's always a leading ":" on Mac OS, even for
+# plain file/directory names.
+
+sub file_path_name {
+    my $path = file_path(@_);
+    $path = ":$path" if (($^O eq 'MacOS') && ($path !~ /:/));
+    return $path;
+}
+
+
+
+MkDir( dir_path('for_find'), 0770 );
+CheckDie(chdir( dir_path('for_find')));
+
+$cwd = cwd(); # save cwd
+( $cwd_untainted ) = $cwd =~ m|^(.+)$|; # untaint it
+
+MkDir( dir_path('fa'), 0770 );
+MkDir( dir_path('fb'), 0770  );
+touch( file_path('fb', 'fb_ord') );
+MkDir( dir_path('fb', 'fba'), 0770  );
+touch( file_path('fb', 'fba', 'fba_ord') );
+if ($^O eq 'MacOS') {
+      CheckDie( symlink(':fb',':fa:fsl') ) if $symlink_exists;
+} else {
+      CheckDie( symlink('../fb','fa/fsl') ) if $symlink_exists;
+}
+touch( file_path('fa', 'fa_ord') );
+
+MkDir( dir_path('fa', 'faa'), 0770  );
+touch( file_path('fa', 'faa', 'faa_ord') );
+MkDir( dir_path('fa', 'fab'), 0770  );
+touch( file_path('fa', 'fab', 'fab_ord') );
+MkDir( dir_path('fa', 'fab', 'faba'), 0770  );
+touch( file_path('fa', 'fab', 'faba', 'faba_ord') );
+
+print "# check untainting (no follow)\n";
+
+# untainting here should work correctly
+
+%Expect_File = (File::Spec->curdir => 1, file_path('fsl') =>
+                1,file_path('fa_ord') => 1, file_path('fab') => 1,
+                file_path('fab_ord') => 1, file_path('faba') => 1,
+                file_path('faa') => 1, file_path('faa_ord') => 1);
+delete $Expect_File{ file_path('fsl') } unless $symlink_exists;
+%Expect_Name = ();
+
+%Expect_Dir = ( dir_path('fa') => 1, dir_path('faa') => 1,
+                dir_path('fab') => 1, dir_path('faba') => 1,
+                dir_path('fb') => 1, dir_path('fba') => 1);
+
+delete @Expect_Dir{ dir_path('fb'), dir_path('fba') } unless $symlink_exists;
+
+File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1,
+		   untaint_pattern => qr|^(.+)$|}, topdir('fa') );
+
+Check( scalar(keys %Expect_File) == 0 );
+
+
+# don't untaint at all, should die
+%Expect_File = ();
+%Expect_Name = ();
+%Expect_Dir  = ();
+undef $@;
+eval {File::Find::find( {wanted => \&simple_wanted}, topdir('fa') );};
+Check( $@ =~ m|Insecure dependency| );
+chdir($cwd_untainted);
+
+
+# untaint pattern doesn't match, should die 
+undef $@;
+
+eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                         untaint_pattern => qr|^(NO_MATCH)$|},
+                         topdir('fa') );};
+
+Check( $@ =~ m|is still tainted| );
+chdir($cwd_untainted);
+
+
+# untaint pattern doesn't match, should die when we chdir to cwd   
+print "# check untaint_skip (no follow)\n";
+undef $@;
+
+eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                         untaint_skip => 1, untaint_pattern =>
+                         qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+Check( $@ =~ m|insecure cwd| );
+chdir($cwd_untainted);
+
+
+if ( $symlink_exists ) {
+    print "# --- symbolic link tests --- \n";
+    $FastFileTests_OK= 1;
+
+    print "# check untainting (follow)\n";
+
+    # untainting here should work correctly
+    # no_chdir is in effect, hence we use file_path_name to specify the expected paths for %Expect_File
+
+    %Expect_File = (file_path_name('fa') => 1,
+		    file_path_name('fa','fa_ord') => 1,
+		    file_path_name('fa', 'fsl') => 1,
+                    file_path_name('fa', 'fsl', 'fb_ord') => 1,
+                    file_path_name('fa', 'fsl', 'fba') => 1,
+                    file_path_name('fa', 'fsl', 'fba', 'fba_ord') => 1,
+                    file_path_name('fa', 'fab') => 1,
+                    file_path_name('fa', 'fab', 'fab_ord') => 1,
+                    file_path_name('fa', 'fab', 'faba') => 1,
+                    file_path_name('fa', 'fab', 'faba', 'faba_ord') => 1,
+                    file_path_name('fa', 'faa') => 1,
+                    file_path_name('fa', 'faa', 'faa_ord') => 1);
+
+    %Expect_Name = ();
+
+    %Expect_Dir = (dir_path('fa') => 1,
+		   dir_path('fa', 'faa') => 1,
+                   dir_path('fa', 'fab') => 1,
+		   dir_path('fa', 'fab', 'faba') => 1,
+		   dir_path('fb') => 1,
+		   dir_path('fb', 'fba') => 1);
+
+    File::Find::find( {wanted => \&wanted_File_Dir, follow_fast => 1,
+                       no_chdir => 1, untaint => 1, untaint_pattern =>
+                       qr|^(.+)$| }, topdir('fa') );
+
+    Check( scalar(keys %Expect_File) == 0 );
+ 
+    
+    # don't untaint at all, should die
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1},
+			    topdir('fa') );};
+
+    Check( $@ =~ m|Insecure dependency| );
+    chdir($cwd_untainted);
+
+    # untaint pattern doesn't match, should die
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, follow => 1,
+                             untaint => 1, untaint_pattern =>
+                             qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+    Check( $@ =~ m|is still tainted| );
+    chdir($cwd_untainted);
+
+    # untaint pattern doesn't match, should die when we chdir to cwd
+    print "# check untaint_skip (follow)\n";
+    undef $@;
+
+    eval {File::Find::find( {wanted => \&simple_wanted, untaint => 1,
+                             untaint_skip => 1, untaint_pattern =>
+                             qr|^(NO_MATCH)$|}, topdir('fa') );};
+
+    Check( $@ =~ m|insecure cwd| );
+    chdir($cwd_untainted);
+
+} 
+
diff --git a/lib/File/Glob/basic.t b/lib/File/Glob/basic.t
new file mode 100755
index 0000000000..ef9dd96495
--- /dev/null
+++ b/lib/File/Glob/basic.t
@@ -0,0 +1,175 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..11\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob ':glob';
+use Cwd ();
+$loaded = 1;
+print "ok 1\n";
+
+sub array {
+    return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
+}
+
+# look for the contents of the current directory
+$ENV{PATH} = "/bin";
+delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
+@correct = ();
+if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
+   @correct = grep { !/^\./ } sort readdir(D);
+   closedir D;
+}
+@a = File::Glob::glob("*", 0);
+@a = sort @a;
+if ("@a" ne "@correct" || GLOB_ERROR) {
+    print "# |@a| ne |@correct|\nnot ";
+}
+print "ok 2\n";
+
+# look up the user's home directory
+# should return a list with one item, and not set ERROR
+if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS') {
+  eval {
+    ($name, $home) = (getpwuid($>))[0,7];
+    1;
+  } and do {
+    @a = bsd_glob("~$name", GLOB_TILDE);
+    if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
+	print "not ";
+    }
+  };
+}
+print "ok 3\n";
+
+# check backslashing
+# should return a list with one item, and not set ERROR
+@a = bsd_glob('TEST', GLOB_QUOTE);
+if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
+    local $/ = "][";
+    print "# [@a]\n";
+    print "not ";
+}
+print "ok 4\n";
+
+# check nonexistent checks
+# should return an empty list
+# XXX since errfunc is NULL on win32, this test is not valid there
+@a = bsd_glob("asdfasdf", 0);
+if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
+    print "# |@a|\nnot ";
+}
+print "ok 5\n";
+
+# check bad protections
+# should return an empty list, and set ERROR
+if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
+    or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
+{
+    print "ok 6 # skipped\n";
+}
+else {
+    $dir = "pteerslt";
+    mkdir $dir, 0;
+    @a = bsd_glob("$dir/*", GLOB_ERR);
+    #print "\@a = ", array(@a);
+    rmdir $dir;
+    if (scalar(@a) != 0 || GLOB_ERROR == 0) {
+	print "not ";
+    }
+    print "ok 6\n";
+}
+
+# check for csh style globbing
+@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
+unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
+    print "not ";
+}
+print "ok 7\n";
+
+@a = bsd_glob(
+    '{TES*,doesntexist*,a,b}',
+    GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
+);
+
+# Working on t/TEST often causes this test to fail because it sees Emacs temp
+# and RCS files.  Filter them out, and .pm files too, and patch temp files.
+@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
+
+print "# @a\n";
+
+unless (@a == 3
+        and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
+        and $a[1] eq 'a'
+        and $a[2] eq 'b')
+{
+    print "not ok 8 # @a";
+} else {
+    print "ok 8\n";
+}
+
+# "~" should expand to $ENV{HOME}
+$ENV{HOME} = "sweet home";
+@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
+unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
+    print "not ";
+}
+print "ok 9\n";
+
+# GLOB_ALPHASORT (default) should sort alphabetically regardless of case
+mkdir "pteerslt", 0777;
+chdir "pteerslt";
+
+@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
+@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
+if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
+    @f_names = sort(@f_names);
+}
+if ($^O eq 'VMS') { # VMS is happily caseignorant
+    @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
+    @f_names = @f_alpha;
+}
+
+for (@f_names) {
+    open T, "> $_";
+    close T;
+}
+
+$pat = "*.pl";
+
+$ok = 1;
+@g_names = bsd_glob($pat, 0);
+print "# f_names = @f_names\n";
+print "# g_names = @g_names\n";
+for (@f_names) {
+    $ok = 0 unless $_ eq shift @g_names;
+}
+print $ok ? "ok 10\n" : "not ok 10\n";
+
+$ok = 1;
+@g_alpha = bsd_glob($pat);
+print "# f_alpha = @f_alpha\n";
+print "# g_alpha = @g_alpha\n";
+for (@f_alpha) {
+    $ok = 0 unless $_ eq shift @g_alpha;
+}
+print $ok ? "ok 11\n" : "not ok 11\n";
+
+unlink @f_names;
+chdir "..";
+rmdir "pteerslt";
diff --git a/lib/File/Glob/case.t b/lib/File/Glob/case.t
new file mode 100755
index 0000000000..87f3b9f694
--- /dev/null
+++ b/lib/File/Glob/case.t
@@ -0,0 +1,60 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..7\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob qw(:glob csh_glob);
+$loaded = 1;
+print "ok 1\n";
+
+my $pat = $^O eq "MacOS" ? ":op:G*.t" : "op/G*.t";
+
+# Test the actual use of the case sensitivity tags, via csh_glob()
+import File::Glob ':nocase';
+@a = csh_glob($pat);
+print "not " unless @a >= 8;
+print "ok 2\n";
+
+# This may fail on systems which are not case-PRESERVING
+import File::Glob ':case';
+@a = csh_glob($pat); # None should be uppercase
+print "not " unless @a == 0;
+print "ok 3\n";
+
+# Test the explicit use of the GLOB_NOCASE flag
+@a = bsd_glob($pat, GLOB_NOCASE);
+print "not " unless @a >= 3;
+print "ok 4\n";
+
+# Test Win32 backslash nastiness...
+if ($^O ne 'MSWin32' && $^O ne 'NetWare') {
+    print "ok 5\nok 6\nok 7\n";
+}
+else {
+    @a = File::Glob::glob("op\\g*.t");
+    print "not " unless @a >= 8;
+    print "ok 5\n";
+    mkdir "[]", 0;
+    @a = File::Glob::glob("\\[\\]", GLOB_QUOTE);
+    rmdir "[]";
+    print "# returned @a\nnot " unless @a == 1;
+    print "ok 6\n";
+    @a = bsd_glob("op\\*", GLOB_QUOTE);
+    print "not " if @a == 0;
+    print "ok 7\n";
+}
diff --git a/lib/File/Glob/global.t b/lib/File/Glob/global.t
new file mode 100755
index 0000000000..c0abbc5ea5
--- /dev/null
+++ b/lib/File/Glob/global.t
@@ -0,0 +1,151 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..10\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+
+BEGIN {
+    *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
+}
+
+BEGIN {
+    if ("Just another Perl hacker," ne (<*>)[0]) {
+        die <<EOMessage;
+Your version of perl ($]) doesn't seem to allow extensions to override
+the core glob operator.
+EOMessage
+    }
+}
+
+use File::Glob ':globally';
+$loaded = 1;
+print "ok 1\n";
+
+$_ = $^O eq "MacOS" ? ":op:*.t" : "op/*.t";
+my @r = glob;
+print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t");
+print "ok 2\n";
+
+print "# |@r|\nnot " if @r < 3;
+print "ok 3\n";
+
+# check if <*/*> works
+if ($^O eq "MacOS") {
+    @r = <:*:*.t>;
+} else {
+    @r = <*/*.t>;
+}
+# at least t/global.t t/basic.t, t/taint.t
+print "not " if @r < 3;
+print "ok 4\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+if ($^O eq "MacOS") {
+    while (defined($_ = <:*:*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (defined($_ = <*/*.t>)) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# check if list context works
+@r = ();
+if ($^O eq "MacOS") {
+    for (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    for (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_\n";
+	push @r, $_;
+    }
+}
+print "not " if @r != $r;
+print "ok 7\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# how about in a different package, like?
+package Foo;
+use File::Glob ':globally';
+@s = ();
+while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+my $i = 0;
+if ($^O eq "MacOS") {
+    while (<:*:*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<:bas*:*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
+    }
+} else {
+    while (<*/*.t>) {
+	#print "# $_ <";
+	push @s, $_;
+	while (<bas*/*.t>) {
+	    #print " $_";
+	    $i++;
+	}
+	#print " >\n";
+    }
+}
+print "not " if "@r" ne "@s" or not $i;
+print "ok 10\n";
diff --git a/lib/File/Glob/taint.t b/lib/File/Glob/taint.t
new file mode 100755
index 0000000000..4c0990358d
--- /dev/null
+++ b/lib/File/Glob/taint.t
@@ -0,0 +1,31 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..2\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob;
+$loaded = 1;
+print "ok 1\n";
+
+# all filenames should be tainted
+@a = File::Glob::bsd_glob("*");
+eval { $a = join("",@a), kill 0; 1 };
+unless ($@ =~ /Insecure dependency/) {
+    print "not ";
+}
+print "ok 2\n";
diff --git a/lib/File/Path.t b/lib/File/Path.t
new file mode 100755
index 0000000000..42e0ae9f93
--- /dev/null
+++ b/lib/File/Path.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Path;
+use strict;
+
+my $count = 0;
+use warnings;
+
+print "1..4\n";
+
+# first check for stupid permissions second for full, so we clean up
+# behind ourselves
+for my $perm (0111,0777) {
+    mkpath("foo/bar");
+    chmod $perm, "foo", "foo/bar";
+
+    print "not " unless -d "foo" && -d "foo/bar";
+    print "ok ", ++$count, "\n";
+
+    rmtree("foo");
+    print "not " if -e "foo";
+    print "ok ", ++$count, "\n";
+}
diff --git a/lib/File/Spec.t b/lib/File/Spec.t
new file mode 100755
index 0000000000..c6d155fac1
--- /dev/null
+++ b/lib/File/Spec.t
@@ -0,0 +1,379 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Each element in this array is a single test. Storing them this way makes
+# maintenance easy, and should be OK since perl should be pretty functional
+# before these tests are run.
+
+@tests = (
+# Function                      Expected
+[ "Unix->catfile('a','b','c')", 'a/b/c'  ],
+
+[ "Unix->splitpath('file')",            ',,file'            ],
+[ "Unix->splitpath('/d1/d2/d3/')",      ',/d1/d2/d3/,'      ],
+[ "Unix->splitpath('d1/d2/d3/')",       ',d1/d2/d3/,'       ],
+[ "Unix->splitpath('/d1/d2/d3/.')",     ',/d1/d2/d3/.,'     ],
+[ "Unix->splitpath('/d1/d2/d3/..')",    ',/d1/d2/d3/..,'    ],
+[ "Unix->splitpath('/d1/d2/d3/.file')", ',/d1/d2/d3/,.file' ],
+[ "Unix->splitpath('d1/d2/d3/file')",   ',d1/d2/d3/,file'   ],
+[ "Unix->splitpath('/../../d1/')",      ',/../../d1/,'      ],
+[ "Unix->splitpath('/././d1/')",        ',/././d1/,'        ],
+
+[ "Unix->catpath('','','file')",            'file'            ],
+[ "Unix->catpath('','/d1/d2/d3/','')",      '/d1/d2/d3/'      ],
+[ "Unix->catpath('','d1/d2/d3/','')",       'd1/d2/d3/'       ],
+[ "Unix->catpath('','/d1/d2/d3/.','')",     '/d1/d2/d3/.'     ],
+[ "Unix->catpath('','/d1/d2/d3/..','')",    '/d1/d2/d3/..'    ],
+[ "Unix->catpath('','/d1/d2/d3/','.file')", '/d1/d2/d3/.file' ],
+[ "Unix->catpath('','d1/d2/d3/','file')",   'd1/d2/d3/file'   ],
+[ "Unix->catpath('','/../../d1/','')",      '/../../d1/'      ],
+[ "Unix->catpath('','/././d1/','')",        '/././d1/'        ],
+[ "Unix->catpath('d1','d2/d3/','')",        'd2/d3/'          ],
+[ "Unix->catpath('d1','d2','d3/')",         'd2/d3/'          ],
+
+[ "Unix->splitdir('')",           ''           ],
+[ "Unix->splitdir('/d1/d2/d3/')", ',d1,d2,d3,' ],
+[ "Unix->splitdir('d1/d2/d3/')",  'd1,d2,d3,'  ],
+[ "Unix->splitdir('/d1/d2/d3')",  ',d1,d2,d3'  ],
+[ "Unix->splitdir('d1/d2/d3')",   'd1,d2,d3'   ],
+
+[ "Unix->catdir()",                     ''          ],
+[ "Unix->catdir('/')",                  '/'         ],
+[ "Unix->catdir('','d1','d2','d3','')", '/d1/d2/d3' ],
+[ "Unix->catdir('d1','d2','d3','')",    'd1/d2/d3'  ],
+[ "Unix->catdir('','d1','d2','d3')",    '/d1/d2/d3' ],
+[ "Unix->catdir('d1','d2','d3')",       'd1/d2/d3'  ],
+
+[ "Unix->catfile('a','b','c')", 'a/b/c' ],
+
+[ "Unix->canonpath('')",                                      ''          ],
+[ "Unix->canonpath('///../../..//./././a//b/.././c/././')",   '/a/b/../c' ],
+[ "Unix->canonpath('/.')",                                    '/.'        ],
+
+[  "Unix->abs2rel('/t1/t2/t3','/t1/t2/t3')",          ''                   ],
+[  "Unix->abs2rel('/t1/t2/t4','/t1/t2/t3')",          '../t4'              ],
+[  "Unix->abs2rel('/t1/t2','/t1/t2/t3')",             '..'                 ],
+[  "Unix->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')",       't4'                 ],
+[  "Unix->abs2rel('/t4/t5/t6','/t1/t2/t3')",          '../../../t4/t5/t6'  ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
+[  "Unix->abs2rel('/','/t1/t2/t3')",                  '../../..'           ],
+[  "Unix->abs2rel('///','/t1/t2/t3')",                '../../..'           ],
+[  "Unix->abs2rel('/.','/t1/t2/t3')",                 '../../../.'         ],
+[  "Unix->abs2rel('/./','/t1/t2/t3')",                '../../..'           ],
+#[ "Unix->abs2rel('../t4','/t1/t2/t3')",              '../t4'              ],
+
+[ "Unix->rel2abs('t4','/t1/t2/t3')",             '/t1/t2/t3/t4'    ],
+[ "Unix->rel2abs('t4/t5','/t1/t2/t3')",          '/t1/t2/t3/t4/t5' ],
+[ "Unix->rel2abs('.','/t1/t2/t3')",              '/t1/t2/t3'       ],
+[ "Unix->rel2abs('..','/t1/t2/t3')",             '/t1/t2/t3/..'    ],
+[ "Unix->rel2abs('../t4','/t1/t2/t3')",          '/t1/t2/t3/../t4' ],
+[ "Unix->rel2abs('/t1','/t1/t2/t3')",            '/t1'             ],
+
+[ "Win32->splitpath('file')",                            ',,file'                            ],
+[ "Win32->splitpath('\\d1/d2\\d3/')",                    ',\\d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('d1/d2\\d3/')",                      ',d1/d2\\d3/,'                      ],
+[ "Win32->splitpath('\\d1/d2\\d3/.')",                   ',\\d1/d2\\d3/.,'                   ],
+[ "Win32->splitpath('\\d1/d2\\d3/..')",                  ',\\d1/d2\\d3/..,'                  ],
+[ "Win32->splitpath('\\d1/d2\\d3/.file')",               ',\\d1/d2\\d3/,.file'               ],
+[ "Win32->splitpath('\\d1/d2\\d3/file')",                ',\\d1/d2\\d3/,file'                ],
+[ "Win32->splitpath('d1/d2\\d3/file')",                  ',d1/d2\\d3/,file'                  ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/')",                  'C:,\\d1/d2\\d3/,'                  ],
+[ "Win32->splitpath('C:d1/d2\\d3/')",                    'C:,d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('C:\\d1/d2\\d3/file')",              'C:,\\d1/d2\\d3/,file'              ],
+[ "Win32->splitpath('C:d1/d2\\d3/file')",                'C:,d1/d2\\d3/,file'                ],
+[ "Win32->splitpath('C:\\../d2\\d3/file')",              'C:,\\../d2\\d3/,file'              ],
+[ "Win32->splitpath('C:../d2\\d3/file')",                'C:,../d2\\d3/,file'                ],
+[ "Win32->splitpath('\\../..\\d1/')",                    ',\\../..\\d1/,'                    ],
+[ "Win32->splitpath('\\./.\\d1/')",                      ',\\./.\\d1/,'                      ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/')",     '\\\\node\\share,\\d1/d2\\d3/,'     ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/file')", '\\\\node\\share,\\d1/d2\\d3/,file' ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\file')",    '\\\\node\\share,\\d1/d2\\,file'    ],
+[ "Win32->splitpath('file',1)",                          ',file,'                            ],
+[ "Win32->splitpath('\\d1/d2\\d3/',1)",                  ',\\d1/d2\\d3/,'                    ],
+[ "Win32->splitpath('d1/d2\\d3/',1)",                    ',d1/d2\\d3/,'                      ],
+[ "Win32->splitpath('\\\\node\\share\\d1/d2\\d3/',1)",   '\\\\node\\share,\\d1/d2\\d3/,'     ],
+
+[ "Win32->catpath('','','file')",                            'file'                            ],
+[ "Win32->catpath('','\\d1/d2\\d3/','')",                    '\\d1/d2\\d3/'                    ],
+[ "Win32->catpath('','d1/d2\\d3/','')",                      'd1/d2\\d3/'                      ],
+[ "Win32->catpath('','\\d1/d2\\d3/.','')",                   '\\d1/d2\\d3/.'                   ],
+[ "Win32->catpath('','\\d1/d2\\d3/..','')",                  '\\d1/d2\\d3/..'                  ],
+[ "Win32->catpath('','\\d1/d2\\d3/','.file')",               '\\d1/d2\\d3/.file'               ],
+[ "Win32->catpath('','\\d1/d2\\d3/','file')",                '\\d1/d2\\d3/file'                ],
+[ "Win32->catpath('','d1/d2\\d3/','file')",                  'd1/d2\\d3/file'                  ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','')",                  'C:\\d1/d2\\d3/'                  ],
+[ "Win32->catpath('C:','d1/d2\\d3/','')",                    'C:d1/d2\\d3/'                    ],
+[ "Win32->catpath('C:','\\d1/d2\\d3/','file')",              'C:\\d1/d2\\d3/file'              ],
+[ "Win32->catpath('C:','d1/d2\\d3/','file')",                'C:d1/d2\\d3/file'                ],
+[ "Win32->catpath('C:','\\../d2\\d3/','file')",              'C:\\../d2\\d3/file'              ],
+[ "Win32->catpath('C:','../d2\\d3/','file')",                'C:../d2\\d3/file'                ],
+[ "Win32->catpath('','\\../..\\d1/','')",                    '\\../..\\d1/'                    ],
+[ "Win32->catpath('','\\./.\\d1/','')",                      '\\./.\\d1/'                      ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','')",     '\\\\node\\share\\d1/d2\\d3/'     ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\d3/','file')", '\\\\node\\share\\d1/d2\\d3/file' ],
+[ "Win32->catpath('\\\\node\\share','\\d1/d2\\','file')",    '\\\\node\\share\\d1/d2\\file'    ],
+
+[ "Win32->splitdir('')",             ''           ],
+[ "Win32->splitdir('\\d1/d2\\d3/')", ',d1,d2,d3,' ],
+[ "Win32->splitdir('d1/d2\\d3/')",   'd1,d2,d3,'  ],
+[ "Win32->splitdir('\\d1/d2\\d3')",  ',d1,d2,d3'  ],
+[ "Win32->splitdir('d1/d2\\d3')",    'd1,d2,d3'   ],
+
+[ "Win32->catdir()",                        ''                   ],
+[ "Win32->catdir('')",                      '\\'                 ],
+[ "Win32->catdir('/')",                     '\\'                 ],
+[ "Win32->catdir('//d1','d2')",             '\\\\d1\\d2'         ],
+[ "Win32->catdir('','/d1','d2')",           '\\\\d1\\d2'         ],
+[ "Win32->catdir('','','/d1','d2')",        '\\\\\\d1\\d2'       ],
+[ "Win32->catdir('','//d1','d2')",          '\\\\\\d1\\d2'       ],
+[ "Win32->catdir('','','//d1','d2')",       '\\\\\\\\d1\\d2'     ],
+[ "Win32->catdir('','d1','','d2','')",      '\\d1\\d2'           ],
+[ "Win32->catdir('','d1','d2','d3','')",    '\\d1\\d2\\d3'       ],
+[ "Win32->catdir('d1','d2','d3','')",       'd1\\d2\\d3'         ],
+[ "Win32->catdir('','d1','d2','d3')",       '\\d1\\d2\\d3'       ],
+[ "Win32->catdir('d1','d2','d3')",          'd1\\d2\\d3'         ],
+[ "Win32->catdir('A:/d1','d2','d3')",       'A:\\d1\\d2\\d3'     ],
+[ "Win32->catdir('A:/d1','d2','d3','')",    'A:\\d1\\d2\\d3'     ],
+#[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\d2\\d3'     ],
+[ "Win32->catdir('A:/d1','B:/d2','d3','')", 'A:\\d1\\B:\\d2\\d3' ],
+[ "Win32->catdir('A:/')",                   'A:\\'               ],
+
+[ "Win32->catfile('a','b','c')", 'a\\b\\c' ],
+
+[ "Win32->canonpath('')",               ''                    ],
+[ "Win32->canonpath('a:')",             'A:'                  ],
+[ "Win32->canonpath('A:f')",            'A:f'                 ],
+[ "Win32->canonpath('//a\\b//c')",      '\\\\a\\b\\c'         ],
+[ "Win32->canonpath('/a/..../c')",      '\\a\\....\\c'        ],
+[ "Win32->canonpath('//a/b\\c')",       '\\\\a\\b\\c'         ],
+[ "Win32->canonpath('////')",           '\\\\\\'              ],
+[ "Win32->canonpath('//')",             '\\'                  ],
+[ "Win32->canonpath('/.')",             '\\.'                 ],
+[ "Win32->canonpath('//a/b/../../c')",  '\\\\a\\b\\..\\..\\c' ],
+[ "Win32->canonpath('//a/../../c')",    '\\\\a\\..\\..\\c'    ],
+
+[  "Win32->abs2rel('/t1/t2/t3','/t1/t2/t3')",    ''                       ],
+[  "Win32->abs2rel('/t1/t2/t4','/t1/t2/t3')",    '..\\t4'                 ],
+[  "Win32->abs2rel('/t1/t2','/t1/t2/t3')",       '..'                     ],
+[  "Win32->abs2rel('/t1/t2/t3/t4','/t1/t2/t3')", 't4'                     ],
+[  "Win32->abs2rel('/t4/t5/t6','/t1/t2/t3')",    '..\\..\\..\\t4\\t5\\t6' ],
+#[ "Win32->abs2rel('../t4','/t1/t2/t3')",        '\\t1\\t2\\t3\\..\\t4'   ],
+[  "Win32->abs2rel('/','/t1/t2/t3')",            '..\\..\\..'             ],
+[  "Win32->abs2rel('///','/t1/t2/t3')",          '..\\..\\..'             ],
+[  "Win32->abs2rel('/.','/t1/t2/t3')",           '..\\..\\..\\.'          ],
+[  "Win32->abs2rel('/./','/t1/t2/t3')",          '..\\..\\..'             ],
+[  "Win32->abs2rel('\\\\a/t1/t2/t4','/t2/t3')",  '..\\t4'                 ],
+[  "Win32->abs2rel('//a/t1/t2/t4','/t2/t3')",    '..\\t4'                 ],
+
+[ "Win32->rel2abs('temp','C:/')",                       'C:\\temp'                        ],
+[ "Win32->rel2abs('temp','C:/a')",                      'C:\\a\\temp'                     ],
+[ "Win32->rel2abs('temp','C:/a/')",                     'C:\\a\\temp'                     ],
+[ "Win32->rel2abs('../','C:/')",                        'C:\\..'                          ],
+[ "Win32->rel2abs('../','C:/a')",                       'C:\\a\\..'                       ],
+[ "Win32->rel2abs('temp','//prague_main/work/')",       '\\\\prague_main\\work\\temp'     ],
+[ "Win32->rel2abs('../temp','//prague_main/work/')",    '\\\\prague_main\\work\\..\\temp' ],
+[ "Win32->rel2abs('temp','//prague_main/work')",        '\\\\prague_main\\work\\temp'     ],
+[ "Win32->rel2abs('../','//prague_main/work')",         '\\\\prague_main\\work\\..'       ],
+
+[ "VMS->splitpath('file')",                                       ',,file'                                   ],
+[ "VMS->splitpath('[d1.d2.d3]')",                                 ',[d1.d2.d3],'                               ],
+[ "VMS->splitpath('[.d1.d2.d3]')",                                ',[.d1.d2.d3],'                              ],
+[ "VMS->splitpath('[d1.d2.d3]file')",                             ',[d1.d2.d3],file'                           ],
+[ "VMS->splitpath('d1/d2/d3/file')",                              ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('/d1/d2/d3/file')",                             'd1:,[d2.d3],file'                         ],
+[ "VMS->splitpath('[.d1.d2.d3]file')",                            ',[.d1.d2.d3],file'                          ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]')",                    'node::volume:,[d1.d2.d3],'                  ],
+[ "VMS->splitpath('node::volume:[d1.d2.d3]file')",                'node::volume:,[d1.d2.d3],file'              ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]')",     'node"access_spec"::volume:,[d1.d2.d3],'     ],
+[ "VMS->splitpath('node\"access_spec\"::volume:[d1.d2.d3]file')", 'node"access_spec"::volume:,[d1.d2.d3],file' ],
+
+[ "VMS->catpath('','','file')",                                       'file'                                     ],
+[ "VMS->catpath('','[d1.d2.d3]','')",                                 '[d1.d2.d3]'                               ],
+[ "VMS->catpath('','[.d1.d2.d3]','')",                                '[.d1.d2.d3]'                              ],
+[ "VMS->catpath('','[d1.d2.d3]','file')",                             '[d1.d2.d3]file'                           ],
+[ "VMS->catpath('','[.d1.d2.d3]','file')",                            '[.d1.d2.d3]file'                          ],
+[ "VMS->catpath('','d1/d2/d3','file')",                               '[.d1.d2.d3]file'                            ],
+[ "VMS->catpath('v','d1/d2/d3','file')",                              'v:[.d1.d2.d3]file'                            ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','')",                    'node::volume:[d1.d2.d3]'                  ],
+[ "VMS->catpath('node::volume:','[d1.d2.d3]','file')",                'node::volume:[d1.d2.d3]file'              ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','')",     'node"access_spec"::volume:[d1.d2.d3]'     ],
+[ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ],
+
+[ "VMS->canonpath('')",                                    ''                        ],
+[ "VMS->canonpath('volume:[d1]file')",                     'volume:[d1]file'         ],
+[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')",              'volume:[d2.d3]'          ],
+[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')",                 'volume:[d1]d2.dir;1'   ],
+
+[ "VMS->splitdir('')",            ''          ],
+[ "VMS->splitdir('[]')",          ''          ],
+[ "VMS->splitdir('d1.d2.d3')",    'd1,d2,d3'  ],
+[ "VMS->splitdir('[d1.d2.d3]')",  'd1,d2,d3'  ],
+[ "VMS->splitdir('.d1.d2.d3')",   ',d1,d2,d3' ],
+[ "VMS->splitdir('[.d1.d2.d3]')", ',d1,d2,d3' ],
+[ "VMS->splitdir('.-.d2.d3')",    ',-,d2,d3'  ],
+[ "VMS->splitdir('[.-.d2.d3]')",  ',-,d2,d3'  ],
+
+[ "VMS->catdir('')",                                                      ''                 ],
+[ "VMS->catdir('d1','d2','d3')",                                          '[.d1.d2.d3]'         ],
+[ "VMS->catdir('d1','d2/','d3')",                                         '[.d1.d2.d3]'         ],
+[ "VMS->catdir('','d1','d2','d3')",                                       '[.d1.d2.d3]'        ],
+[ "VMS->catdir('','-','d2','d3')",                                        '[-.d2.d3]'         ],
+[ "VMS->catdir('','-','','d3')",                                          '[-.d3]'            ],
+[ "VMS->catdir('dir.dir','d2.dir','d3.dir')",                             '[.dir.d2.d3]'        ],
+[ "VMS->catdir('[.name]')",                                               '[.name]'            ],
+[ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],    
+
+[  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", ''                 ],
+[  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]'           ],
+[  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              ''                 ],
+[  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')",          'file'             ],
+[  "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')",              '[-.t4]'           ],
+[  "VMS->abs2rel('[t1.t2]file','[t1.t2.t3]')",             '[-]file'          ],
+[  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[t4]'             ],
+[  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
+[ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---.000000]'     ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             '[-.t4]'           ],
+[ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],
+
+[ "VMS->rel2abs('[.t4]','[t1.t2.t3]')",          '[t1.t2.t3.t4]'    ],
+[ "VMS->rel2abs('[.t4.t5]','[t1.t2.t3]')",       '[t1.t2.t3.t4.t5]' ],
+[ "VMS->rel2abs('[]','[t1.t2.t3]')",             '[t1.t2.t3]'       ],
+[ "VMS->rel2abs('[-]','[t1.t2.t3]')",            '[t1.t2]'          ],
+[ "VMS->rel2abs('[-.t4]','[t1.t2.t3]')",         '[t1.t2.t4]'       ],
+[ "VMS->rel2abs('[t1]','[t1.t2.t3]')",           '[t1]'             ],
+
+[ "OS2->catdir('A:/d1','B:/d2','d3','')", 'A:/d1/B:/d2/d3' ],
+[ "OS2->catfile('a','b','c')",            'a/b/c'          ],
+
+[ "Mac->splitpath('file')",          ',,file'          ],
+[ "Mac->splitpath(':file')",         ',:,file'         ],
+[ "Mac->splitpath(':d1',1)",         ',:d1:,'          ],
+[ "Mac->splitpath('d1',1)",          'd1:,,'           ],
+[ "Mac->splitpath('d1:d2:d3:')",     'd1:,d2:d3:,'     ],
+[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
+[ "Mac->splitpath(':d1:d2:d3:')",    ',:d1:d2:d3:,'    ],
+[ "Mac->splitpath(':d1:d2:d3:',1)",  ',:d1:d2:d3:,'    ],
+[ "Mac->splitpath('d1:d2:d3:file')", 'd1:,d2:d3:,file' ],
+[ "Mac->splitpath('d1:d2:d3',1)",    'd1:,d2:d3:,'     ],
+
+[ "Mac->catdir('')",                ':'           ],
+[ "Mac->catdir('d1','d2','d3')",    'd1:d2:d3:'   ],
+[ "Mac->catdir('d1','d2/','d3')",   'd1:d2/:d3:'  ],
+[ "Mac->catdir('','d1','d2','d3')", ':d1:d2:d3:'  ],
+[ "Mac->catdir('','','d2','d3')",   '::d2:d3:'    ],
+[ "Mac->catdir('','','','d3')",     ':::d3:'      ],
+[ "Mac->catdir(':name')",           ':name:'      ],
+[ "Mac->catdir(':name',':name')",   ':name:name:' ],
+
+[ "Mac->catfile('a','b','c')", 'a:b:c' ],
+
+[ "Mac->canonpath('')",                   ''     ],
+[ "Mac->canonpath(':')",                  ':'    ],
+[ "Mac->canonpath('::')",                 '::'   ],
+[ "Mac->canonpath('a::')",                'a::'  ],
+[ "Mac->canonpath(':a::')",               ':a::' ],
+
+[ "Mac->abs2rel('t1:t2:t3','t1:t2:t3')",    ':'            ],
+[ "Mac->abs2rel('t1:t2','t1:t2:t3')",       '::'           ],
+[ "Mac->abs2rel('t1:t4','t1:t2:t3')",       ':::t4'        ],
+[ "Mac->abs2rel('t1:t2:t4','t1:t2:t3')",    '::t4'         ],
+[ "Mac->abs2rel('t1:t2:t3:t4','t1:t2:t3')", ':t4'          ],
+[ "Mac->abs2rel('t4:t5:t6','t1:t2:t3')",    '::::t4:t5:t6' ],
+[ "Mac->abs2rel('t1','t1:t2:t3')",          ':::'          ],
+
+[ "Mac->rel2abs(':t4','t1:t2:t3')",          't1:t2:t3:t4'    ],
+[ "Mac->rel2abs(':t4:t5','t1:t2:t3')",       't1:t2:t3:t4:t5' ],
+[ "Mac->rel2abs('','t1:t2:t3')",             ''               ],
+[ "Mac->rel2abs('::','t1:t2:t3')",           't1:t2:t3::'     ],
+[ "Mac->rel2abs('::t4','t1:t2:t3')",         't1:t2:t3::t4'   ],
+[ "Mac->rel2abs('t1','t1:t2:t3')",           't1'             ],
+) ;
+
+# Grab all of the plain routines from File::Spec
+use File::Spec @File::Spec::EXPORT_OK ;
+
+require File::Spec::Unix ;
+require File::Spec::Win32 ;
+
+eval {
+   require VMS::Filespec ;
+} ;
+
+my $skip_exception = "Install VMS::Filespec (from vms/ext)" ;
+
+if ( $@ ) {
+   # Not pretty, but it allows testing of things not implemented soley
+   # on VMS.  It might be better to change File::Spec::VMS to do this,
+   # making it more usable when running on (say) Unix but working with
+   # VMS paths.
+   eval qq-
+      sub File::Spec::VMS::vmsify  { die "$skip_exception" }
+      sub File::Spec::VMS::unixify { die "$skip_exception" }
+      sub File::Spec::VMS::vmspath { die "$skip_exception" }
+   - ;
+   $INC{"VMS/Filespec.pm"} = 1 ;
+}
+require File::Spec::VMS ;
+
+require File::Spec::OS2 ;
+require File::Spec::Mac ;
+
+print "1..", scalar( @tests ), "\n" ;
+
+my $current_test= 1 ;
+
+# Test out the class methods
+for ( @tests ) {
+   tryfunc( @$_ ) ;
+}
+
+
+
+#
+# Tries a named function with the given args and compares the result against
+# an expected result. Works with functions that return scalars or arrays.
+#
+sub tryfunc {
+    my $function = shift ;
+    my $expected = shift ;
+    my $platform = shift ;
+
+    if ($platform && $^O ne $platform) {
+	print "ok $current_test # skipped: $function\n" ;
+	++$current_test ;
+	return;
+    }
+
+    $function =~ s#\\#\\\\#g ;
+
+    my $got ;
+    if ( $function =~ /^[^\$].*->/ ) {
+	$got = eval( "join( ',', File::Spec::$function )" ) ;
+    }
+    else {
+	$got = eval( "join( ',', $function )" ) ;
+    }
+
+    if ( $@ ) {
+        if ( substr( $@, 0, length $skip_exception ) eq $skip_exception ) {
+	    chomp $@ ;
+	    print "ok $current_test # skip $function: $@\n" ;
+	}
+	else {
+	    chomp $@ ;
+	    print "not ok $current_test # $function: $@\n" ;
+	}
+    }
+    elsif ( !defined( $got ) || $got ne $expected ) {
+	print "not ok $current_test # $function: got '$got', expected '$expected'\n" ;
+    }
+    else {
+	print "ok $current_test # $function\n" ;
+    }
+    ++$current_test ;
+}
diff --git a/lib/File/Spec/Functions.t b/lib/File/Spec/Functions.t
new file mode 100755
index 0000000000..926812248c
--- /dev/null
+++ b/lib/File/Spec/Functions.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::Spec::Functions;
+
+if (catfile('a','b','c') eq 'a/b/c') {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}
diff --git a/lib/File/Temp/mktemp.t b/lib/File/Temp/mktemp.t
new file mode 100755
index 0000000000..4e31d01a3f
--- /dev/null
+++ b/lib/File/Temp/mktemp.t
@@ -0,0 +1,115 @@
+#!/usr/bin/perl -w
+
+# Test for mktemp family of commands in File::Temp
+# Use STANDARD safe level for these tests
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 9);
+}
+
+use strict;
+
+use File::Spec;
+use File::Path;
+use File::Temp qw/ :mktemp unlink0 /;
+use FileHandle;
+
+ok(1);
+
+# MKSTEMP - test
+
+# Create file in temp directory
+my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
+
+(my $fh, $template) = mkstemp($template);
+
+print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $template) );
+
+# Autoflush
+$fh->autoflush(1) if $] >= 5.006;
+
+# Try printing something to the file
+my $string = "woohoo\n";
+print $fh $string;
+
+# rewind the file
+ok(seek( $fh, 0, 0));
+
+# Read from the file
+my $line = <$fh>;
+
+# compare with previous string
+ok($string, $line);
+
+# Tidy up
+# This test fails on Windows NT since it seems that the size returned by 
+# stat(filehandle) does not always equal the size of the stat(filename)
+# This must be due to caching. In particular this test writes 7 bytes
+# to the file which are not recognised by stat(filename)
+# Simply waiting 3 seconds seems to be enough for the system to update
+
+if ($^O eq 'MSWin32') {
+  sleep 3;
+}
+my $status = unlink0($fh, $template);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# MKSTEMPS
+# File with suffix. This is created in the current directory so
+# may be problematic on NFS
+
+$template = "suffixXXXXXX";
+my $suffix = ".dat";
+
+($fh, my $fname) = mkstemps($template, $suffix);
+
+print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $fname) );
+
+# This fails if you are running on NFS
+# If this test fails simply skip it rather than doing a hard failure
+$status = unlink0($fh, $fname);
+
+if ($status) {
+  ok($status);
+} else {
+  skip("Skip test failed probably due to cwd being on NFS",1)
+}
+
+# MKDTEMP
+# Temp directory
+
+$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
+
+my $tmpdir = mkdtemp($template);
+
+print "# MKDTEMP: Name is $tmpdir from template $template\n";
+
+ok( (-d $tmpdir ) );
+
+# Need to tidy up after myself
+rmtree($tmpdir);
+
+# MKTEMP
+# Just a filename, not opened
+
+$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
+
+my $tmpfile = mktemp($template);
+
+print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
+
+# Okay if template no longer has XXXXX in
+
+
+ok( ($tmpfile !~ /XXXXX$/) );
diff --git a/lib/File/Temp/posix.t b/lib/File/Temp/posix.t
new file mode 100755
index 0000000000..0a5e86061b
--- /dev/null
+++ b/lib/File/Temp/posix.t
@@ -0,0 +1,83 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - POSIX functions
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 7);
+}
+
+use strict;
+
+use File::Temp qw/ :POSIX unlink0 /;
+use FileHandle;
+
+ok(1);
+
+# TMPNAM - scalar
+
+print "# TMPNAM: in a scalar context: \n";
+my $tmpnam = tmpnam();
+
+# simply check that the file does not exist
+# Not a 100% water tight test though if another program 
+# has managed to create one in the meantime.
+ok( !(-e $tmpnam ));
+
+print "# TMPNAM file name: $tmpnam\n";
+
+# TMPNAM list context
+# Not strict posix behaviour
+(my $fh, $tmpnam) = tmpnam();
+
+print "# TMPNAM: in list context: $fh $tmpnam\n";
+
+# File is opened - make sure it exists
+ok( (-e $tmpnam ));
+
+# Unlink it - a possible NFS issue again if TMPDIR is not a local disk
+my $status = unlink0($fh, $tmpnam);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# TMPFILE
+
+$fh = tmpfile();
+
+if (defined $fh) {
+  ok( $fh );
+  print "# TMPFILE: tmpfile got FH $fh\n";
+
+  $fh->autoflush(1) if $] >= 5.006;
+
+  # print something to it
+  my $original = "Hello a test\n";
+  print "# TMPFILE: Wrote line: $original";
+  print $fh $original
+    or die "Error printing to tempfile\n";
+
+  # rewind it
+  ok( seek($fh,0,0) );
+
+  # Read from it
+  my $line = <$fh>;
+
+  print "# TMPFILE: Read line: $line";
+  ok( $original, $line);
+
+  close($fh);
+
+} else {
+  # Skip all the remaining tests
+  foreach (1..3) {
+    skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+  }
+}
+
+
+
+
diff --git a/lib/File/Temp/security.t b/lib/File/Temp/security.t
new file mode 100755
index 0000000000..f9be237dd3
--- /dev/null
+++ b/lib/File/Temp/security.t
@@ -0,0 +1,140 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - Security levels
+
+# Some of the security checking will not work on all platforms
+# Test a simple open in the cwd and tmpdir foreach of the
+# security levels
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 13);
+}
+
+use strict;
+use File::Spec;
+
+# Set up END block - this needs to happen before we load
+# File::Temp since this END block must be evaluated after the
+# END block configured by File::Temp
+my @files; # list of files to remove
+END { foreach (@files) { ok( !(-e $_) )} }
+
+use File::Temp qw/ tempfile unlink0 /;
+ok(1);
+
+# The high security tests must currently be skipped on some platforms
+my $skipplat = ( (
+		  # No sticky bits.
+		  $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'os2' || $^O eq 'dos'
+		  ) ? 1 : 0 );
+
+# Can not run high security tests in perls before 5.6.0
+my $skipperl  = ($] < 5.006 ? 1 : 0 );
+
+# Determine whether we need to skip things and why
+my $skip = 0;
+if ($skipplat) {
+  $skip = "Skip Not supported on this platform";
+} elsif ($skipperl) {
+  $skip = "Skip Perl version must be v5.6.0 for these tests";
+
+}
+
+print "# We will be skipping some tests : $skip\n" if $skip;
+
+# start off with basic checking
+
+File::Temp->safe_level( File::Temp::STANDARD );
+
+print "# Testing with STANDARD security...\n";
+
+&test_security(0);
+
+# Try medium
+
+File::Temp->safe_level( File::Temp::MEDIUM )
+  unless $skip;
+
+print "# Testing with MEDIUM security...\n";
+
+# Now we need to start skipping tests
+&test_security($skip);
+
+# Try HIGH
+
+File::Temp->safe_level( File::Temp::HIGH )
+  unless $skip;
+
+print "# Testing with HIGH security...\n";
+
+&test_security($skip);
+
+exit;
+
+# Subroutine to open two temporary files.
+# one is opened in the current dir and the other in the temp dir
+
+sub test_security {
+
+  # Read in the skip flag
+  my $skip = shift;
+
+  # If we are skipping we need to simply fake the correct number
+  # of tests -- we dont use skip since the tempfile() commands will
+  # fail with MEDIUM/HIGH security before the skip() command would be run
+  if ($skip) {
+
+    skip($skip,1);
+    skip($skip,1);
+
+    # plus we need an end block so the tests come out in the right order
+    eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
+
+    return;
+  }
+
+  # Create the tempfile
+  my $template = "tmpXXXXX";
+  my ($fh1, $fname1) = eval { tempfile ( $template, 
+				  DIR => File::Spec->tmpdir,
+				  UNLINK => 1,
+				);
+			    };
+
+  if (defined $fname1) {
+      print "# fname1 = $fname1\n";
+      ok( (-e $fname1) );
+      push(@files, $fname1); # store for end block
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+  # Explicitly 
+  if ( $< < File::Temp->top_system_uid() ){
+      skip("Skip Test inappropriate for root", 1);
+      eval q{ END { skip($skip,1); } 1; } || die;
+      return;
+  }
+  my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
+  if (defined $fname2) {
+      print "# fname2 = $fname2\n";
+      ok( (-e $fname2) );
+      push(@files, $fname2); # store for end block
+      close($fh2);
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+}
diff --git a/lib/File/Temp/tempfile.t b/lib/File/Temp/tempfile.t
new file mode 100755
index 0000000000..ed59765a75
--- /dev/null
+++ b/lib/File/Temp/tempfile.t
@@ -0,0 +1,145 @@
+#!/usr/local/bin/perl -w
+# Test for File::Temp - tempfile function
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 20);
+}
+
+use strict;
+use File::Spec;
+
+# Will need to check that all files were unlinked correctly
+# Set up an END block here to do it
+
+# Arrays containing list of dirs/files to test
+my (@files, @dirs, @still_there);
+
+# And a test for files that should still be around
+# These are tidied up
+END {
+  foreach (@still_there) {
+    ok( -f $_ );
+    ok( unlink( $_ ) );
+    ok( !(-f $_) );
+  }
+}
+
+# Loop over an array hoping that the files dont exist
+END { foreach (@files) { ok( !(-e $_) )} }
+
+# And a test for directories
+END { foreach (@dirs)  { ok( !(-d $_) )} }
+
+# Need to make sure that the END blocks are setup before
+# the ones that File::Temp configures since END blocks are evaluated
+# in revers order and we need to check the files *after* File::Temp
+# removes them
+use File::Temp qw/ tempfile tempdir/;
+
+# Now we start the tests properly
+ok(1);
+
+
+# Tempfile
+# Open tempfile in some directory, unlink at end
+my ($fh, $tempfile) = tempfile(
+			       UNLINK => 1,
+			       SUFFIX => '.txt',
+			      );
+
+ok( (-f $tempfile) );
+# Should still be around after closing
+ok( close( $fh ) ); 
+ok( (-f $tempfile) );
+# Check again at exit
+push(@files, $tempfile);
+
+# TEMPDIR test
+# Create temp directory in current dir
+my $template = 'tmpdirXXXXXX';
+print "# Template: $template\n";
+my $tempdir = tempdir( $template ,
+		       DIR => File::Spec->curdir,
+		       CLEANUP => 1,
+		     );
+
+print "# TEMPDIR: $tempdir\n";
+
+ok( (-d $tempdir) );
+push(@dirs, $tempdir);
+
+# Create file in the temp dir
+($fh, $tempfile) = tempfile(
+			    DIR => $tempdir,
+			    UNLINK => 1,
+			    SUFFIX => '.dat',
+			   );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile));
+push(@files, $tempfile);
+
+# Test tempfile
+# ..and again
+($fh, $tempfile) = tempfile(
+			    DIR => $tempdir,
+			   );
+
+
+ok( (-f $tempfile ));
+push(@files, $tempfile);
+
+print "# TEMPFILE: Created $tempfile\n";
+
+# and another (with template)
+
+($fh, $tempfile) = tempfile( 'helloXXXXXXX',
+			    DIR => $tempdir,
+			    UNLINK => 1,
+			    SUFFIX => '.dat',
+			   );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile) );
+push(@files, $tempfile);
+
+
+# Create a temporary file that should stay around after
+# it has been closed
+($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
+print "# TEMPFILE: Created $tempfile\n";
+ok( -f $tempfile );
+ok( close( $fh ) );
+push( @still_there, $tempfile); # check at END
+
+# Would like to create a temp file and just retrieve the handle
+# but the test is problematic since:
+#  - We dont know the filename so we cant check that it is tidied
+#    correctly
+#  - The unlink0 required on unix for tempfile creation will fail
+#    on NFS
+# Try to do what we can.
+# Tempfile croaks on error so we need an eval
+$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
+
+if ($fh) {
+
+  # print something to it to make sure something is there
+  ok( print $fh "Test\n" );
+
+  # Close it - can not check it is gone since we dont know the name
+  ok( close($fh) );
+
+} else {
+  skip "Skip Failed probably due to NFS", 1;
+  skip "Skip Failed probably due to NFS", 1;
+}
+
+# Now END block will execute to test the removal of directories
+print "# End of tests. Execute END blocks\n";
+
diff --git a/lib/File/stat.t b/lib/File/stat.t
new file mode 100644
index 0000000000..ac6d95f745
--- /dev/null
+++ b/lib/File/stat.t
@@ -0,0 +1,70 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasst;
+    eval { my @n = stat "TEST" };
+    $hasst = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasst) { print "1..0 # Skip: no stat\n"; exit 0 }
+    use Config;
+    $hasst = 0 unless $Config{'i_sysstat'} eq 'define';
+    unless ($hasst) { print "1..0 # Skip: no sys/stat.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @stat = stat "TEST"; # This is the function stat.
+    unless (@stat) { print "1..0 # Skip: no file TEST\n"; exit 0 }
+}
+
+print "1..14\n";
+
+use File::stat;
+
+print "ok 1\n";
+
+my $stat = stat "TEST"; # This is the OO stat.
+
+print "not " unless $stat->dev     == $stat[ 0];
+print "ok 2\n";
+
+print "not " unless $stat->ino     == $stat[ 1];
+print "ok 3\n";
+
+print "not " unless $stat->mode    == $stat[ 2];
+print "ok 4\n";
+
+print "not " unless $stat->nlink   == $stat[ 3];
+print "ok 5\n";
+
+print "not " unless $stat->uid     == $stat[ 4];
+print "ok 6\n";
+
+print "not " unless $stat->gid     == $stat[ 5];
+print "ok 7\n";
+
+print "not " unless $stat->rdev    == $stat[ 6];
+print "ok 8\n";
+
+print "not " unless $stat->size    == $stat[ 7];
+print "ok 9\n";
+
+print "not " unless $stat->atime   == $stat[ 8];
+print "ok 10\n";
+
+print "not " unless $stat->mtime   == $stat[ 9];
+print "ok 11\n";
+
+print "not " unless $stat->ctime   == $stat[10];
+print "ok 12\n";
+
+print "not " unless $stat->blksize == $stat[11];
+print "ok 13\n";
+
+print "not " unless $stat->blocks  == $stat[12];
+print "ok 14\n";
+
+# Testing pretty much anything else is unportable.
diff --git a/lib/FileCache.t b/lib/FileCache.t
new file mode 100755
index 0000000000..a97fdd532c
--- /dev/null
+++ b/lib/FileCache.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FileCache;
+
+# This is really not a complete test as I don't bother to open enough
+# files to make real swapping of open filedescriptor happen.
+
+$path = "foo";
+cacheout $path;
+
+print $path "\n";
+
+close $path;
+
+print "not " unless -f $path;
+print "ok 1\n";
+
+unlink $path;
diff --git a/lib/FileHandle.t b/lib/FileHandle.t
new file mode 100755
index 0000000000..eaddf496db
--- /dev/null
+++ b/lib/FileHandle.t
@@ -0,0 +1,91 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use FileHandle;
+use strict subs;
+
+autoflush STDOUT 1;
+
+$mystdout = new_from_fd FileHandle 1,"w";
+$| = 1;
+autoflush $mystdout;
+print "1..11\n";
+
+print $mystdout "ok ".fileno($mystdout)."\n";
+
+$fh = (new FileHandle "./TEST", O_RDONLY
+       or new FileHandle "TEST", O_RDONLY)
+  and print "ok 2\n";
+
+
+$buffer = <$fh>;
+print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
+
+
+ungetc $fh ord 'A';
+CORE::read($fh, $buf,1);
+print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
+
+close $fh;
+
+$fh = new FileHandle;
+
+print "not " unless ($fh->open("< TEST") && <$fh> eq $buffer);
+print "ok 5\n";
+
+$fh->seek(0,0);
+print "#possible mixed CRLF/LF in t/TEST\nnot " unless (<$fh> eq $buffer);
+print "ok 6\n";
+
+$fh->seek(0,2);
+$line = <$fh>;
+print "not " if (defined($line) || !$fh->eof);
+print "ok 7\n";
+
+print "not " unless ($fh->open("TEST","r") && !$fh->tell && $fh->close);
+print "ok 8\n";
+
+autoflush STDOUT 0;
+
+print "not " if ($|);
+print "ok 9\n";
+
+autoflush STDOUT 1;
+
+print "not " unless ($|);
+print "ok 10\n";
+
+if ($^O eq 'dos')
+{
+    printf("ok %d\n",11);
+    exit(0);
+}
+
+($rd,$wr) = FileHandle::pipe;
+
+if ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'MSWin32' || $^O eq 'NetWare' ||
+    $Config{d_fork} ne 'define') {
+  $wr->autoflush;
+  $wr->printf("ok %d\n",11);
+  print $rd->getline;
+}
+else {
+  if (fork) {
+   $wr->close;
+   print $rd->getline;
+  }
+  else {
+   $rd->close;
+   $wr->printf("ok %d\n",11);
+   exit(0);
+  }
+}
diff --git a/lib/Filter/Simple/test.pl b/lib/Filter/Simple/test.pl
new file mode 100644
index 0000000000..3fb32701c5
--- /dev/null
+++ b/lib/Filter/Simple/test.pl
@@ -0,0 +1,27 @@
+#!./perl
+
+BEGIN {
+    chdir('t') if -d 't';    
+    @INC = 'lib';
+}
+
+print "1..6\n";
+
+use MyFilter qr/not ok/ => "ok", fail => "ok";
+
+sub fail { print "fail ", $_[0], "\n" }
+
+print "not ok 1\n";
+print "fail 2\n";
+
+fail(3);
+&fail(4);
+
+print "not " unless "whatnot okapi" eq "whatokapi";
+print "ok 5\n";
+
+no MyFilter;
+
+print "not " unless "not ok" =~ /^not /;
+print "ok 6\n";
+
diff --git a/lib/FindBin.t b/lib/FindBin.t
new file mode 100755
index 0000000000..d07ce755ca
--- /dev/null
+++ b/lib/FindBin.t
@@ -0,0 +1,15 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FindBin qw($Bin);
+
+print "# $Bin\n";
+
+print "not " unless $Bin =~ m,[/.]lib\]?$,;
+print "ok 1\n";
diff --git a/lib/Getopt/Long/basic.t b/lib/Getopt/Long/basic.t
new file mode 100755
index 0000000000..c5d857d5b8
--- /dev/null
+++ b/lib/Getopt/Long/basic.t
@@ -0,0 +1,26 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long qw(:config no_ignore_case);
+die("Getopt::Long version 2.24 required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION >= 2.24;
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if GetOptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/lib/Getopt/Long/compat.t b/lib/Getopt/Long/compat.t
new file mode 100755
index 0000000000..0bbe386846
--- /dev/null
+++ b/lib/Getopt/Long/compat.t
@@ -0,0 +1,25 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+require "newgetopt.pl";
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+$newgetopt::ignorecase = 0;
+$newgetopt::ignorecase = 0;
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if NGetOpt ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/lib/Getopt/Long/linkage.t b/lib/Getopt/Long/linkage.t
new file mode 100755
index 0000000000..3bd81a3552
--- /dev/null
+++ b/lib/Getopt/Long/linkage.t
@@ -0,0 +1,37 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long;
+
+print "1..18\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("no_ignore_case");
+%lnk = ();
+print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s");
+print ((defined $lnk{foo})   ? "" : "not ", "ok 2\n");
+print (($lnk{foo} == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 4\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 7\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 8\n");
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("default","no_ignore_case");
+%lnk = ();
+my $foo;
+print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s");
+print ((defined $foo)        ? "" : "not ", "ok 10\n");
+print (($foo == 1)           ? "" : "not ", "ok 11\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 12\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 14\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");
diff --git a/lib/Getopt/Long/oo.t b/lib/Getopt/Long/oo.t
new file mode 100644
index 0000000000..98f3eaadb9
--- /dev/null
+++ b/lib/Getopt/Long/oo.t
@@ -0,0 +1,26 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long;
+die("Getopt::Long version 2.24 required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION >= 2.24;
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+my $p = new Getopt::Long::Parser (config => ["no_ignore_case"]);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if $p->getoptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/lib/Getopt/Std.t b/lib/Getopt/Std.t
new file mode 100755
index 0000000000..fb70f10aae
--- /dev/null
+++ b/lib/Getopt/Std.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..11\n";
+
+use Getopt::Std;
+
+# First we test the getopt function
+@ARGV = qw(-xo -f foo -y file);
+getopt('f');
+
+print "not " if "@ARGV" ne 'file';
+print "ok 1\n";
+
+print "not " unless $opt_x && $opt_o && opt_y;
+print "ok 2\n";
+
+print "not " unless $opt_f eq 'foo';
+print "ok 3\n";
+
+
+# Then we try the getopts
+$opt_o = $opt_i = $opt_f = undef;
+@ARGV = qw(-foi -i file);
+getopts('oif:') or print "not ";
+print "ok 4\n";
+
+print "not " unless "@ARGV" eq 'file';
+print "ok 5\n";
+
+print "not " unless $opt_i and $opt_f eq 'oi';
+print "ok 6\n";
+
+print "not " if $opt_o;
+print "ok 7\n";
+
+# Try illegal options, but avoid printing of the error message
+
+open(STDERR, ">stderr") || die;
+
+@ARGV = qw(-h help);
+
+!getopts("xf:y") or print "not ";
+print "ok 8\n";
+
+
+# Then try the Getopt::Long module
+
+use Getopt::Long;
+
+@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
+
+GetOptions(
+   'help'   => \$HELP,
+   'file:s' => \$FILE,
+   'foo!'   => \$FOO,
+   'bar!'   => \$BAR,
+   'num:i'  => \$NO,
+) || print "not ";
+print "ok 9\n";
+
+print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5;
+print "ok 10\n";
+
+print "not " unless "@ARGV" eq "file";
+print "ok 11\n";
+
+close STDERR;
+unlink "stderr";
diff --git a/lib/I18N/Collate.t b/lib/I18N/Collate.t
new file mode 100644
index 0000000000..bf3ba20b6a
--- /dev/null
+++ b/lib/I18N/Collate.t
@@ -0,0 +1,44 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
+	print "1..0\n";
+	exit;
+    }
+}
+
+print "1..7\n";
+
+use I18N::Collate;
+
+print "ok 1\n";
+
+$a = I18N::Collate->new("foo");
+
+print "ok 2\n";
+
+{
+    use warnings;
+    local $SIG{__WARN__} = sub { $@ = $_[0] };
+    $b = I18N::Collate->new("foo");
+    print "not " unless $@ =~ /\bHAS BEEN DEPRECATED\b/;
+    print "ok 3\n";
+    $@ = '';
+}
+
+print "not " unless $a eq $b;
+print "ok 4\n";
+
+$b = I18N::Collate->new("bar");
+print "not " if $@ =~ /\bHAS BEEN DEPRECATED\b/;
+print "ok 5\n";
+
+print "not " if $a eq $b;
+print "ok 6\n";
+
+print "not " if $a lt $b == $a gt $b;
+print "ok 7\n";
+
diff --git a/lib/I18N/LangTags/test.pl b/lib/I18N/LangTags/test.pl
new file mode 100644
index 0000000000..06c178ef27
--- /dev/null
+++ b/lib/I18N/LangTags/test.pl
@@ -0,0 +1,45 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+######################### We start with some black magic to print on failure.
+require 5;
+
+use strict;
+use Test;
+BEGIN { plan tests => 23 };
+BEGIN { ok 1 }
+use I18N::LangTags qw(is_language_tag same_language_tag
+		      extract_language_tags super_languages
+		      similarity_language_tag is_dialect_of
+		      locale2language_tag alternate_language_tags
+		      encode_language_tag
+		     );
+
+ok !is_language_tag('');
+ok  is_language_tag('fr');
+ok  is_language_tag('fr-ca');
+ok  is_language_tag('fr-CA');
+ok !is_language_tag('fr-CA-');
+ok !is_language_tag('fr_CA');
+ok  is_language_tag('fr-ca-joual');
+ok !is_language_tag('frca');
+ok  is_language_tag('nav');
+ok  is_language_tag('nav-shiprock');
+ok !is_language_tag('nav-ceremonial'); # subtag too long
+ok !is_language_tag('x');
+ok !is_language_tag('i');
+ok  is_language_tag('i-borg'); # NB: fictitious tag
+ok  is_language_tag('x-borg');
+ok  is_language_tag('x-borg-prot5123');
+ok  same_language_tag('x-borg-prot5123', 'i-BORG-Prot5123' );
+ok !same_language_tag('en', 'en-us' );
+
+ok 0 == similarity_language_tag('en-ca', 'fr-ca');
+ok 1 == similarity_language_tag('en-ca', 'en-us');
+ok 2 == similarity_language_tag('en-us-southern', 'en-us-western');
+ok 2 == similarity_language_tag('en-us-southern', 'en-us');
+
+# print "So there!\n";
+
diff --git a/lib/IPC/Open2.t b/lib/IPC/Open2.t
new file mode 100644
index 0000000000..fe49189d83
--- /dev/null
+++ b/lib/IPC/Open2.t
@@ -0,0 +1,59 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
+    {
+	print "1..0\n";
+	exit 0;
+    }
+    # make warnings fatal
+    $SIG{__WARN__} = sub { die @_ };
+}
+
+use strict;
+use IO::Handle;
+use IPC::Open2;
+#require 'open2.pl'; use subs 'open2';
+
+my $perl = './perl';
+
+sub ok {
+    my ($n, $result, $info) = @_;
+    if ($result) {
+	print "ok $n\n";
+    }
+    else {
+	print "not ok $n\n";
+	print "# $info\n" if $info;
+    }
+}
+
+sub cmd_line {
+	if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+		return qq/"$_[0]"/;
+	}
+	else {
+		return $_[0];
+	}
+}
+
+my ($pid, $reaped_pid);
+STDOUT->autoflush;
+STDERR->autoflush;
+
+print "1..7\n";
+
+ok 1, $pid = open2 'READ', 'WRITE', $perl, '-e',
+	cmd_line('print scalar <STDIN>');
+ok 2, print WRITE "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, close(WRITE), $!;
+ok 5, close(READ), $!;
+$reaped_pid = waitpid $pid, 0;
+ok 6, $reaped_pid == $pid, $reaped_pid;
+ok 7, $? == 0, $?;
diff --git a/lib/IPC/Open3.t b/lib/IPC/Open3.t
new file mode 100644
index 0000000000..7d2d4113df
--- /dev/null
+++ b/lib/IPC/Open3.t
@@ -0,0 +1,150 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (!$Config{'d_fork'}
+       # open2/3 supported on win32 (but not Borland due to CRT bugs)
+       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
+    {
+	print "1..0\n";
+	exit 0;
+    }
+    # make warnings fatal
+    $SIG{__WARN__} = sub { die @_ };
+}
+
+use strict;
+use IO::Handle;
+use IPC::Open3;
+#require 'open3.pl'; use subs 'open3';
+
+my $perl = $^X;
+
+sub ok {
+    my ($n, $result, $info) = @_;
+    if ($result) {
+	print "ok $n\n";
+    }
+    else {
+	print "not ok $n\n";
+	print "# $info\n" if $info;
+    }
+}
+
+sub cmd_line {
+	if ($^O eq 'MSWin32' || $^O eq 'NetWare') {
+		my $cmd = shift;
+		$cmd =~ tr/\r\n//d;
+		$cmd =~ s/"/\\"/g;
+		return qq/"$cmd"/;
+	}
+	else {
+		return $_[0];
+	}
+}
+
+my ($pid, $reaped_pid);
+STDOUT->autoflush;
+STDERR->autoflush;
+
+print "1..22\n";
+
+# basic
+ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR "hi error\n";
+EOF
+ok 2, print WRITE "hi kid\n";
+ok 3, <READ> =~ /^hi kid\r?\n$/;
+ok 4, <ERROR> =~ /^hi error\r?\n$/;
+ok 5, close(WRITE), $!;
+ok 6, close(READ), $!;
+ok 7, close(ERROR), $!;
+$reaped_pid = waitpid $pid, 0;
+ok 8, $reaped_pid == $pid, $reaped_pid;
+ok 9, $? == 0, $?;
+
+# read and error together, both named
+$pid = open3 'WRITE', 'READ', 'READ', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 10\n";
+print scalar <READ>;
+print WRITE "ok 11\n";
+print scalar <READ>;
+waitpid $pid, 0;
+
+# read and error together, error empty
+$pid = open3 'WRITE', 'READ', '', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 12\n";
+print scalar <READ>;
+print WRITE "ok 13\n";
+print scalar <READ>;
+waitpid $pid, 0;
+
+# dup writer
+ok 14, pipe PIPE_READ, PIPE_WRITE;
+$pid = open3 '<&PIPE_READ', 'READ', '',
+		    $perl, '-e', cmd_line('print scalar <STDIN>');
+close PIPE_READ;
+print PIPE_WRITE "ok 15\n";
+close PIPE_WRITE;
+print scalar <READ>;
+waitpid $pid, 0;
+
+# dup reader
+$pid = open3 'WRITE', '>&STDOUT', 'ERROR',
+		    $perl, '-e', cmd_line('print scalar <STDIN>');
+print WRITE "ok 16\n";
+waitpid $pid, 0;
+
+# dup error:  This particular case, duping stderr onto the existing
+# stdout but putting stdout somewhere else, is a good case because it
+# used not to work.
+$pid = open3 'WRITE', 'READ', '>&STDOUT',
+		    $perl, '-e', cmd_line('print STDERR scalar <STDIN>');
+print WRITE "ok 17\n";
+waitpid $pid, 0;
+
+# dup reader and error together, both named
+$pid = open3 'WRITE', '>&STDOUT', '>&STDOUT', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print STDOUT scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 18\n";
+print WRITE "ok 19\n";
+waitpid $pid, 0;
+
+# dup reader and error together, error empty
+$pid = open3 'WRITE', '>&STDOUT', '', $perl, '-e', cmd_line(<<'EOF');
+    $| = 1;
+    print STDOUT scalar <STDIN>;
+    print STDERR scalar <STDIN>;
+EOF
+print WRITE "ok 20\n";
+print WRITE "ok 21\n";
+waitpid $pid, 0;
+
+# command line in single parameter variant of open3
+# for understanding of Config{'sh'} test see exec description in camel book
+my $cmd = 'print(scalar(<STDIN>))';
+$cmd = $Config{'sh'} =~ /sh/ ? "'$cmd'" : cmd_line($cmd);
+eval{$pid = open3 'WRITE', '>&STDOUT', 'ERROR', "$perl -e " . $cmd; };
+if ($@) {
+	print "error $@\n";
+	print "not ok 22\n";
+}
+else {
+	print WRITE "ok 22\n";
+	waitpid $pid, 0;
+}        
diff --git a/lib/IPC/SysV.t b/lib/IPC/SysV.t
new file mode 100755
index 0000000000..795ad5d6c7
--- /dev/null
+++ b/lib/IPC/SysV.t
@@ -0,0 +1,218 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+
+    @INC = '../lib';
+
+    require Config; import Config;
+
+    my $reason;
+
+    if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) {
+      $reason = 'IPC::SysV was not built';
+    } elsif ($Config{'d_sem'} ne 'define') {
+      $reason = '$Config{d_sem} undefined';
+    } elsif ($Config{'d_msg'} ne 'define') {
+      $reason = '$Config{d_msg} undefined';
+    }
+    if ($reason) {
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+# These constants are common to all tests.
+# Later the sem* tests will import more for themselves.
+
+use IPC::SysV qw(IPC_PRIVATE IPC_NOWAIT IPC_STAT IPC_RMID S_IRWXU);
+use strict;
+
+print "1..16\n";
+
+my $msg;
+my $sem;
+
+$SIG{__DIE__} = 'cleanup'; # will cleanup $msg and $sem if needed
+
+# FreeBSD is known to throw this if there's no SysV IPC in the kernel.
+$SIG{SYS} = sub {
+    print STDERR <<EOM;
+SIGSYS caught.
+It may be that your kernel does not have SysV IPC configured.
+
+EOM
+    if ($^O eq 'freebsd') {
+	print STDERR <<EOM;
+You must have following options in your kernel:
+
+options         SYSVSHM
+options         SYSVSEM
+options         SYSVMSG
+
+See config(8).
+EOM
+    }
+    exit(1);
+};
+
+my $perm = S_IRWXU;
+
+if ($Config{'d_msgget'} eq 'define' &&
+    $Config{'d_msgctl'} eq 'define' &&
+    $Config{'d_msgsnd'} eq 'define' &&
+    $Config{'d_msgrcv'} eq 'define') {
+
+    $msg = msgget(IPC_PRIVATE, $perm);
+    # Very first time called after machine is booted value may be 0 
+    die "msgget failed: $!\n" unless defined($msg) && $msg >= 0;
+
+    print "ok 1\n";
+
+    #Putting a message on the queue
+    my $msgtype = 1;
+    my $msgtext = "hello";
+
+    my $test2bad;
+    my $test5bad;
+    my $test6bad;
+
+    unless (msgsnd($msg,pack("L! a*",$msgtype,$msgtext),IPC_NOWAIT)) {
+	print "not ";
+	$test2bad = 1;
+    }
+    print "ok 2\n";
+    if ($test2bad) {
+	print <<EOM;
+#
+# The failure of the subtest #2 may indicate that the message queue
+# resource limits either of the system or of the testing account
+# have been reached.  Error message "Operating would block" is
+# usually indicative of this situation.  The error message was now:
+# "$!"
+#
+# You can check the message queues with the 'ipcs' command and
+# you can remove unneeded queues with the 'ipcrm -q id' command.
+# You may also consider configuring your system or account
+# to have more message queue resources.
+#
+# Because of the subtest #2 failing also the substests #5 and #6 will
+# very probably also fail.
+#
+EOM
+    }
+
+    my $data;
+    msgctl($msg,IPC_STAT,$data) or print "not ";
+    print "ok 3\n";
+
+    print "not " unless length($data);
+    print "ok 4\n";
+
+    my $msgbuf;
+    unless (msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT)) {
+	print "not ";
+	$test5bad = 1;
+    }
+    print "ok 5\n";
+    if ($test5bad && $test2bad) {
+	print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+    }
+
+    my($rmsgtype,$rmsgtext);
+    ($rmsgtype,$rmsgtext) = unpack("L! a*",$msgbuf);
+    unless ($rmsgtype == $msgtype && $rmsgtext eq $msgtext) {
+	print "not ";
+	$test6bad = 1;
+    }
+    print "ok 6\n";
+    if ($test6bad && $test2bad) {
+	print <<EOM;
+#
+# This failure was to be expected because the subtest #2 failed.
+#
+EOM
+     }
+} else {
+    for (1..6) {
+	print "ok $_\n"; # fake it
+    }
+}
+
+if($Config{'d_semget'} eq 'define' &&
+   $Config{'d_semctl'} eq 'define') {
+
+    if ($Config{'d_semctl_semid_ds'} eq 'define' ||
+	$Config{'d_semctl_semun'}    eq 'define') {
+
+	use IPC::SysV qw(IPC_CREAT GETALL SETALL);
+
+	$sem = semget(IPC_PRIVATE, 10, $perm | IPC_CREAT);
+	# Very first time called after machine is booted value may be 0 
+	die "semget: $!\n" unless defined($sem) && $sem >= 0;
+
+	print "ok 7\n";
+
+	my $data;
+	semctl($sem,0,IPC_STAT,$data) or print "not ";
+	print "ok 8\n";
+	
+	print "not " unless length($data);
+	print "ok 9\n";
+
+	my $nsem = 10;
+
+	semctl($sem,0,SETALL,pack("s!*",(0) x $nsem)) or print "not ";
+	print "ok 10\n";
+
+	$data = "";
+	semctl($sem,0,GETALL,$data) or print "not ";
+	print "ok 11\n";
+
+	print "not " unless length($data) == length(pack("s!*",(0) x $nsem));
+	print "ok 12\n";
+
+	my @data = unpack("s!*",$data);
+
+	my $adata = "0" x $nsem;
+
+	print "not " unless @data == $nsem and join("",@data) eq $adata;
+	print "ok 13\n";
+
+	my $poke = 2;
+
+	$data[$poke] = 1;
+	semctl($sem,0,SETALL,pack("s!*",@data)) or print "not ";
+	print "ok 14\n";
+    
+	$data = "";
+	semctl($sem,0,GETALL,$data) or print "not ";
+	print "ok 15\n";
+
+	@data = unpack("s!*",$data);
+
+	my $bdata = "0" x $poke . "1" . "0" x ($nsem-$poke-1);
+
+	print "not " unless join("",@data) eq $bdata;
+	print "ok 16\n";
+    } else {
+	for (7..16) {
+	    print "ok $_ # skipped, no semctl possible\n";
+	}
+    }
+} else {
+    for (7..16) {
+	print "ok $_\n"; # fake it
+    }
+}
+
+sub cleanup {
+    msgctl($msg,IPC_RMID,0)       if defined $msg;
+    semctl($sem,0,IPC_RMID,undef) if defined $sem;
+}
+
+cleanup;
diff --git a/lib/Locale/Codes/t/all.t b/lib/Locale/Codes/t/all.t
new file mode 100644
index 0000000000..ed93c5a856
--- /dev/null
+++ b/lib/Locale/Codes/t/all.t
@@ -0,0 +1,366 @@
+#!./perl
+#
+# all.t - tests for all_* routines in
+#	Locale::Country
+#	Locale::Language
+#	Locale::Currency
+#
+# There are four tests. We get a list of all codes, convert to
+# language/country/currency, # convert back to code,
+# and check that they're the same. Then we do the same,
+# starting with list of languages/countries/currencies.
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Country;
+use Locale::Language;
+use Locale::Currency;
+
+print "1..12\n";
+
+my $code;
+my $language;
+my $country;
+my $ok;
+my $reverse;
+my $currency;
+
+
+#-----------------------------------------------------------------------
+# Old API - without codeset specified, default to ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes())
+{
+    $country = code2country($code);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 1\n" : "not ok 1\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for ALPHA2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_ALPHA_2))
+{
+    $country = code2country($code, LOCALE_CODE_ALPHA_2);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_ALPHA_2);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 2\n" : "not ok 2\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for ALPHA3
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_ALPHA_3))
+{
+    $country = code2country($code, LOCALE_CODE_ALPHA_3);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_ALPHA_3);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 3\n" : "not ok 3\n");
+
+#-----------------------------------------------------------------------
+# code to country, back to code, for NUMERIC
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $code (all_country_codes(LOCALE_CODE_NUMERIC))
+{
+    $country = code2country($code, LOCALE_CODE_NUMERIC);
+    if (!defined $country)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = country2code($country, LOCALE_CODE_NUMERIC);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 4\n" : "not ok 4\n");
+
+
+#-----------------------------------------------------------------------
+# Old API - country to code, back to country, using default of ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 5\n" : "not ok 5\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_ALPHA_2
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_ALPHA_2);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_ALPHA_2);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 6\n" : "not ok 6\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_ALPHA_3
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_ALPHA_3);
+    if (!defined $code)
+    {
+	next if ($country eq 'Antarctica'
+		 || $country eq 'Bouvet Island'
+		 || $country eq 'Cocos (Keeling) Islands'
+		 || $country eq 'Christmas Island'
+		 || $country eq 'France, Metropolitan'
+		 || $country eq 'South Georgia and the South Sandwich Islands'
+		 || $country eq 'Heard Island and McDonald Islands'
+		 || $country eq 'British Indian Ocean Territory'
+		 || $country eq 'French Southern Territories'
+		 || $country eq 'United States Minor Outlying Islands'
+		 || $country eq 'Mayotte'
+		 || $country eq 'Zaire');
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_ALPHA_3);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 7\n" : "not ok 7\n");
+
+#-----------------------------------------------------------------------
+# country to code, back to country, using LOCALE_CODE_NUMERIC
+#-----------------------------------------------------------------------
+$ok = 1;
+foreach $country (all_country_names())
+{
+    $code = country2code($country, LOCALE_CODE_NUMERIC);
+    if (!defined $code)
+    {
+	next if ($country eq 'Antarctica'
+		 || $country eq 'Bouvet Island'
+		 || $country eq 'Cocos (Keeling) Islands'
+		 || $country eq 'Christmas Island'
+		 || $country eq 'France, Metropolitan'
+		 || $country eq 'South Georgia and the South Sandwich Islands'
+		 || $country eq 'Heard Island and McDonald Islands'
+		 || $country eq 'British Indian Ocean Territory'
+		 || $country eq 'French Southern Territories'
+		 || $country eq 'United States Minor Outlying Islands'
+		 || $country eq 'Mayotte'
+		 || $country eq 'Zaire');
+        $ok = 0;
+        last;
+    }
+    $reverse = code2country($code, LOCALE_CODE_NUMERIC);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $country)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+
+$ok = 1;
+foreach $code (all_language_codes())
+{
+    $language = code2language($code);
+    if (!defined $language)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = language2code($language);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $code)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 9\n" : "not ok 9\n");
+
+
+$ok = 1;
+foreach $language (all_language_names())
+{
+    $code = language2code($language);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2language($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $language)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 10\n" : "not ok 10\n");
+
+$ok = 1;
+foreach $code (all_currency_codes())
+{
+    $currency = code2currency($code);
+    if (!defined $currency)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = currency2code($currency);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    #
+    # three special cases:
+    #	The Kwacha has two codes - used in Zambia and Malawi
+    #	The Russian Ruble has two codes - rub and rur
+    #	The Belarussian Ruble has two codes - byb and byr
+    if ($reverse ne $code
+	&& $code ne 'mwk' && $code ne 'zmk'
+	&& $code ne 'byr' && $code ne 'byb'
+	&& $code ne 'rub' && $code ne 'rur')
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 11\n" : "not ok 11\n");
+
+$ok = 1;
+foreach $currency (all_currency_names())
+{
+    $code = currency2code($currency);
+    if (!defined $code)
+    {
+        $ok = 0;
+        last;
+    }
+    $reverse = code2currency($code);
+    if (!defined $reverse)
+    {
+        $ok = 0;
+        last;
+    }
+    if ($reverse ne $currency)
+    {
+        $ok = 0;
+        last;
+    }
+}
+print ($ok ? "ok 12\n" : "not ok 12\n");
diff --git a/lib/Locale/Codes/t/constants.t b/lib/Locale/Codes/t/constants.t
new file mode 100644
index 0000000000..359cdfc7a5
--- /dev/null
+++ b/lib/Locale/Codes/t/constants.t
@@ -0,0 +1,49 @@
+#!./perl
+#
+# constants.t - tests for Locale::Constants
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Constants;
+
+print "1..3\n";
+
+if (defined LOCALE_CODE_ALPHA_2
+    && defined LOCALE_CODE_ALPHA_3
+    && defined LOCALE_CODE_NUMERIC)
+{
+    print "ok 1\n";
+}
+else
+{
+    print "not ok 1\n";
+}
+
+if (LOCALE_CODE_ALPHA_2 != LOCALE_CODE_ALPHA_3
+    && LOCALE_CODE_ALPHA_2 != LOCALE_CODE_NUMERIC
+    && LOCALE_CODE_ALPHA_3 != LOCALE_CODE_NUMERIC)
+{
+    print "ok 2\n";
+}
+else
+{
+    print "not ok 2\n";
+}
+
+if (defined LOCALE_CODE_DEFAULT
+    && (LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_2
+	|| LOCALE_CODE_DEFAULT == LOCALE_CODE_ALPHA_3
+	|| LOCALE_CODE_DEFAULT == LOCALE_CODE_NUMERIC))
+{
+    print "ok 3\n";
+}
+else
+{
+    print "not ok 3\n";
+}
+
+exit 0;
diff --git a/lib/Locale/Codes/t/country.t b/lib/Locale/Codes/t/country.t
new file mode 100644
index 0000000000..4234d1e6a7
--- /dev/null
+++ b/lib/Locale/Codes/t/country.t
@@ -0,0 +1,114 @@
+#!./perl
+#
+# country.t - tests for Locale::Country
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Country;
+
+#-----------------------------------------------------------------------
+# This is an array of tests specs. Each spec is [TEST, OK_TO_DIE]
+# Each TEST is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N". If the eval dies, then the OK_TO_DIE flag is checked.
+# If it is true (1), the test is treated as passing, otherwise it failed.
+#-----------------------------------------------------------------------
+@TESTS =
+(
+	#================================================
+	# TESTS FOR code2country
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined code2country()', 0],                  # no argument
+ ['!defined code2country(undef)', 0],             # undef argument
+ ['!defined code2country("zz")', 0],              # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_ALPHA_2)', 0],        # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_ALPHA_3)', 0],        # illegal code
+ ['!defined code2country("zz", LOCALE_CODE_NUMERIC)', 0],        # illegal code
+ ['!defined code2country("ja")', 0],              # should be jp for country
+ ['!defined code2country("uk")', 0],              # should be jp for country
+
+ #---- some successful examples -----------------------------------------
+ ['code2country("BO") eq "Bolivia"', 0],
+ ['code2country("BO", LOCALE_CODE_ALPHA_2) eq "Bolivia"', 0],
+ ['code2country("bol", LOCALE_CODE_ALPHA_3) eq "Bolivia"', 0],
+ ['code2country("pk") eq "Pakistan"', 0],
+ ['code2country("sn") eq "Senegal"', 0],
+ ['code2country("us") eq "United States"', 0],
+ ['code2country("ad") eq "Andorra"', 0],          # first in DATA segment
+ ['code2country("ad", LOCALE_CODE_ALPHA_2) eq "Andorra"', 0],
+ ['code2country("and", LOCALE_CODE_ALPHA_3) eq "Andorra"', 0],
+ ['code2country("020", LOCALE_CODE_NUMERIC) eq "Andorra"', 0],
+ ['code2country(48, LOCALE_CODE_NUMERIC) eq "Bahrain"', 0],
+ ['code2country("zw") eq "Zimbabwe"', 0],         # last in DATA segment
+ ['code2country("gb") eq "United Kingdom"', 0],   # United Kingdom is "gb", not "uk"
+
+	#================================================
+	# TESTS FOR country2code
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined code2country("BO", LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined code2country("BO", LOCALE_CODE_NUMERIC)', 0],
+ ['!defined country2code()', 0],                  # no argument
+ ['!defined country2code(undef)', 0],             # undef argument
+ ['!defined country2code("Banana")', 0],          # illegal country name
+
+ #---- some successful examples -----------------------------------------
+ ['country2code("japan")          eq "jp"', 0],
+ ['country2code("japan")          ne "ja"', 0],
+ ['country2code("Japan")          eq "jp"', 0],
+ ['country2code("United States")  eq "us"', 0],
+ ['country2code("United Kingdom") eq "gb"', 0],
+ ['country2code("Andorra")        eq "ad"', 0],    # first in DATA segment
+ ['country2code("Zimbabwe")       eq "zw"', 0],    # last in DATA segment
+
+	#================================================
+	# TESTS FOR country_code2code
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_3)', 0],
+ ['!defined country_code2code("zz", LOCALE_CODE_ALPHA_2)', 1],
+ ['!defined country_code2code("bo", LOCALE_CODE_ALPHA_2)', 1],
+ ['!defined country_code2code()', 1],                  # no argument
+ ['!defined country_code2code(undef)', 1],             # undef argument
+
+ #---- some successful examples -----------------------------------------
+ ['country_code2code("BO", LOCALE_CODE_ALPHA_2, LOCALE_CODE_ALPHA_3) eq "bol"', 0],
+ ['country_code2code("bol", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "bo"', 0],
+ ['country_code2code("zwe", LOCALE_CODE_ALPHA_3, LOCALE_CODE_ALPHA_2) eq "zw"', 0],
+ ['country_code2code("858", LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
+ ['country_code2code(858, LOCALE_CODE_NUMERIC, LOCALE_CODE_ALPHA_3) eq "ury"', 0],
+ ['country_code2code("tr", LOCALE_CODE_ALPHA_2, LOCALE_CODE_NUMERIC) eq "792"', 0],
+
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test->[0]) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    if ($@)
+    {
+	if (!$test->[1])
+	{
+	    print "not ok $testid\n";
+	}
+	else
+	{
+	    print "ok $testid\n";
+	}
+    }
+    ++$testid;
+}
+
+exit 0;
diff --git a/lib/Locale/Codes/t/currency.t b/lib/Locale/Codes/t/currency.t
new file mode 100644
index 0000000000..55a04db9fb
--- /dev/null
+++ b/lib/Locale/Codes/t/currency.t
@@ -0,0 +1,85 @@
+#!./perl
+#
+# currency.t - tests for Locale::Currency
+#
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+}
+
+use Locale::Currency;
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+	#================================================
+	# TESTS FOR code2currency
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2currency()',                 # no argument => undef returned
+ '!defined code2currency(undef)',            # undef arg   => undef returned
+ '!defined code2currency("zz")',             # illegal code => undef
+ '!defined code2currency("zzzz")',           # illegal code => undef
+ '!defined code2currency("zzz")',            # illegal code => undef
+ '!defined code2currency("ukp")',            # gbp for sterling, not ukp
+
+ #---- misc tests -------------------------------------------------------
+ 'code2currency("all") eq "Lek"',
+ 'code2currency("ats") eq "Schilling"',
+ 'code2currency("bob") eq "Boliviano"',
+ 'code2currency("bnd") eq "Brunei Dollar"',
+ 'code2currency("cop") eq "Colombian Peso"',
+ 'code2currency("dkk") eq "Danish Krone"',
+ 'code2currency("fjd") eq "Fiji Dollar"',
+ 'code2currency("idr") eq "Rupiah"',
+ 'code2currency("chf") eq "Swiss Franc"',
+ 'code2currency("mvr") eq "Rufiyaa"',
+ 'code2currency("mmk") eq "Kyat"',
+ 'code2currency("mwk") eq "Kwacha"',	# two different codes for Kwacha
+ 'code2currency("zmk") eq "Kwacha"',    # used in Zambia and Malawi
+ 'code2currency("byr") eq "Belarussian Ruble"',	# 2 codes for belarussian ruble
+ 'code2currency("byb") eq "Belarussian Ruble"', #
+ 'code2currency("rub") eq "Russian Ruble"',	# 2 codes for russian ruble
+ 'code2currency("rur") eq "Russian Ruble"',     #
+
+ #---- some successful examples -----------------------------------------
+ 'code2currency("BOB") eq "Boliviano"',
+ 'code2currency("adp") eq "Andorran Peseta"',  # first in DATA segment
+ 'code2currency("zwd") eq "Zimbabwe Dollar"',  # last in DATA segment
+
+	#================================================
+	# TESTS FOR currency2code
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined currency2code()',                 # no argument => undef returned
+ '!defined currency2code(undef)',            # undef arg   => undef returned
+ '!defined currency2code("")',               # empty string => undef returned
+ '!defined currency2code("Banana")',         # illegal curr name => undef
+
+ #---- some successful examples -----------------------------------------
+ 'currency2code("Kroon")           eq "eek"',
+ 'currency2code("Markka")         eq "fim"',
+ 'currency2code("Riel")            eq "khr"',
+ 'currency2code("PULA")            eq "bwp"',
+ 'currency2code("Andorran Peseta") eq "adp"',       # first in DATA segment
+ 'currency2code("Zimbabwe Dollar") eq "zwd"',       # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;
diff --git a/lib/Locale/Codes/t/languages.t b/lib/Locale/Codes/t/languages.t
new file mode 100644
index 0000000000..9facd3509d
--- /dev/null
+++ b/lib/Locale/Codes/t/languages.t
@@ -0,0 +1,110 @@
+#!./perl
+#
+# language.t - tests for Locale::Language
+#
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use Locale::Language;
+
+no utf8; # so that the naked 8-bit characters won't gripe under use utf8
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+	#================================================
+	# TESTS FOR code2language
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2language()',                 # no argument => undef returned
+ '!defined code2language(undef)',            # undef arg   => undef returned
+ '!defined code2language("zz")',             # illegal code => undef
+ '!defined code2language("jp")',             # ja for lang, jp for country
+
+ #---- test recent changes ----------------------------------------------
+ 'code2language("ae") eq "Avestan"',
+ 'code2language("bs") eq "Bosnian"',
+ 'code2language("ch") eq "Chamorro"',
+ 'code2language("ce") eq "Chechen"',
+ 'code2language("cu") eq "Church Slavic"',
+ 'code2language("cv") eq "Chuvash"',
+ 'code2language("hz") eq "Herero"',
+ 'code2language("ho") eq "Hiri Motu"',
+ 'code2language("ki") eq "Kikuyu"',
+ 'code2language("kj") eq "Kuanyama"',
+ 'code2language("kv") eq "Komi"',
+ 'code2language("mh") eq "Marshall"',
+ 'code2language("nv") eq "Navajo"',
+ 'code2language("nr") eq "Ndebele, South"',
+ 'code2language("nd") eq "Ndebele, North"',
+ 'code2language("ng") eq "Ndonga"',
+ 'code2language("nn") eq "Norwegian Nynorsk"',
+ 'code2language("nb") eq "Norwegian Bokm�l"',
+ 'code2language("ny") eq "Chichewa; Nyanja"',
+ 'code2language("oc") eq "Occitan (post 1500)"',
+ 'code2language("os") eq "Ossetian; Ossetic"',
+ 'code2language("pi") eq "Pali"',
+ '!defined code2language("sh")',             # Serbo-Croatian withdrawn
+ 'code2language("se") eq "Sami"',
+ 'code2language("sc") eq "Sardinian"',
+ 'code2language("kw") eq "Cornish"',
+ 'code2language("gv") eq "Manx"',
+ 'code2language("lb") eq "Letzeburgesch"',
+ 'code2language("he") eq "Hebrew"',
+ '!defined code2language("iw")',             # Hebrew withdrawn
+ 'code2language("id") eq "Indonesian"',
+ '!defined code2language("in")',             # Indonesian withdrawn
+ 'code2language("iu") eq "Inuktitut"',
+ 'code2language("ug") eq "Uighur"',
+ '!defined code2language("ji")',             # Yiddish withdrawn
+ 'code2language("yi") eq "Yiddish"',
+ 'code2language("za") eq "Zhuang"',
+
+ #---- some successful examples -----------------------------------------
+ 'code2language("DA") eq "Danish"',
+ 'code2language("eo") eq "Esperanto"',
+ 'code2language("fi") eq "Finnish"',
+ 'code2language("en") eq "English"',
+ 'code2language("aa") eq "Afar"',            # first in DATA segment
+ 'code2language("zu") eq "Zulu"',            # last in DATA segment
+
+	#================================================
+	# TESTS FOR language2code
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined language2code()',                 # no argument => undef returned
+ '!defined language2code(undef)',            # undef arg   => undef returned
+ '!defined language2code("Banana")',         # illegal lang name => undef
+
+ #---- some successful examples -----------------------------------------
+ 'language2code("Japanese")  eq "ja"',
+ 'language2code("japanese")  eq "ja"',
+ 'language2code("japanese")  ne "jp"',
+ 'language2code("French")    eq "fr"',
+ 'language2code("Greek")     eq "el"',
+ 'language2code("english")   eq "en"',
+ 'language2code("ESTONIAN")  eq "et"',
+ 'language2code("Afar")      eq "aa"',       # first in DATA segment
+ 'language2code("Zulu")      eq "zu"',       # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;
diff --git a/lib/Locale/Codes/t/uk.t b/lib/Locale/Codes/t/uk.t
new file mode 100644
index 0000000000..948e2d1af2
--- /dev/null
+++ b/lib/Locale/Codes/t/uk.t
@@ -0,0 +1,70 @@
+#!./perl
+#
+# uk.t - tests for Locale::Country with "uk" aliases to "gb"
+#
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use Locale::Country;
+
+Locale::Country::_alias_code('uk' => 'gb');
+
+#-----------------------------------------------------------------------
+# This is an array of tests. Each test is eval'd as an expression.
+# If it evaluates to FALSE, then "not ok N" is printed for the test,
+# otherwise "ok N".
+#-----------------------------------------------------------------------
+@TESTS =
+(
+	#================================================
+	# TESTS FOR code2country
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined code2country()',                  # no argument
+ '!defined code2country(undef)',             # undef argument
+ '!defined code2country("zz")',              # illegal code
+ '!defined code2country("ja")',              # should be jp for country
+
+ #---- some successful examples -----------------------------------------
+ 'code2country("BO") eq "Bolivia"',
+ 'code2country("pk") eq "Pakistan"',
+ 'code2country("sn") eq "Senegal"',
+ 'code2country("us") eq "United States"',
+ 'code2country("ad") eq "Andorra"',          # first in DATA segment
+ 'code2country("zw") eq "Zimbabwe"',         # last in DATA segment
+ 'code2country("uk") eq "United Kingdom"',   # normally "gb"
+
+	#================================================
+	# TESTS FOR country2code
+	#================================================
+
+ #---- selection of examples which should all result in undef -----------
+ '!defined country2code()',                  # no argument
+ '!defined country2code(undef)',             # undef argument
+ '!defined country2code("Banana")',          # illegal country name
+
+ #---- some successful examples -----------------------------------------
+ 'country2code("japan")          eq "jp"',
+ 'country2code("japan")          ne "ja"',
+ 'country2code("Japan")          eq "jp"',
+ 'country2code("United States")  eq "us"',
+ 'country2code("United Kingdom") eq "uk"',
+ 'country2code("Andorra")        eq "ad"',    # first in DATA segment
+ 'country2code("Zimbabwe")       eq "zw"',    # last in DATA segment
+);
+
+print "1..", int(@TESTS), "\n";
+
+$testid = 1;
+foreach $test (@TESTS)
+{
+    eval "print (($test) ? \"ok $testid\\n\" : \"not ok $testid\\n\" )";
+    print "not ok $testid\n" if $@;
+    ++$testid;
+}
+
+exit 0;
diff --git a/lib/Locale/Maketext.t b/lib/Locale/Maketext.t
new file mode 100644
index 0000000000..743d8eecbd
--- /dev/null
+++ b/lib/Locale/Maketext.t
@@ -0,0 +1,37 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN { $| = 1; print "1..3\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Locale::Maketext 1.01;
+print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
+$loaded = 1;
+print "ok 1\n";
+{
+  package Woozle;
+  @ISA = ('Locale::Maketext');
+  sub dubbil { return $_[1] * 2 }
+}
+{
+  package Woozle::elx;
+  @ISA = ('Woozle');
+  %Lexicon = (
+   'd2' => 'hum [dubbil,_1]',
+  );
+}
+
+$lh = Woozle->get_handle('elx');
+if($lh) {
+  print "ok 2\n";
+  my $x = $lh->maketext('d2', 7);
+  if($x eq "hum 14") {
+    print "ok 3\n";
+  } else {
+    print "not ok 3\n  (got \"$x\")\n";
+  }
+} else {
+  print "not ok 2\n";
+}
+#Shazam!
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
new file mode 100755
index 0000000000..e8de58d871
--- /dev/null
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -0,0 +1,708 @@
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+  {
+  $| = 1;
+  unshift @INC, '../lib'; # for running manually
+  # chdir 't' if -d 't';
+  plan tests => 514;
+  }
+
+use Math::BigFloat;
+use Math::BigInt;
+
+my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
+while (<DATA>)
+  {
+  chop;
+  $_ =~ s/#.*$//;	# remove comments
+  $_ =~ s/\s+$//;	# trailing spaces
+  next if /^$/;		# skip empty lines & comments
+  if (s/^&//)
+    {
+    $f = $_;
+    }
+  elsif (/^\$/)
+    {
+    $setup = $_; $setup =~ s/^\$/\$Math::BigFloat::/;	# rnd_mode, div_scale 
+    # print "$setup\n";
+    }
+  else
+    {
+    if (m|^(.*?):(/.+)$|)
+      {
+      $ans = $2;
+      @args = split(/:/,$1,99);
+      }
+    else
+      {
+      @args = split(/:/,$_,99); $ans = pop(@args);
+      }
+    $try = "\$x = new Math::BigFloat \"$args[0]\";";
+    if ($f eq "fnorm")
+      {
+        $try .= "\$x;";
+      } elsif ($f eq "binf") {
+        $try .= "\$x->binf('$args[1]');";
+      } elsif ($f eq "bsstr") {
+        $try .= "\$x->bsstr();";
+      } elsif ($f eq "_set") {
+        $try .= "\$x->_set('$args[1]'); \$x;";
+      } elsif ($f eq "fneg") {
+        $try .= "-\$x;";
+      } elsif ($f eq "bfloor") {
+        $try .= "\$x->bfloor();";
+      } elsif ($f eq "bceil") {
+        $try .= "\$x->bceil();";
+      } elsif ($f eq "is_zero") {
+        $try .= "\$x->is_zero()+0;";
+      } elsif ($f eq "is_one") {
+        $try .= "\$x->is_one()+0;";
+      } elsif ($f eq "is_odd") {
+        $try .= "\$x->is_odd()+0;";
+      } elsif ($f eq "is_even") {
+        $try .= "\$x->is_even()+0;";
+      } elsif ($f eq "as_number") {
+        $try .= "\$x->as_number();";
+      } elsif ($f eq "fpow") {
+        $try .= "\$x ** $args[1];";
+      } elsif ($f eq "fabs") {
+        $try .= "abs \$x;";
+      }elsif ($f eq "fround") {
+        $try .= "$setup; \$x->fround($args[1]);";
+      } elsif ($f eq "ffround") {
+        $try .= "$setup; \$x->ffround($args[1]);";
+      } elsif ($f eq "fsqrt") {
+        $try .= "$setup; \$x->fsqrt();";
+      }
+    else
+      {
+      $try .= "\$y = new Math::BigFloat \"$args[1]\";";
+      if ($f eq "fcmp") {
+        $try .= "\$x <=> \$y;";
+      } elsif ($f eq "fadd") {
+        $try .= "\$x + \$y;";
+      } elsif ($f eq "fsub") {
+        $try .= "\$x - \$y;";
+      } elsif ($f eq "fmul") {
+        $try .= "\$x * \$y;";
+      } elsif ($f eq "fdiv") {
+        $try .= "$setup; \$x / \$y;";
+      } elsif ($f eq "fmod") {
+        $try .= "\$x % \$y;";
+      } else { warn "Unknown op '$f'"; }
+    }
+    $ans1 = eval $try;
+    if ($ans =~ m|^/(.*)$|)
+      {
+      my $pat = $1;
+      if ($ans1 =~ /$pat/)
+        {
+        ok (1,1);
+        }
+      else
+        {
+        print "# '$try' expected: /$pat/ got: '$ans1'\n" if !ok(1,0);
+        }
+      }
+    else
+      {
+      if ($ans eq "")
+        {
+        ok_undef ($ans1);
+        }
+      else
+        {
+        print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+        } 
+      } # end pattern or string
+    }
+  } # end while
+
+# all done
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+   
+__END__
+&as_number
+0:0
+1:1
+1.2:1
+2.345:2
+-2:-2
+-123.456:-123
+-200:-200
+&binf
+1:+:+inf
+2:-:-inf
+3:abc:+inf
+&bsstr
++inf:+inf
+-inf:-inf
+abc:NaN
+&fnorm
++inf:+inf
+-inf:-inf
++infinity:NaN
++-inf:NaN
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:0
++0:0
++00:0
++0_0_0:0
+000000_0000000_00000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+123.456a:NaN
+123.456:123.456
+0.01:0.01
+.002:0.002
++.2:0.2
+-0.0003:-0.0003
+-.0000000004:-0.0000000004
+123456E2:12345600
+123456E-2:1234.56
+-123456E2:-12345600
+-123456E-2:-1234.56
+1e1:10
+2e-11:0.00000000002
+-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
+-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
+&fpow
+2:2:4
+1:2:1
+1:3:1
+-1:2:1
+-1:3:-1
+123.456:2:15241.383936
+2:-2:0.25
+2:-3:0.125
+128:-2:0.00006103515625
+&fneg
+abc:NaN
++0:0
++1:-1
+-1:1
++123456789:-123456789
+-123456789:123456789
++123.456789:-123.456789
+-123456.789:123456.789
+&fabs
+abc:NaN
++0:0
++1:1
+-1:1
++123456789:123456789
+-123456789:123456789
++123.456789:123.456789
+-123456.789:123456.789
+&fround
+$rnd_mode = "trunc"
++10123456789:5:10123000000
+-10123456789:5:-10123000000
++10123456789.123:5:10123000000
+-10123456789.123:5:-10123000000
++10123456789:9:10123456700
+-10123456789:9:-10123456700
++101234500:6:101234000
+-101234500:6:-101234000
+$rnd_mode = "zero"
++20123456789:5:20123000000
+-20123456789:5:-20123000000
++20123456789.123:5:20123000000
+-20123456789.123:5:-20123000000
++20123456789:9:20123456800
+-20123456789:9:-20123456800
++201234500:6:201234000
+-201234500:6:-201234000
+$rnd_mode = "+inf"
++30123456789:5:30123000000
+-30123456789:5:-30123000000
++30123456789.123:5:30123000000
+-30123456789.123:5:-30123000000
++30123456789:9:30123456800
+-30123456789:9:-30123456800
++301234500:6:301235000
+-301234500:6:-301234000
+$rnd_mode = "-inf"
++40123456789:5:40123000000
+-40123456789:5:-40123000000
++40123456789.123:5:40123000000
+-40123456789.123:5:-40123000000
++40123456789:9:40123456800
+-40123456789:9:-40123456800
++401234500:6:401234000
+-401234500:6:-401235000
+$rnd_mode = "odd"
++50123456789:5:50123000000
+-50123456789:5:-50123000000
++50123456789.123:5:50123000000
+-50123456789.123:5:-50123000000
++50123456789:9:50123456800
+-50123456789:9:-50123456800
++501234500:6:501235000
+-501234500:6:-501235000
+$rnd_mode = "even"
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601234000
+-601234500:6:-601234000
++60123456789.0123:5:60123000000
+-60123456789.0123:5:-60123000000
+&ffround
+$rnd_mode = "trunc"
++1.23:-1:1.2
++1.234:-1:1.2
++1.2345:-1:1.2
++1.23:-2:1.23
++1.234:-2:1.23
++1.2345:-2:1.23
++1.23:-3:1.23
++1.234:-3:1.234
++1.2345:-3:1.234
+-1.23:-1:-1.2
++1.27:-1:1.2
+-1.27:-1:-1.2
++1.25:-1:1.2
+-1.25:-1:-1.2
++1.35:-1:1.3
+-1.35:-1:-1.3
+-0.0061234567890:-1:0
+-0.0061:-1:0
+-0.00612:-1:0
+-0.00612:-2:0
+-0.006:-1:0
+-0.006:-2:0
+-0.0006:-2:0
+-0.0006:-3:0
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:0
+0.41:0:0
+$rnd_mode = "zero"
++2.23:-1:/2.2(?:0{5}\d+)?
+-2.23:-1:/-2.2(?:0{5}\d+)?
++2.27:-1:/2.(?:3|29{5}\d+)
+-2.27:-1:/-2.(?:3|29{5}\d+)
++2.25:-1:/2.2(?:0{5}\d+)?
+-2.25:-1:/-2.2(?:0{5}\d+)?
++2.35:-1:/2.(?:3|29{5}\d+)
+-2.35:-1:/-2.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$rnd_mode = "+inf"
++3.23:-1:/3.2(?:0{5}\d+)?
+-3.23:-1:/-3.2(?:0{5}\d+)?
++3.27:-1:/3.(?:3|29{5}\d+)
+-3.27:-1:/-3.(?:3|29{5}\d+)
++3.25:-1:/3.(?:3|29{5}\d+)
+-3.25:-1:/-3.2(?:0{5}\d+)?
++3.35:-1:/3.(?:4|39{5}\d+)
+-3.35:-1:/-3.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$rnd_mode = "-inf"
++4.23:-1:/4.2(?:0{5}\d+)?
+-4.23:-1:/-4.2(?:0{5}\d+)?
++4.27:-1:/4.(?:3|29{5}\d+)
+-4.27:-1:/-4.(?:3|29{5}\d+)
++4.25:-1:/4.2(?:0{5}\d+)?
+-4.25:-1:/-4.(?:3|29{5}\d+)
++4.35:-1:/4.(?:3|29{5}\d+)
+-4.35:-1:/-4.(?:4|39{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+$rnd_mode = "odd"
++5.23:-1:/5.2(?:0{5}\d+)?
+-5.23:-1:/-5.2(?:0{5}\d+)?
++5.27:-1:/5.(?:3|29{5}\d+)
+-5.27:-1:/-5.(?:3|29{5}\d+)
++5.25:-1:/5.(?:3|29{5}\d+)
+-5.25:-1:/-5.(?:3|29{5}\d+)
++5.35:-1:/5.(?:3|29{5}\d+)
+-5.35:-1:/-5.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:1
+0.51:0:1
+0.41:0:0
+$rnd_mode = "even"
++6.23:-1:/6.2(?:0{5}\d+)?
+-6.23:-1:/-6.2(?:0{5}\d+)?
++6.27:-1:/6.(?:3|29{5}\d+)
+-6.27:-1:/-6.(?:3|29{5}\d+)
++6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+)
+-6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+)
++6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+)
+-6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+0.05:0:0
+0.5:0:0
+0.51:0:1
+0.41:0:0
+0.01234567:-3:0.012
+0.01234567:-4:0.0123
+0.01234567:-5:0.01235
+0.01234567:-6:0.012346
+0.01234567:-7:0.0123457
+0.01234567:-8:0.01234567
+0.01234567:-9:0.01234567
+0.01234567:-12:0.01234567
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
+-1.1:0:-1
++0:-1.1:1
++1.1:+0:1
++0:+1.1:-1
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+0:0.01:-1
+0:0.0001:-1
+0:-0.0001:1
+0:-0.1:1
+0.1:0:1
+0.00001:0:1
+-0.0001:0:-1
+-0.1:0:-1
+0:0.0001234:-1
+0:-0.0001234:1
+0.0001234:0:1
+-0.0001234:0:-1
+0.0001:0.0005:-1
+0.0005:0.0001:1
+0.005:0.0001:1
+0.001:0.0005:1
+0.000001:0.0005:-2	# <0, but can't test this
+0.00000123:0.0005:-2	# <0, but can't test this
+0.00512:0.0001:1
+0.005:0.000112:1
+0.00123:0.0005:1
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++1:+0:1
++0:+1:1
++1:+1:2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:0
++1:-1:0
++9:+1:10
++99:+1:100
++999:+1:1000
++9999:+1:10000
++99999:+1:100000
++999999:+1:1000000
++9999999:+1:10000000
++99999999:+1:100000000
++999999999:+1:1000000000
++9999999999:+1:10000000000
++99999999999:+1:100000000000
++10:-1:9
++100:-1:99
++1000:-1:999
++10000:-1:9999
++100000:-1:99999
++1000000:-1:999999
++10000000:-1:9999999
++100000000:-1:99999999
++1000000000:-1:999999999
++10000000000:-1:9999999999
++123456789:+987654321:1111111110
+-123456789:+987654321:864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++1:+0:1
++0:+1:-1
++1:+1:0
+-1:+0:-1
++0:-1:1
+-1:-1:0
+-1:+1:-2
++1:-1:2
++9:+1:8
++99:+1:98
++999:+1:998
++9999:+1:9998
++99999:+1:99998
++999999:+1:999998
++9999999:+1:9999998
++99999999:+1:99999998
++999999999:+1:999999998
++9999999999:+1:9999999998
++99999999999:+1:99999999998
++10:-1:11
++100:-1:101
++1000:-1:1001
++10000:-1:10001
++100000:-1:100001
++1000000:-1:1000001
++10000000:-1:10000001
++100000000:-1:100000001
++1000000000:-1:1000000001
++10000000000:-1:10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:864197532
++123456789:-987654321:1111111110
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++0:+1:0
++1:+0:0
++0:-1:0
+-1:+0:0
++123456789123456789:+0:0
++0:+123456789123456789:0
+-1:-1:1
+-1:+1:-1
++1:-1:-1
++1:+1:1
++2:+3:6
+-2:+3:-6
++2:-3:-6
+-2:-3:6
++111:+111:12321
++10101:+10101:102030201
++1001001:+1001001:1002003002001
++100010001:+100010001:10002000300020001
++10000100001:+10000100001:100002000030000200001
++11111111111:+9:99999999999
++22222222222:+9:199999999998
++33333333333:+9:299999999997
++44444444444:+9:399999999996
++55555555555:+9:499999999995
++66666666666:+9:599999999994
++77777777777:+9:699999999993
++88888888888:+9:799999999992
++99999999999:+9:899999999991
+&fdiv
+$div_scale = 40; $Math::BigFloat::rnd_mode = 'even'
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:0
++1:+0:NaN
++0:-1:0
+-1:+0:NaN
++1:+1:1
+-1:-1:1
++1:-1:-1
+-1:+1:-1
++1:+2:0.5
++2:+1:2
++10:+5:2
++100:+4:25
++1000:+8:125
++10000:+16:625
++10000:-16:-625
++999999999999:+9:111111111111
++999999999999:+99:10101010101
++999999999999:+999:1001001001
++999999999999:+9999:100010001
++999999999999999:+99999:10000100001
++1000000000:+9:111111111.1111111111111111111111111111111
++2000000000:+9:222222222.2222222222222222222222222222222
++3000000000:+9:333333333.3333333333333333333333333333333
++4000000000:+9:444444444.4444444444444444444444444444444
++5000000000:+9:555555555.5555555555555555555555555555556
++6000000000:+9:666666666.6666666666666666666666666666667
++7000000000:+9:777777777.7777777777777777777777777777778
++8000000000:+9:888888888.8888888888888888888888888888889
++9000000000:+9:1000000000
++35500000:+113:314159.2920353982300884955752212389380531
++71000000:+226:314159.2920353982300884955752212389380531
++106500000:+339:314159.2920353982300884955752212389380531
++1000000000:+3:333333333.3333333333333333333333333333333
+$div_scale = 20
++1000000000:+9:111111111.11111111111
++2000000000:+9:222222222.22222222222
++3000000000:+9:333333333.33333333333
++4000000000:+9:444444444.44444444444
++5000000000:+9:555555555.55555555556
++6000000000:+9:666666666.66666666667
++7000000000:+9:777777777.77777777778
++8000000000:+9:888888888.88888888889
++9000000000:+9:1000000000
+# following two cases are the "old" behaviour, but are now (>v0.01) different
+#+35500000:+113:314159.292035398230088
+#+71000000:+226:314159.292035398230088
++35500000:+113:314159.29203539823009
++71000000:+226:314159.29203539823009
++106500000:+339:314159.29203539823009
++1000000000:+3:333333333.33333333333
+$div_scale = 1
+# div_scale will be 3 since $x has 3 digits
++124:+3:41.3
+# reset scale for further tests
+$div_scale = 40
+&fmod
++0:0:NaN
++0:1:0
++3:1:0
+#+5:2:1
+#+9:4:1
+#+9:5:4
+#+9000:56:40
+#+56:9000:56
+&fsqrt
++0:0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.45:NaN
++1:1
+#+1.44:1.2
+#+2:1.41421356237309504880168872420969807857
+#+4:2
+#+16:4
+#+100:10
+#+123.456:11.11107555549866648462149404118219234119
+#+15241.38393:123.456
+&is_odd
+abc:0
+0:0
+-1:1
+-3:1
+1:1
+3:1
+1000001:1
+1000002:0
+2:0
+&is_even
+abc:0
+0:1
+-1:0
+-3:0
+1:0
+3:0
+1000001:0
+1000002:1
+2:1
+&is_zero
+NaNzero:0
+0:1
+-1:0
+1:0
+&is_one
+0:0
+2:0
+1:1
+-1:0
+-2:0
+&_set
+NaN:2:2
+2:abc:NaN
+1:-1:-1
+2:1:1
+-2:0:0
+128:-2:-2
+&bfloor
+0:0
+abc:NaN
++inf:+inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-52
+12.2:12
+&bceil
+0:0
+abc:NaN
++inf:+inf
+-inf:-inf
+1:1
+-51:-51
+-51.2:-51
+12.2:13
diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
new file mode 100755
index 0000000000..f819104885
--- /dev/null
+++ b/lib/Math/BigInt/t/bigintpm.t
@@ -0,0 +1,1238 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 1190;
+  }
+
+##############################################################################
+# for testing inheritance of _swap
+
+package Math::Foo;
+
+use Math::BigInt;
+use vars qw/@ISA/;
+@ISA = (qw/Math::BigInt/);
+
+use overload
+# customized overload for sub, since original does not use swap there
+'-'     =>      sub { my @a = ref($_[0])->_swap(@_);
+                   $a[0]->bsub($a[1])};
+
+sub _swap
+  {
+  # a fake _swap, which reverses the params
+  my $self = shift;                     # for override in subclass
+  if ($_[2])
+    {
+    my $c = ref ($_[0] ) || 'Math::Foo';
+    return ( $_[0]->copy(), $_[1] );
+    }
+  else
+    {
+    return ( Math::Foo->new($_[1]), $_[0] );
+    }
+  }
+
+##############################################################################
+package main;
+
+use Math::BigInt;
+
+my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode);
+
+while (<DATA>) 
+  {
+  chop;
+  next if /^#/;	# skip comments
+  if (s/^&//) 
+    {
+    $f = $_;
+    }
+  elsif (/^\$/) 
+    {
+    $round_mode = $_;
+    $round_mode =~ s/^\$/Math::BigInt->/;
+    # print "$round_mode\n";
+    }
+  else 
+    {
+    @args = split(/:/,$_,99);
+    $ans = pop(@args);
+    $try = "\$x = Math::BigInt->new(\"$args[0]\");";
+    if ($f eq "bnorm"){
+      # $try .= '$x+0;';
+    } elsif ($f eq "_set") {
+      $try .= '$x->_set($args[1]); "$x";';
+    } elsif ($f eq "is_zero") {
+      $try .= '$x->is_zero()+0;';
+    } elsif ($f eq "is_one") {
+      $try .= '$x->is_one()+0;';
+    } elsif ($f eq "is_odd") {
+      $try .= '$x->is_odd()+0;';
+    } elsif ($f eq "is_even") {
+      $try .= '$x->is_even()+0;';
+    } elsif ($f eq "binf") {
+      $try .= "\$x->binf('$args[1]');";
+    } elsif ($f eq "bfloor") {
+      $try .= '$x->bfloor();';
+    } elsif ($f eq "bceil") {
+      $try .= '$x->bceil();';
+    } elsif ($f eq "is_inf") {
+      $try .= "\$x->is_inf('$args[1]')+0;";
+    } elsif ($f eq "bsstr") {
+      $try .= '$x->bsstr();';
+    } elsif ($f eq "bneg") {
+      $try .= '-$x;';
+    } elsif ($f eq "babs") {
+      $try .= 'abs $x;';
+    } elsif ($f eq "binc") {
+      $try .= '++$x;'; 
+    } elsif ($f eq "bdec") {
+      $try .= '--$x;'; 
+    }elsif ($f eq "bnot") {
+      $try .= '~$x;';
+    }elsif ($f eq "bsqrt") {
+      $try .= '$x->bsqrt();';
+    }elsif ($f eq "length") {
+      $try .= "\$x->length();";
+    }elsif ($f eq "bround") {
+      $try .= "$round_mode; \$x->bround($args[1]);";
+    }elsif ($f eq "exponent"){
+      $try .= '$x = $x->exponent()->bstr();';
+    }elsif ($f eq "mantissa"){
+      $try .= '$x = $x->mantissa()->bstr();';
+    }elsif ($f eq "parts"){
+      $try .= "(\$m,\$e) = \$x->parts();"; 
+      $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
+      $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
+      $try .= '"$m,$e";';
+    } else {
+      $try .= "\$y = new Math::BigInt \"$args[1]\";";
+      if ($f eq "bcmp"){
+        $try .= '$x <=> $y;';
+      }elsif ($f eq "bacmp"){
+        $try .= '$x->bacmp($y);';
+      }elsif ($f eq "badd"){
+        $try .= "\$x + \$y;";
+      }elsif ($f eq "bsub"){
+        $try .= "\$x - \$y;";
+      }elsif ($f eq "bmul"){
+        $try .= "\$x * \$y;";
+      }elsif ($f eq "bdiv"){
+        $try .= "\$x / \$y;";
+      }elsif ($f eq "bmod"){
+        $try .= "\$x % \$y;";
+      }elsif ($f eq "bgcd")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
+          }
+        $try .= "Math::BigInt::bgcd(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+        }
+      elsif ($f eq "blcm")
+        {
+        if (defined $args[2])
+          {
+          $try .= " \$z = new Math::BigInt \"$args[2]\"; ";
+          }
+        $try .= "Math::BigInt::blcm(\$x, \$y";
+        $try .= ", \$z" if (defined $args[2]);
+        $try .= " );";
+      }elsif ($f eq "blsft"){
+        if (defined $args[2])
+          {
+          $try .= "\$x->blsft(\$y,$args[2]);";
+          }
+        else
+          {
+          $try .= "\$x << \$y;";
+          }
+      }elsif ($f eq "brsft"){
+        if (defined $args[2])
+          {
+          $try .= "\$x->brsft(\$y,$args[2]);";
+          }
+        else
+          {
+          $try .= "\$x >> \$y;";
+          }
+      }elsif ($f eq "band"){
+        $try .= "\$x & \$y;";
+      }elsif ($f eq "bior"){
+        $try .= "\$x | \$y;";
+      }elsif ($f eq "bxor"){
+        $try .= "\$x ^ \$y;";
+      }elsif ($f eq "bpow"){
+        $try .= "\$x ** \$y;";
+      }elsif ($f eq "digit"){
+        $try = "\$x = Math::BigInt->new(\"$args[0]\"); \$x->digit($args[1]);";
+      } else { warn "Unknown op '$f'"; }
+    }
+    # print "trying $try\n";
+    $ans1 = eval $try;
+    $ans =~ s/^[+]([0-9])/$1/; 		# remove leading '+' 
+    if ($ans eq "")
+      {
+      ok_undef ($ans1); 
+      }
+    else
+      {
+      #print "try: $try ans: $ans1 $ans\n";
+      print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+      }
+    # check internal state of number objects
+    is_valid($ans1) if ref $ans1; 
+    }
+  } # endwhile data tests
+close DATA;
+
+# test whether constant works or not
+$try = "use Math::BigInt (1.31,'babs',':constant');";
+$try .= ' $x = 2**150; babs($x); $x = "$x";';
+$ans1 = eval $try;
+
+ok ( $ans1, "1427247692705959881058285969449495136382746624");
+
+# test some more
+@a = ();
+for (my $i = 1; $i < 10; $i++) 
+  {
+  push @a, $i;
+  }
+ok "@a", "1 2 3 4 5 6 7 8 9";
+
+# test whether selfmultiplication works correctly (result is 2**64)
+$try = '$x = new Math::BigInt "+4294967296";';
+$try .= '$a = $x->bmul($x);';
+$ans1 = eval $try;
+print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64);
+
+# test whether op detroys args or not (should better not)
+
+$x = new Math::BigInt (3);
+$y = new Math::BigInt (4);
+$z = $x & $y;
+ok ($x,3);
+ok ($y,4);
+ok ($z,0);
+$z = $x | $y;
+ok ($x,3);
+ok ($y,4);
+ok ($z,7);
+$x = new Math::BigInt (1);
+$y = new Math::BigInt (2);
+$z = $x | $y;
+ok ($x,1);
+ok ($y,2);
+ok ($z,3);
+
+$x = new Math::BigInt (5);
+$y = new Math::BigInt (4);
+$z = $x ^ $y;
+ok ($x,5);
+ok ($y,4);
+ok ($z,1);
+
+$x = new Math::BigInt (-5); $y = -$x;
+ok ($x, -5);
+
+$x = new Math::BigInt (-5); $y = abs($x);
+ok ($x, -5);
+
+# check whether overloading cmp works
+$try = "\$x = Math::BigInt->new(0);";
+$try .= "\$y = 10;";
+$try .= "'false' if \$x ne \$y;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "false" ); 
+
+# we cant test for working cmpt with other objects here, we would need a dummy
+# object with stringify overload for this. see Math::String tests
+
+###############################################################################
+# check shortcuts
+$try = "\$x = Math::BigInt->new(1); \$x += 9;";
+$try .= "'ok' if \$x == 10;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(1); \$x -= 9;";
+$try .= "'ok' if \$x == -8;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(1); \$x *= 9;";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x /= 2;";
+$try .= "'ok' if \$x == 5;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check reversed order of arguments
+$try = "\$x = Math::BigInt->new(10); \$x = 2 ** \$x;";
+$try .= "'ok' if \$x == 1024;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 * \$x;";
+$try .= "'ok' if \$x == 20;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 + \$x;";
+$try .= "'ok' if \$x == 12;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 2 - \$x;";
+$try .= "'ok' if \$x == -8;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->new(10); \$x = 20 / \$x;";
+$try .= "'ok' if \$x == 2;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check badd(4,5) form
+
+$try = "\$x = Math::BigInt::badd(4,5);";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = Math::BigInt->badd(4,5);";
+$try .= "'ok' if \$x == 9;";
+$ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+###############################################################################
+# check proper length of internal arrays
+
+$x = Math::BigInt->new(99999); 
+ok ($x,99999);
+ok (scalar @{$x->{value}}, 1);
+$x += 1;
+ok ($x,100000);
+ok (scalar @{$x->{value}}, 2);
+$x -= 1;
+ok ($x,99999);
+ok (scalar @{$x->{value}}, 1);
+
+###############################################################################
+# check numify
+
+my $BASE = int(1e5);
+$x = Math::BigInt->new($BASE-1);     ok ($x->numify(),$BASE-1); 
+$x = Math::BigInt->new(-($BASE-1));  ok ($x->numify(),-($BASE-1)); 
+$x = Math::BigInt->new($BASE);       ok ($x->numify(),$BASE); 
+$x = Math::BigInt->new(-$BASE);      ok ($x->numify(),-$BASE);
+$x = Math::BigInt->new( -($BASE*$BASE*1+$BASE*1+1) ); 
+ok($x->numify(),-($BASE*$BASE*1+$BASE*1+1)); 
+
+###############################################################################
+# test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead of 1
+
+$x = Math::BigInt->new(99998); $x++; $x++; $x++; $x++;
+if ($x > 100000) { ok (1,1) } else { ok ("$x < 100000","$x > 100000"); }
+
+$x = Math::BigInt->new(100003); $x++;
+$y = Math::BigInt->new(1000000);
+if ($x < 1000000) { ok (1,1) } else { ok ("$x > 1000000","$x < 1000000"); }
+
+###############################################################################
+# bug in sub where number with at least 6 trailing zeros after any op failed
+
+$x = Math::BigInt->new(123456); $z = Math::BigInt->new(10000); $z *= 10;
+$x -= $z;
+ok ($z, 100000);
+ok ($x, 23456);
+
+###############################################################################
+# bug with rest "-0" in div, causing further div()s to fail
+
+$x = Math::BigInt->new(-322056000); ($x,$y) = $x->bdiv('-12882240');
+
+ok ($y,'0');	# not '-0'
+is_valid($y);
+
+###############################################################################
+# check undefs: NOT DONE YET
+
+###############################################################################
+# bool
+
+$x = Math::BigInt->new(1); if ($x) { ok (1,1); } else { ok($x,'to be true') }
+$x = Math::BigInt->new(0); if (!$x) { ok (1,1); } else { ok($x,'to be false') }
+
+###############################################################################
+# objectify()
+
+@args = Math::BigInt::objectify(2,4,5);
+ok (scalar @args,3);		# 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(0,4,5);
+ok (scalar @args,3);		# 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(2,4,5);
+ok (scalar @args,3);		# 'Math::BigInt', 4, 5
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4);
+ok ($args[2],5);
+
+@args = Math::BigInt::objectify(2,4,5,6,7);
+ok (scalar @args,5);		# 'Math::BigInt', 4, 5, 6, 7
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4); ok (ref($args[1]),$args[0]);
+ok ($args[2],5); ok (ref($args[2]),$args[0]);
+ok ($args[3],6); ok (ref($args[3]),'');
+ok ($args[4],7); ok (ref($args[4]),'');
+
+@args = Math::BigInt::objectify(2,'Math::BigInt',4,5,6,7);
+ok (scalar @args,5);		# 'Math::BigInt', 4, 5, 6, 7
+ok ($args[0],'Math::BigInt');
+ok ($args[1],4); ok (ref($args[1]),$args[0]);
+ok ($args[2],5); ok (ref($args[2]),$args[0]);
+ok ($args[3],6); ok (ref($args[3]),'');
+ok ($args[4],7); ok (ref($args[4]),'');
+
+###############################################################################
+# test for flaoting-point input (other tests in bnorm() below)
+
+$z = 1050000000000000;          # may be int on systems with 64bit?
+$x = Math::BigInt->new($z); ok ($x->bsstr(),'105e+13');	# not 1.03e+15?
+$z = 1e+129;			# definitely a float
+$x = Math::BigInt->new($z); ok ($x->bsstr(),$z);
+
+###############################################################################
+# prime number tests, also test for **= and length()
+# found on: http://www.utm.edu/research/primes/notes/by_year.html
+
+# ((2^148)-1)/17
+$x = Math::BigInt->new(2); $x **= 148; $x++; $x = $x / 17;
+ok ($x,"20988936657440586486151264256610222593863921");
+ok ($x->length(),length "20988936657440586486151264256610222593863921");
+
+# MM7 = 2^127-1
+$x = Math::BigInt->new(2); $x **= 127; $x--;
+ok ($x,"170141183460469231731687303715884105727");
+
+# I am afraid the following is not yet possible due to slowness
+# Also, testing for 2 meg output is a bit hard ;)
+#$x = new Math::BigInt(2); $x **= 6972593; $x--;
+
+# 593573509*2^332162+1 has exactly 100.000 digits
+# takes over 16 mins and still not complete, so can not be done yet ;)
+#$x = Math::BigInt->new(2); $x **= 332162; $x *= "593573509"; $x++;
+#ok ($x->digits(),100000);
+
+###############################################################################
+# inheritance and overriding of _swap
+
+$x = Math::Foo->new(5);
+$x = $x - 8;		# 8 - 5 instead of 5-8
+ok ($x,3);
+ok (ref($x),'Math::Foo');
+
+$x = Math::Foo->new(5);
+$x = 8 - $x;		# 5 - 8 instead of 8 - 5
+ok ($x,-3);
+ok (ref($x),'Math::Foo');
+
+###############################################################################
+# all tests done
+
+# devel test, see whether valid catches errors
+#$x = Math::BigInt->new(0);
+#$x->{sign} = '-';
+#is_valid($x); # nok
+#
+#$x->{sign} = 'e';
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = undef;
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = 1e6;
+#is_valid($x); # nok
+#
+#$x->{value}->[0] = -2;
+#is_valid($x); # nok
+#
+#$x->{sign} = '+';
+#is_valid($x); # ok
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+
+###############################################################################
+# sub to check validity of a BigInt internally, to ensure that no op leaves a
+# number object in an invalid state (f.i. "-0")
+
+sub is_valid
+  {
+  my $x = shift;
+
+  my $error = ["",];
+
+  # ok as reference? 
+  is_okay('ref($x)','Math::BigInt',ref($x),$error);
+
+  # has ok sign?
+  is_okay('$x->{sign}',"'+', '-', '-inf', '+inf' or 'NaN'",$x->{sign},$error)
+   if $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+
+  # is not -0?
+  if (($x->{sign} eq '-') && (@{$x->{value}} == 1) && ($x->{value}->[0] == 0))
+     {
+     is_okay("\$x ne '-0'","0",$x,$error);
+     }
+  # all parts are valid?
+  my $i = 0; my $j = scalar @{$x->{value}}; my $e; my $try;
+  while ($i < $j)
+    {
+    $e = $x->{value}->[$i]; $e = 'undef' unless defined $e;
+    $try = '=~ /^[\+]?[0-9]+\$/; '."($f, $x, $e)";
+    last if $e !~ /^[+]?[0-9]+$/;
+    $try = ' < 0 || >= 1e5; '."($f, $x, $e)";
+    last if $e <0 || $e >= 1e5;
+    # this test is disabled, since new/bnorm and certain ops (like early out
+    # in add/sub) are allowed/expected to leave '00000' in some elements
+    #$try = '=~ /^00+/; '."($f, $x, $e)";
+    #last if $e =~ /^00+/;
+    $i++;
+    }
+  is_okay("\$x->{value}->[$i] $try","not $e",$e,$error)
+   if $i < $j; # trough all?
+  
+  # see whether errors crop up
+  $error->[1] = 'undef' unless defined $error->[1];
+  if ($error->[0] ne "")
+    {
+    ok ($error->[1],$error->[2]);
+    print "# Tried: $error->[0]\n";
+    }
+  else
+    {
+    ok (1,1);
+    }
+  }
+
+sub is_okay
+  {
+  my ($tried,$expected,$try,$error) = @_;
+
+  return if $error->[0] ne "";	# error, no further testing
+
+  @$error = ( $tried, $try, $expected ) if $try ne $expected;
+  }
+
+__END__
+&bnorm
+# binary input
+0babc:NaN
+0b123:NaN
+0b0:0
+-0b0:0
+-0b1:-1
+0b0001:1
+0b001:1
+0b011:3
+0b101:5
+0b1000000000000000000000000000000:1073741824
+# hex input
+-0x0:0
+0xabcdefgh:NaN
+0x1234:4660
+0xabcdef:11259375
+-0xABCDEF:-11259375
+-0x1234:-4660
+0x12345678:305419896
+# inf input
++inf:+inf
+-inf:-inf
+0inf:NaN
+# normal input
+:NaN
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:0
++0:0
++00:0
++000:0
+000000000000000000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+1_2_3:123
+_123:NaN
+_123_:NaN
+_123_:NaN
+1__23:NaN
+10000000000E-1_0:1
+1E2:100
+1E1:10
+1E0:1
+E1:NaN
+E23:NaN
+1.23E2:123
+1.23E1:NaN
+1.23E-1:NaN
+100E-1:10
+# floating point input
+1.01E2:101
+1010E-1:101
+-1010E0:-1010
+-1010E1:-10100
+-1010E-2:NaN
+-1.01E+1:NaN
+-1.01E-1:NaN
+&binf
+1:+:+inf
+2:-:-inf
+3:abc:+inf
+&is_inf
++inf::1
+-inf::1
+abc::0
+1::0
+NaN::0
+-1::0
++inf:-:0
++inf:+:1
+-inf:-:1
+-inf:+:0
+&blsft
+abc:abc:NaN
++2:+2:+8
++1:+32:+4294967296
++1:+48:+281474976710656
++8:-2:NaN
+# excercise base 10
++12345:4:10:123450000
+-1234:0:10:-1234
++1234:0:10:+1234
++2:2:10:200
++12:2:10:1200
++1234:-3:10:NaN
+1234567890123:12:10:1234567890123000000000000
+&brsft
+abc:abc:NaN
++8:+2:+2
++4294967296:+32:+1
++281474976710656:+48:+1
++2:-2:NaN
+# excercise base 10
+-1234:0:10:-1234
++1234:0:10:+1234
++200:2:10:2
++1234:3:10:1
++1234:2:10:12
++1234:-3:10:NaN
+310000:4:10:31
+12300000:5:10:123
+1230000000000:10:10:123
+09876123456789067890:12:10:9876123
+1234561234567890123:13:10:123456
+&bsstr
+1e+34:1e+34
+123.456E3:123456e+0
+100:1e+2
+abc:NaN
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
++100:+5:1
+-123456789:+987654321:-1
++123456789:-987654321:1
+-987654321:+123456789:-1
+&bacmp
++0:-0:0
++0:+1:-1
+-1:+1:0
++1:-1:0
+-1:+2:-1
++2:-1:1
+-123456789:+987654321:-1
++123456789:-987654321:-1
+-987654321:+123456789:1
+&binc
+abc:NaN
++0:+1
++1:+2
+-1:+0
+&bdec
+abc:NaN
++0:-1
++1:+0
+-1:-2
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
++25:+25:+625
++12345:+12345:+152399025
++99999:+11111:+1111088889
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1:+26:+0
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
++1111088889:+99999:+11111
+-5:-3:1
+4:3:1
+1:3:0
+-2:-3:0
+-2:3:-1
+1:-3:-1
+-5:3:-2
+4:-3:-2
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+-9:+5:+1
++9:-5:-1
+-9:-5:-4
+-5:3:1
+-2:3:1
+4:3:1
+1:3:1
+-5:-3:-2
+-2:-3:-2
+4:-3:-2
+1:-3:-2
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
+-3:+2:+1
++100:+625:+25
++4096:+81:+1
++1034:+804:+2
++27:+90:+56:+1
++27:+90:+54:+9
+&blcm
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:NaN
++1:+0:+0
++0:+1:+0
++27:+90:+270
++1034:+804:+415668
+&band
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+0
++281474976710656:+0:+0
++281474976710656:+1:+0
++281474976710656:+281474976710656:+281474976710656
+&bior
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+281474976710656
+&bxor
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
++8:+2:+10
++281474976710656:+0:+281474976710656
++281474976710656:+1:+281474976710657
++281474976710656:+281474976710656:+0
+&bnot
+abc:NaN
++0:-1
++8:-9
++281474976710656:-281474976710657
+&digit
+0:0:0
+12:0:2
+12:1:1
+123:0:3
+123:1:2
+123:2:1
+123:-1:1
+123:-2:2
+123:-3:3
+123456:0:6
+123456:1:5
+123456:2:4
+123456:3:3
+123456:4:2
+123456:5:1
+123456:-1:1
+123456:-2:2
+123456:-3:3
+100000:-3:0
+100000:0:0
+100000:1:0
+&mantissa
+abc:NaN
+1e4:1
+2e0:2
+123:123
+-1:-1
+-2:-2
+&exponent
+abc:NaN
+1e4:4
+2e0:0
+123:0
+-1:0
+-2:0
+0:1
+&parts
+abc:NaN,NaN
+1e4:1,4
+2e0:2,0
+123:123,0
+-1:-1,0
+-2:-2,0
+0:0,1
+&bpow
+0:0:1
+0:1:0
+0:2:0
+0:-1:NaN
+0:-2:NaN
+1:0:1
+1:1:1
+1:2:1
+1:3:1
+1:-1:1
+1:-2:1
+1:-3:1
+2:0:1
+2:1:2
+2:2:4
+2:3:8
+3:3:27
+2:-1:NaN
+-2:-1:NaN
+2:-2:NaN
+-2:-2:NaN
+# 1 ** -x => 1 / (1 ** x)
+-1:0:1
+-2:0:1
+-1:1:-1
+-1:2:1
+-1:3:-1
+-1:4:1
+-1:5:-1
+-1:-1:-1
+-1:-2:1
+-1:-3:-1
+-1:-4:1
+10:2:100
+10:3:1000
+10:4:10000
+10:5:100000
+10:6:1000000
+10:7:10000000
+10:8:100000000
+10:9:1000000000
+10:20:100000000000000000000
+123456:2:15241383936
+&length
+100:3
+10:2
+1:1
+0:1
+12345:5
+10000000000000000:17
+-123:3
+&bsqrt
+144:12
+16:4
+4:2
+2:1
+12:3
+256:16
+100000000:10000
+4000000000000:2000000
+1:1
+0:0
+-2:NaN
+Nan:NaN
+&bround
+$round_mode('trunc')
+1234:0:1234
+1234:2:1200
+123456:4:123400
+123456:5:123450
+123456:6:123456
++10123456789:5:+10123000000
+-10123456789:5:-10123000000
++10123456789:9:+10123456700
+-10123456789:9:-10123456700
++101234500:6:+101234000
+-101234500:6:-101234000
+#+101234500:-4:+101234000
+#-101234500:-4:-101234000
+$round_mode('zero')
++20123456789:5:+20123000000
+-20123456789:5:-20123000000
++20123456789:9:+20123456800
+-20123456789:9:-20123456800
++201234500:6:+201234000
+-201234500:6:-201234000
+#+201234500:-4:+201234000
+#-201234500:-4:-201234000
++12345000:4:12340000
+-12345000:4:-12340000
+$round_mode('+inf')
++30123456789:5:+30123000000
+-30123456789:5:-30123000000
++30123456789:9:+30123456800
+-30123456789:9:-30123456800
++301234500:6:+301235000
+-301234500:6:-301234000
+#+301234500:-4:+301235000
+#-301234500:-4:-301234000
++12345000:4:12350000
+-12345000:4:-12340000
+$round_mode('-inf')
++40123456789:5:+40123000000
+-40123456789:5:-40123000000
++40123456789:9:+40123456800
+-40123456789:9:-40123456800
++401234500:6:+401234000
++401234500:6:+401234000
+#-401234500:-4:-401235000
+#-401234500:-4:-401235000
++12345000:4:12340000
+-12345000:4:-12350000
+$round_mode('odd')
++50123456789:5:+50123000000
+-50123456789:5:-50123000000
++50123456789:9:+50123456800
+-50123456789:9:-50123456800
++501234500:6:+501235000
+-501234500:6:-501235000
+#+501234500:-4:+501235000
+#-501234500:-4:-501235000
++12345000:4:12350000
+-12345000:4:-12350000
+$round_mode('even')
++60123456789:5:+60123000000
+-60123456789:5:-60123000000
++60123456789:9:+60123456800
+-60123456789:9:-60123456800
++601234500:6:+601234000
+-601234500:6:-601234000
+#+601234500:-4:+601234000
+#-601234500:-4:-601234000
+#-601234500:-9:0
+#-501234500:-9:0
+#-601234500:-8:0
+#-501234500:-8:0
++1234567:7:1234567
++1234567:6:1234570
++12345000:4:12340000
+-12345000:4:-12340000
+&is_odd
+abc:0
+0:0
+1:1
+3:1
+-1:1
+-3:1
+10000001:1
+10000002:0
+2:0
+&is_even
+abc:0
+0:1
+1:0
+3:0
+-1:0
+-3:0
+10000001:0
+10000002:1
+2:1
+&is_zero
+0:1
+NaNzero:0
+123:0
+-1:0
+1:0
+&_set
+2:-1:-1
+-2:1:1
+NaN:2:2
+2:abc:NaN
+&is_one
+0:0
+1:1
+2:0
+-1:0
+-2:0
+# floor and ceil tests are pretty pointless in integer space...but play safe
+&bfloor
+0:0
+-1:-1
+-2:-2
+2:2
+3:3
+abc:NaN
+&bceil
+0:0
+-1:-1
+-2:-2
+2:2
+3:3
+abc:NaN
diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
new file mode 100644
index 0000000000..3948102f0e
--- /dev/null
+++ b/lib/Math/BigInt/t/mbimbf.t
@@ -0,0 +1,214 @@
+#!/usr/bin/perl -w
+
+# test accuracy, precicion and fallback, round_mode
+
+use strict;
+use Test;
+
+BEGIN 
+  {
+  $| = 1;
+  # chdir 't' if -d 't';
+  unshift @INC, '../lib'; # for running manually
+  plan tests => 103;
+  }
+
+use Math::BigInt;
+use Math::BigFloat;
+
+my ($x,$y,$z,$u);
+
+###############################################################################
+# test defaults and set/get
+
+ok_undef ($Math::BigInt::accuracy);
+ok_undef ($Math::BigInt::precision);
+ok ($Math::BigInt::div_scale,40);
+ok (Math::BigInt::round_mode(),'even');
+ok ($Math::BigInt::rnd_mode,'even');
+
+ok_undef ($Math::BigFloat::accuracy);
+ok_undef ($Math::BigFloat::precision);
+ok ($Math::BigFloat::div_scale,40);
+ok ($Math::BigFloat::rnd_mode,'even');
+
+# accuracy
+foreach (qw/5 42 -1 0/)
+  {
+  ok ($Math::BigFloat::accuracy = $_,$_);
+  ok ($Math::BigInt::accuracy = $_,$_);
+  }
+ok_undef ($Math::BigFloat::accuracy = undef);
+ok_undef ($Math::BigInt::accuracy = undef);
+
+# precision
+foreach (qw/5 42 -1 0/)
+  {
+  ok ($Math::BigFloat::precision = $_,$_);
+  ok ($Math::BigInt::precision = $_,$_);
+  }
+ok_undef ($Math::BigFloat::precision = undef);
+ok_undef ($Math::BigInt::precision = undef);
+
+# fallback
+foreach (qw/5 42 1/)
+  {
+  ok ($Math::BigFloat::div_scale = $_,$_);
+  ok ($Math::BigInt::div_scale = $_,$_);
+  }
+# illegal values are possible for fallback due to no accessor
+
+# round_mode
+foreach (qw/odd even zero trunc +inf -inf/)
+  {
+  ok ($Math::BigFloat::rnd_mode = $_,$_);
+  ok ($Math::BigInt::rnd_mode = $_,$_);
+  }
+$Math::BigFloat::rnd_mode = 4;
+ok ($Math::BigFloat::rnd_mode,4);
+ok ($Math::BigInt::rnd_mode,'-inf');	# from above
+
+$Math::BigInt::accuracy = undef;
+$Math::BigInt::precision = undef;
+# local copies
+$x = Math::BigFloat->new(123.456);
+ok_undef ($x->accuracy());
+ok ($x->accuracy(5),5);
+ok_undef ($x->accuracy(undef),undef);
+ok_undef ($x->precision());
+ok ($x->precision(5),5);
+ok_undef ($x->precision(undef),undef);
+
+# see if MBF changes MBIs values
+ok ($Math::BigInt::accuracy = 42,42);
+ok ($Math::BigFloat::accuracy = 64,64);
+ok ($Math::BigInt::accuracy,42);		# should be still 42
+ok ($Math::BigFloat::accuracy,64);		# should be still 64
+
+###############################################################################
+# see if creating a number under set A or P will round it
+
+$Math::BigInt::accuracy = 4;
+$Math::BigInt::precision = 3;
+
+ok (Math::BigInt->new(123456),123500);	# with A
+$Math::BigInt::accuracy = undef;
+ok (Math::BigInt->new(123456),123000);	# with P
+
+$Math::BigFloat::accuracy = 4;
+$Math::BigFloat::precision = -1;
+$Math::BigInt::precision = undef;
+
+ok (Math::BigFloat->new(123.456),123.5);	# with A
+$Math::BigFloat::accuracy = undef;
+ok (Math::BigFloat->new(123.456),123.5);	# with P from MBF, not MBI!
+
+$Math::BigFloat::precision = undef;
+
+###############################################################################
+# see if setting accuracy/precision actually rounds the number
+
+$x = Math::BigFloat->new(123.456); $x->accuracy(4);   ok ($x,123.5);
+$x = Math::BigFloat->new(123.456); $x->precision(-2); ok ($x,123.46);
+
+$x = Math::BigInt->new(123456);    $x->accuracy(4);   ok ($x,123500);
+$x = Math::BigInt->new(123456);    $x->precision(2);  ok ($x,123500);
+
+###############################################################################
+# test actual rounding via round()
+
+$x = Math::BigFloat->new(123.456);
+ok ($x->copy()->round(5,2),123.46);
+ok ($x->copy()->round(4,2),123.5);
+ok ($x->copy()->round(undef,-2),123.46);
+ok ($x->copy()->round(undef,2),100);
+
+$x = Math::BigFloat->new(123.45000);
+ok ($x->copy()->round(undef,-1,'odd'),123.5);
+
+# see if rounding is 'sticky'
+$x = Math::BigFloat->new(123.4567);
+$y = $x->copy()->bround();		# no-op since nowhere A or P defined
+
+ok ($y,123.4567);			
+$y = $x->copy()->round(5,2);
+ok ($y->accuracy(),5);
+ok_undef ($y->precision());		# A has precedence, so P still unset
+$y = $x->copy()->round(undef,2);
+ok ($y->precision(),2);
+ok_undef ($y->accuracy());		# P has precedence, so A still unset
+
+# does copy work?
+$x = Math::BigFloat->new(123.456); $x->accuracy(4); $x->precision(2);
+$z = $x->copy(); ok ($z->accuracy(),4); ok ($z->precision(),2);
+
+###############################################################################
+# test wether operations round properly afterwards
+# These tests are not complete, since they do not excercise every "return"
+# statement in the op's. But heh, it's better than nothing...
+
+$x = Math::BigFloat->new(123.456);
+$y = Math::BigFloat->new(654.321);
+$x->{_a} = 5;		# $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;		# $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y;		ok ($z,777.8);
+$z = $y - $x;		ok ($z,530.9);
+$z = $y * $x;		ok ($z,80780);
+$z = $x ** 2;		ok ($z,15241);
+$z = $x * $x;		ok ($z,15241);
+# not yet: $z = -$x;		ok ($z,-123.46); ok ($x,123.456);
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
+$x = Math::BigFloat->new(123456); $x->{_a} = 4;
+$z = $x->copy; $z++;	ok ($z,123500);
+
+$x = Math::BigInt->new(123456);
+$y = Math::BigInt->new(654321);
+$x->{_a} = 5;		# $x->accuracy(5) would round $x straightaway
+$y->{_a} = 4;		# $y->accuracy(4) would round $x straightaway
+
+$z = $x + $y; 		ok ($z,777800);
+$z = $y - $x; 		ok ($z,530900);
+$z = $y * $x;		ok ($z,80780000000);
+$z = $x ** 2;		ok ($z,15241000000);
+# not yet: $z = -$x;		ok ($z,-123460); ok ($x,123456);
+$z = $x->copy; $z++;	ok ($z,123460);
+$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62000);
+
+###############################################################################
+# test mixed arguments
+
+$x = Math::BigFloat->new(10);
+$u = Math::BigFloat->new(2.5);
+$y = Math::BigInt->new(2);
+
+$z = $x + $y; ok ($z,12); ok (ref($z),'Math::BigFloat');
+$z = $x / $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
+$z = $u * $y; ok ($z,5); ok (ref($z),'Math::BigFloat');
+
+$y = Math::BigInt->new(12345);
+$z = $u->copy()->bmul($y,2,0,'odd'); ok ($z,31000);
+$z = $u->copy()->bmul($y,3,0,'odd'); ok ($z,30900);
+$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
+$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
+$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
+
+# breakage:
+# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
+# $z = $y * $u; ok ($z,5); ok (ref($z),'Math::BigInt');
+# $z = $y + $x; ok ($z,12); ok (ref($z),'Math::BigInt');
+# $z = $y / $x; ok ($z,0); ok (ref($z),'Math::BigInt');
+
+# all done
+
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+  {
+  my $x = shift;
+
+  ok (1,1) and return if !defined $x;
+  ok ($x,'undef');
+  }
+
diff --git a/lib/Math/Complex.t b/lib/Math/Complex.t
new file mode 100755
index 0000000000..334374d519
--- /dev/null
+++ b/lib/Math/Complex.t
@@ -0,0 +1,979 @@
+#!./perl
+
+# $RCSfile: complex.t,v $
+#
+# Regression tests for the Math::Complex pacakge
+# -- Raphael Manfredi	since Sep 1996
+# -- Jarkko Hietaniemi	since Mar 1997
+# -- Daniel S. Lewart	since Sep 1997
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::Complex;
+
+use vars qw($VERSION);
+
+$VERSION = 1.91;
+
+my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
+
+$test = 0;
+$| = 1;
+my @script = (
+    'my ($res, $s0,$s1,$s2,$s3,$s4,$s5,$s6,$s7,$s8,$s9,$s10, $z0,$z1,$z2);' .
+	"\n\n"
+);
+my $eps = 1e-13;
+
+if ($^O eq 'unicos') { 	# For some reason root() produces very inaccurate
+    $eps = 1e-10;	# results in Cray UNICOS, and occasionally also
+}			# cos(), sin(), cosh(), sinh().  The division
+			# of doubles is the current suspect.
+
+while (<DATA>) {
+	s/^\s+//;
+	next if $_ eq '' || /^\#/;
+	chomp;
+	$test_set = 0;		# Assume not a test over a set of values
+	if (/^&(.+)/) {
+		$op = $1;
+		next;
+	}
+	elsif (/^\{(.+)\}/) {
+		set($1, \@set, \@val);
+		next;
+	}
+	elsif (s/^\|//) {
+		$test_set = 1;	# Requests we loop over the set...
+	}
+	my @args = split(/:/);
+	if ($test_set == 1) {
+		my $i;
+		for ($i = 0; $i < @set; $i++) {
+			# complex number
+			$target = $set[$i];
+			# textual value as found in set definition
+			$zvalue = $val[$i];
+			test($zvalue, $target, @args);
+		}
+	} else {
+		test($op, undef, @args);
+	}
+}
+
+#
+
+sub test_mutators {
+    my $op;
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->Re(2);
+    $z->Im(3);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless Re($z) == 2 and Im($z) == 3;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->abs(3 * sqrt(2));
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless (abs($z) - 3 * sqrt(2)) < $eps and
+                        (arg($z) - pi / 4     ) < $eps and
+                        (Re($z) - 3           ) < $eps and
+                        (Im($z) - 3           ) < $eps;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+
+    $test++;
+push(@script, <<'EOT');
+{
+    my $z = cplx(  1,  1);
+    $z->arg(-3 / 4 * pi);
+    print "# $test Re(z) = ",$z->Re(), " Im(z) = ", $z->Im(), " z = $z\n";
+    print 'not ' unless (arg($z) + 3 / 4 * pi) < $eps and
+                        (abs($z) - sqrt(2)   ) < $eps and
+                        (Re($z) + 1          ) < $eps and
+                        (Im($z) + 1          ) < $eps;
+EOT
+    push(@script, qq(print "ok $test\\n"}\n));
+}
+
+test_mutators();
+
+my $constants = '
+my $i    = cplx(0,  1);
+my $pi   = cplx(pi, 0);
+my $pii  = cplx(0, pi);
+my $pip2 = cplx(pi/2, 0);
+my $zero = cplx(0, 0);
+';
+
+push(@script, $constants);
+
+
+# test the divbyzeros
+
+sub test_dbz {
+    for my $op (@_) {
+	$test++;
+	push(@script, <<EOT);
+	eval '$op';
+	(\$bad) = (\$@ =~ /(.+)/);
+	print "# $test op = $op divbyzero? \$bad...\n";
+	print 'not ' unless (\$@ =~ /Division by zero/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+# test the logofzeros
+
+sub test_loz {
+    for my $op (@_) {
+	$test++;
+	push(@script, <<EOT);
+	eval '$op';
+	(\$bad) = (\$@ =~ /(.+)/);
+	print "# $test op = $op logofzero? \$bad...\n";
+	print 'not ' unless (\$@ =~ /Logarithm of zero/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+test_dbz(
+	 'i/0',
+	 'acot(0)',
+	 'acot(+$i)',
+#	 'acoth(-1)',	# Log of zero.
+	 'acoth(0)',
+	 'acoth(+1)',
+	 'acsc(0)',
+	 'acsch(0)',
+	 'asec(0)',
+	 'asech(0)',
+	 'atan($i)',
+#	 'atanh(-1)',	# Log of zero.
+	 'atanh(+1)',
+	 'cot(0)',
+	 'coth(0)',
+	 'csc(0)',
+	 'csch(0)',
+	);
+
+test_loz(
+	 'log($zero)',
+	 'atan(-$i)',
+	 'acot(-$i)',
+	 'atanh(-1)',
+	 'acoth(-1)',
+	);
+
+# test the bad roots
+
+sub test_broot {
+    for my $op (@_) {
+	$test++;
+	push(@script, <<EOT);
+	eval 'root(2, $op)';
+	(\$bad) = (\$@ =~ /(.+)/);
+	print "# $test op = $op badroot? \$bad...\n";
+	print 'not ' unless (\$@ =~ /root rank must be/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+test_broot(qw(-3 -2.1 0 0.99));
+
+sub test_display_format {
+    $test++;
+    push @script, <<EOS;
+    print "# package display_format cartesian?\n";
+    print "not " unless Math::Complex->display_format eq 'cartesian';
+    print "ok $test\n";
+EOS
+
+    push @script, <<EOS;
+    my \$j = (root(1,3))[1];
+
+    \$j->display_format('polar');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j display_format polar?\n";
+    print "not " unless \$j->display_format eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "[1,2pi/3]";
+    print "ok $test\n";
+
+    my %display_format;
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{style} polar?\n";
+    print "not " unless \$display_format{style} eq 'polar';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 2?\n";
+    print "not " unless keys %display_format == 2;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '%.5f');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "-0.50000+0.86603i";
+    print "ok $test\n";
+
+    %display_format = \$j->display_format;
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# display_format{format} %.5f?\n";
+    print "not " unless \$display_format{format} eq '%.5f';
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# keys %display_format == 3?\n";
+    print "not " unless keys %display_format == 3;
+    print "ok $test\n";
+
+    \$j->display_format('format' => undef);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^-0(?:\\.5(?:0000\\d+)?|\\.49999\\d+)\\+0.86602540\\d+i\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'polar', 'polar_pretty_print' => 0);
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" =~ /^\\[1,2\\.09439510\\d+\\]\$/;
+    print "ok $test\n";
+
+    \$j->display_format('style' => 'cartesian', 'format' => '(%.5g)');
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j = \$j\n";
+    print "not " unless "\$j" eq "(-0.5)+(0.86603)i";
+    print "ok $test\n";
+EOS
+
+    $test++;
+    push @script, <<EOS;
+    print "# j display_format cartesian?\n";
+    print "not " unless \$j->display_format eq 'cartesian';
+    print "ok $test\n";
+EOS
+}
+
+test_display_format();
+
+print "1..$test\n";
+eval join '', @script;
+die $@ if $@;
+
+sub abop {
+	my ($op) = @_;
+
+	push(@script, qq(print "# $op=\n";));
+}
+
+sub test {
+	my ($op, $z, @args) = @_;
+	my ($baop) = 0;
+	$test++;
+	my $i;
+	$baop = 1 if ($op =~ s/;=$//);
+	for ($i = 0; $i < @args; $i++) {
+		$val = value($args[$i]);
+		push @script, "\$z$i = $val;\n";
+	}
+	if (defined $z) {
+		$args = "'$op'";		# Really the value
+		$try = "abs(\$z0 - \$z1) <= $eps ? \$z1 : \$z0";
+		push @script, "\$res = $try; ";
+		push @script, "check($test, $args[0], \$res, \$z$#args, $args);\n";
+	} else {
+		my ($try, $args);
+		if (@args == 2) {
+			$try = "$op \$z0";
+			$args = "'$args[0]'";
+		} else {
+			$try = ($op =~ /^\w/) ? "$op(\$z0, \$z1)" : "\$z0 $op \$z1";
+			$args = "'$args[0]', '$args[1]'";
+		}
+		push @script, "\$res = $try; ";
+		push @script, "check($test, '$try', \$res, \$z$#args, $args);\n";
+		if (@args > 2 and $baop) { # binary assignment ops
+			$test++;
+			# check the op= works
+			push @script, <<EOB;
+{
+	my \$za = cplx(ref \$z0 ? \@{\$z0->cartesian} : (\$z0, 0));
+
+	my (\$z1r, \$z1i) = ref \$z1 ? \@{\$z1->cartesian} : (\$z1, 0);
+
+	my \$zb = cplx(\$z1r, \$z1i);
+
+	\$za $op= \$zb;
+	my (\$zbr, \$zbi) = \@{\$zb->cartesian};
+
+	check($test, '\$z0 $op= \$z1', \$za, \$z$#args, $args);
+EOB
+			$test++;
+			# check that the rhs has not changed
+			push @script, qq(print "not " unless (\$zbr == \$z1r and \$zbi == \$z1i););
+			push @script, qq(print "ok $test\\n";\n);
+			push @script, "}\n";
+		}
+	}
+}
+
+sub set {
+	my ($set, $setref, $valref) = @_;
+	@{$setref} = ();
+	@{$valref} = ();
+	my @set = split(/;\s*/, $set);
+	my @res;
+	my $i;
+	for ($i = 0; $i < @set; $i++) {
+		push(@{$valref}, $set[$i]);
+		my $val = value($set[$i]);
+		push @script, "\$s$i = $val;\n";
+		push @{$setref}, "\$s$i";
+	}
+}
+
+sub value {
+	local ($_) = @_;
+	if (/^\s*\((.*),(.*)\)/) {
+		return "cplx($1,$2)";
+	}
+	elsif (/^\s*([\-\+]?(?:\d+(\.\d+)?|\.\d+)(?:[e[\-\+]\d+])?)/) {
+		return "cplx($1,0)";
+	}
+	elsif (/^\s*\[(.*),(.*)\]/) {
+		return "cplxe($1,$2)";
+	}
+	elsif (/^\s*'(.*)'/) {
+		my $ex = $1;
+		$ex =~ s/\bz\b/$target/g;
+		$ex =~ s/\br\b/abs($target)/g;
+		$ex =~ s/\bt\b/arg($target)/g;
+		$ex =~ s/\ba\b/Re($target)/g;
+		$ex =~ s/\bb\b/Im($target)/g;
+		return $ex;
+	}
+	elsif (/^\s*"(.*)"/) {
+		return "\"$1\"";
+	}
+	return $_;
+}
+
+sub check {
+	my ($test, $try, $got, $expected, @z) = @_;
+
+	print "# @_\n";
+
+	if ("$got" eq "$expected"
+	    ||
+	    ($expected =~ /^-?\d/ && $got == $expected)
+	    ||
+	    (abs($got - $expected) < $eps)
+	    ) {
+		print "ok $test\n";
+	} else {
+		print "not ok $test\n";
+		my $args = (@z == 1) ? "z = $z[0]" : "z0 = $z[0], z1 = $z[1]";
+		print "# '$try' expected: '$expected' got: '$got' for $args\n";
+	}
+}
+
+sub addsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + i*$z2) * ($z1 - i*$z2);
+}
+
+sub subsq {
+    my ($z1, $z2) = @_;
+    return ($z1 + $z2) * ($z1 - $z2);
+}
+
+__END__
+&+;=
+(3,4):(3,4):(6,8)
+(-3,4):(3,-4):(0,0)
+(3,4):-3:(0,4)
+1:(4,2):(5,2)
+[2,0]:[2,pi]:(0,0)
+
+&++
+(2,1):(3,1)
+
+&-;=
+(2,3):(-2,-3)
+[2,pi/2]:[2,-(pi)/2]
+2:[2,0]:(0,0)
+[3,0]:2:(1,0)
+3:(4,5):(-1,-5)
+(4,5):3:(1,5)
+(2,1):(3,5):(-1,-4)
+
+&--
+(1,2):(0,2)
+[2,pi]:[3,pi]
+
+&*;=
+(0,1):(0,1):(-1,0)
+(4,5):(1,0):(4,5)
+[2,2*pi/3]:(1,0):[2,2*pi/3]
+2:(0,1):(0,2)
+(0,1):3:(0,3)
+(0,1):(4,1):(-1,4)
+(2,1):(4,-1):(9,2)
+
+&/;=
+(3,4):(3,4):(1,0)
+(4,-5):1:(4,-5)
+1:(0,1):(0,-1)
+(0,6):(0,2):(3,0)
+(9,2):(4,-1):(2,1)
+[4,pi]:[2,pi/2]:[2,pi/2]
+[2,pi/2]:[4,pi]:[0.5,-(pi)/2]
+
+&**;=
+(2,0):(3,0):(8,0)
+(3,0):(2,0):(9,0)
+(2,3):(4,0):(-119,-120)
+(0,0):(1,0):(0,0)
+(0,0):(2,3):(0,0)
+(1,0):(0,0):(1,0)
+(1,0):(1,0):(1,0)
+(1,0):(2,3):(1,0)
+(2,3):(0,0):(1,0)
+(2,3):(1,0):(2,3)
+(0,0):(0,0):(1,0)
+
+&Re
+(3,4):3
+(-3,4):-3
+[1,pi/2]:0
+
+&Im
+(3,4):4
+(3,-4):-4
+[1,pi/2]:1
+
+&abs
+(3,4):5
+(-3,4):5
+
+&arg
+[2,0]:0
+[-2,0]:pi
+
+&~
+(4,5):(4,-5)
+(-3,4):(-3,-4)
+[2,pi/2]:[2,-(pi)/2]
+
+&<
+(3,4):(1,2):0
+(3,4):(3,2):0
+(3,4):(3,8):1
+(4,4):(5,129):1
+
+&==
+(3,4):(4,5):0
+(3,4):(3,5):0
+(3,4):(2,4):0
+(3,4):(3,4):1
+
+&sqrt
+-9:(0,3)
+(-100,0):(0,10)
+(16,-30):(5,-3)
+
+&stringify_cartesian
+(-100,0):"-100"
+(0,1):"i"
+(4,-3):"4-3i"
+(4,0):"4"
+(-4,0):"-4"
+(-2,4):"-2+4i"
+(-2,-1):"-2-i"
+
+&stringify_polar
+[-1, 0]:"[1,pi]"
+[1, pi/3]:"[1,pi/3]"
+[6, -2*pi/3]:"[6,-2pi/3]"
+[0.5, -9*pi/11]:"[0.5,-9pi/11]"
+
+{ (4,3); [3,2]; (-3,4); (0,2); [2,1] }
+
+|'z + ~z':'2*Re(z)'
+|'z - ~z':'2*i*Im(z)'
+|'z * ~z':'abs(z) * abs(z)'
+
+{ (0.5, 0); (-0.5, 0); (2,3); [3,2]; (-3,2); (0,2); 3; 1.2; (-3, 0); (-2, -1); [2,1] }
+
+|'(root(z, 4))[1] ** 4':'z'
+|'(root(z, 5))[3] ** 5':'z'
+|'(root(z, 8))[7] ** 8':'z'
+|'abs(z)':'r'
+|'acot(z)':'acotan(z)'
+|'acsc(z)':'acosec(z)'
+|'acsc(z)':'asin(1 / z)'
+|'asec(z)':'acos(1 / z)'
+|'cbrt(z)':'cbrt(r) * exp(i * t/3)'
+|'cos(acos(z))':'z'
+|'addsq(cos(z), sin(z))':1
+|'cos(z)':'cosh(i*z)'
+|'subsq(cosh(z), sinh(z))':1
+|'cot(acot(z))':'z'
+|'cot(z)':'1 / tan(z)'
+|'cot(z)':'cotan(z)'
+|'csc(acsc(z))':'z'
+|'csc(z)':'1 / sin(z)'
+|'csc(z)':'cosec(z)'
+|'exp(log(z))':'z'
+|'exp(z)':'exp(a) * exp(i * b)'
+|'ln(z)':'log(z)'
+|'log(exp(z))':'z'
+|'log(z)':'log(r) + i*t'
+|'log10(z)':'log(z) / log(10)'
+|'logn(z, 2)':'log(z) / log(2)'
+|'logn(z, 3)':'log(z) / log(3)'
+|'sec(asec(z))':'z'
+|'sec(z)':'1 / cos(z)'
+|'sin(asin(z))':'z'
+|'sin(i * z)':'i * sinh(z)'
+|'sqrt(z) * sqrt(z)':'z'
+|'sqrt(z)':'sqrt(r) * exp(i * t/2)'
+|'tan(atan(z))':'z'
+|'z**z':'exp(z * log(z))'
+
+{ (1,1); [1,0.5]; (-2, -1); 2; -3; (-1,0.5); (0,0.5); 0.5; (2, 0); (-1, -2) }
+
+|'cosh(acosh(z))':'z'
+|'coth(acoth(z))':'z'
+|'coth(z)':'1 / tanh(z)'
+|'coth(z)':'cotanh(z)'
+|'csch(acsch(z))':'z'
+|'csch(z)':'1 / sinh(z)'
+|'csch(z)':'cosech(z)'
+|'sech(asech(z))':'z'
+|'sech(z)':'1 / cosh(z)'
+|'sinh(asinh(z))':'z'
+|'tanh(atanh(z))':'z'
+
+{ (0.2,-0.4); [1,0.5]; -1.2; (-1,0.5); 0.5; (1.1, 0) }
+
+|'acos(cos(z)) ** 2':'z * z'
+|'acosh(cosh(z)) ** 2':'z * z'
+|'acoth(z)':'acotanh(z)'
+|'acoth(z)':'atanh(1 / z)'
+|'acsch(z)':'acosech(z)'
+|'acsch(z)':'asinh(1 / z)'
+|'asech(z)':'acosh(1 / z)'
+|'asin(sin(z))':'z'
+|'asinh(sinh(z))':'z'
+|'atan(tan(z))':'z'
+|'atanh(tanh(z))':'z'
+
+&log
+(-2.0,0):(   0.69314718055995,  3.14159265358979)
+(-1.0,0):(   0               ,  3.14159265358979)
+(-0.5,0):(  -0.69314718055995,  3.14159265358979)
+( 0.5,0):(  -0.69314718055995,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0.69314718055995,  0               )
+
+&log
+( 2, 3):(    1.28247467873077,  0.98279372324733)
+(-2, 3):(    1.28247467873077,  2.15879893034246)
+(-2,-3):(    1.28247467873077, -2.15879893034246)
+( 2,-3):(    1.28247467873077, -0.98279372324733)
+
+&sin
+(-2.0,0):(  -0.90929742682568,  0               )
+(-1.0,0):(  -0.84147098480790,  0               )
+(-0.5,0):(  -0.47942553860420,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.47942553860420,  0               )
+( 1.0,0):(   0.84147098480790,  0               )
+( 2.0,0):(   0.90929742682568,  0               )
+
+&sin
+( 2, 3):(  9.15449914691143, -4.16890695996656)
+(-2, 3):( -9.15449914691143, -4.16890695996656)
+(-2,-3):( -9.15449914691143,  4.16890695996656)
+( 2,-3):(  9.15449914691143,  4.16890695996656)
+
+&cos
+(-2.0,0):(  -0.41614683654714,  0               )
+(-1.0,0):(   0.54030230586814,  0               )
+(-0.5,0):(   0.87758256189037,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.87758256189037,  0               )
+( 1.0,0):(   0.54030230586814,  0               )
+( 2.0,0):(  -0.41614683654714,  0               )
+
+&cos
+( 2, 3):( -4.18962569096881, -9.10922789375534)
+(-2, 3):( -4.18962569096881,  9.10922789375534)
+(-2,-3):( -4.18962569096881, -9.10922789375534)
+( 2,-3):( -4.18962569096881,  9.10922789375534)
+
+&tan
+(-2.0,0):(   2.18503986326152,  0               )
+(-1.0,0):(  -1.55740772465490,  0               )
+(-0.5,0):(  -0.54630248984379,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54630248984379,  0               )
+( 1.0,0):(   1.55740772465490,  0               )
+( 2.0,0):(  -2.18503986326152,  0               )
+
+&tan
+( 2, 3):( -0.00376402564150,  1.00323862735361)
+(-2, 3):(  0.00376402564150,  1.00323862735361)
+(-2,-3):(  0.00376402564150, -1.00323862735361)
+( 2,-3):( -0.00376402564150, -1.00323862735361)
+
+&sec
+(-2.0,0):(  -2.40299796172238,  0               )
+(-1.0,0):(   1.85081571768093,  0               )
+(-0.5,0):(   1.13949392732455,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.13949392732455,  0               )
+( 1.0,0):(   1.85081571768093,  0               )
+( 2.0,0):(  -2.40299796172238,  0               )
+
+&sec
+( 2, 3):( -0.04167496441114,  0.09061113719624)
+(-2, 3):( -0.04167496441114, -0.09061113719624)
+(-2,-3):( -0.04167496441114,  0.09061113719624)
+( 2,-3):( -0.04167496441114, -0.09061113719624)
+
+&csc
+(-2.0,0):(  -1.09975017029462,  0               )
+(-1.0,0):(  -1.18839510577812,  0               )
+(-0.5,0):(  -2.08582964293349,  0               )
+( 0.5,0):(   2.08582964293349,  0               )
+( 1.0,0):(   1.18839510577812,  0               )
+( 2.0,0):(   1.09975017029462,  0               )
+
+&csc
+( 2, 3):(  0.09047320975321,  0.04120098628857)
+(-2, 3):( -0.09047320975321,  0.04120098628857)
+(-2,-3):( -0.09047320975321, -0.04120098628857)
+( 2,-3):(  0.09047320975321, -0.04120098628857)
+
+&cot
+(-2.0,0):(   0.45765755436029,  0               )
+(-1.0,0):(  -0.64209261593433,  0               )
+(-0.5,0):(  -1.83048772171245,  0               )
+( 0.5,0):(   1.83048772171245,  0               )
+( 1.0,0):(   0.64209261593433,  0               )
+( 2.0,0):(  -0.45765755436029,  0               )
+
+&cot
+( 2, 3):( -0.00373971037634, -0.99675779656936)
+(-2, 3):(  0.00373971037634, -0.99675779656936)
+(-2,-3):(  0.00373971037634,  0.99675779656936)
+( 2,-3):( -0.00373971037634,  0.99675779656936)
+
+&asin
+(-2.0,0):(  -1.57079632679490,  1.31695789692482)
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -0.52359877559830,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52359877559830,  0               )
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   1.57079632679490, -1.31695789692482)
+
+&asin
+( 2, 3):(  0.57065278432110,  1.98338702991654)
+(-2, 3):( -0.57065278432110,  1.98338702991654)
+(-2,-3):( -0.57065278432110, -1.98338702991654)
+( 2,-3):(  0.57065278432110, -1.98338702991654)
+
+&acos
+(-2.0,0):(   3.14159265358979, -1.31695789692482)
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   2.09439510239320,  0               )
+( 0.0,0):(   1.57079632679490,  0               )
+( 0.5,0):(   1.04719755119660,  0               )
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   0               ,  1.31695789692482)
+
+&acos
+( 2, 3):(  1.00014354247380, -1.98338702991654)
+(-2, 3):(  2.14144911111600, -1.98338702991654)
+(-2,-3):(  2.14144911111600,  1.98338702991654)
+( 2,-3):(  1.00014354247380,  1.98338702991654)
+
+&atan
+(-2.0,0):(  -1.10714871779409,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -0.46364760900081,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46364760900081,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   1.10714871779409,  0               )
+
+&atan
+( 2, 3):(  1.40992104959658,  0.22907268296854)
+(-2, 3):( -1.40992104959658,  0.22907268296854)
+(-2,-3):( -1.40992104959658, -0.22907268296854)
+( 2,-3):(  1.40992104959658, -0.22907268296854)
+
+&asec
+(-2.0,0):(   2.09439510239320,  0               )
+(-1.0,0):(   3.14159265358979,  0               )
+(-0.5,0):(   3.14159265358979, -1.31695789692482)
+( 0.5,0):(   0               ,  1.31695789692482)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.04719755119660,  0               )
+
+&asec
+( 2, 3):(  1.42041072246703,  0.23133469857397)
+(-2, 3):(  1.72118193112276,  0.23133469857397)
+(-2,-3):(  1.72118193112276, -0.23133469857397)
+( 2,-3):(  1.42041072246703, -0.23133469857397)
+
+&acsc
+(-2.0,0):(  -0.52359877559830,  0               )
+(-1.0,0):(  -1.57079632679490,  0               )
+(-0.5,0):(  -1.57079632679490,  1.31695789692482)
+( 0.5,0):(   1.57079632679490, -1.31695789692482)
+( 1.0,0):(   1.57079632679490,  0               )
+( 2.0,0):(   0.52359877559830,  0               )
+
+&acsc
+( 2, 3):(  0.15038560432786, -0.23133469857397)
+(-2, 3):( -0.15038560432786, -0.23133469857397)
+(-2,-3):( -0.15038560432786,  0.23133469857397)
+( 2,-3):(  0.15038560432786,  0.23133469857397)
+
+&acot
+(-2.0,0):(  -0.46364760900081,  0               )
+(-1.0,0):(  -0.78539816339745,  0               )
+(-0.5,0):(  -1.10714871779409,  0               )
+( 0.5,0):(   1.10714871779409,  0               )
+( 1.0,0):(   0.78539816339745,  0               )
+( 2.0,0):(   0.46364760900081,  0               )
+
+&acot
+( 2, 3):(  0.16087527719832, -0.22907268296854)
+(-2, 3):( -0.16087527719832, -0.22907268296854)
+(-2,-3):( -0.16087527719832,  0.22907268296854)
+( 2,-3):(  0.16087527719832,  0.22907268296854)
+
+&sinh
+(-2.0,0):(  -3.62686040784702,  0               )
+(-1.0,0):(  -1.17520119364380,  0               )
+(-0.5,0):(  -0.52109530549375,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.52109530549375,  0               )
+( 1.0,0):(   1.17520119364380,  0               )
+( 2.0,0):(   3.62686040784702,  0               )
+
+&sinh
+( 2, 3):( -3.59056458998578,  0.53092108624852)
+(-2, 3):(  3.59056458998578,  0.53092108624852)
+(-2,-3):(  3.59056458998578, -0.53092108624852)
+( 2,-3):( -3.59056458998578, -0.53092108624852)
+
+&cosh
+(-2.0,0):(   3.76219569108363,  0               )
+(-1.0,0):(   1.54308063481524,  0               )
+(-0.5,0):(   1.12762596520638,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   1.12762596520638,  0               )
+( 1.0,0):(   1.54308063481524,  0               )
+( 2.0,0):(   3.76219569108363,  0               )
+
+&cosh
+( 2, 3):( -3.72454550491532,  0.51182256998738)
+(-2, 3):( -3.72454550491532, -0.51182256998738)
+(-2,-3):( -3.72454550491532,  0.51182256998738)
+( 2,-3):( -3.72454550491532, -0.51182256998738)
+
+&tanh
+(-2.0,0):(  -0.96402758007582,  0               )
+(-1.0,0):(  -0.76159415595576,  0               )
+(-0.5,0):(  -0.46211715726001,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.46211715726001,  0               )
+( 1.0,0):(   0.76159415595576,  0               )
+( 2.0,0):(   0.96402758007582,  0               )
+
+&tanh
+( 2, 3):(  0.96538587902213, -0.00988437503832)
+(-2, 3):( -0.96538587902213, -0.00988437503832)
+(-2,-3):( -0.96538587902213,  0.00988437503832)
+( 2,-3):(  0.96538587902213,  0.00988437503832)
+
+&sech
+(-2.0,0):(   0.26580222883408,  0               )
+(-1.0,0):(   0.64805427366389,  0               )
+(-0.5,0):(   0.88681888397007,  0               )
+( 0.0,0):(   1               ,  0               )
+( 0.5,0):(   0.88681888397007,  0               )
+( 1.0,0):(   0.64805427366389,  0               )
+( 2.0,0):(   0.26580222883408,  0               )
+
+&sech
+( 2, 3):( -0.26351297515839, -0.03621163655877)
+(-2, 3):( -0.26351297515839,  0.03621163655877)
+(-2,-3):( -0.26351297515839, -0.03621163655877)
+( 2,-3):( -0.26351297515839,  0.03621163655877)
+
+&csch
+(-2.0,0):(  -0.27572056477178,  0               )
+(-1.0,0):(  -0.85091812823932,  0               )
+(-0.5,0):(  -1.91903475133494,  0               )
+( 0.5,0):(   1.91903475133494,  0               )
+( 1.0,0):(   0.85091812823932,  0               )
+( 2.0,0):(   0.27572056477178,  0               )
+
+&csch
+( 2, 3):( -0.27254866146294, -0.04030057885689)
+(-2, 3):(  0.27254866146294, -0.04030057885689)
+(-2,-3):(  0.27254866146294,  0.04030057885689)
+( 2,-3):( -0.27254866146294,  0.04030057885689)
+
+&coth
+(-2.0,0):(  -1.03731472072755,  0               )
+(-1.0,0):(  -1.31303528549933,  0               )
+(-0.5,0):(  -2.16395341373865,  0               )
+( 0.5,0):(   2.16395341373865,  0               )
+( 1.0,0):(   1.31303528549933,  0               )
+( 2.0,0):(   1.03731472072755,  0               )
+
+&coth
+( 2, 3):(  1.03574663776500,  0.01060478347034)
+(-2, 3):( -1.03574663776500,  0.01060478347034)
+(-2,-3):( -1.03574663776500, -0.01060478347034)
+( 2,-3):(  1.03574663776500, -0.01060478347034)
+
+&asinh
+(-2.0,0):(  -1.44363547517881,  0               )
+(-1.0,0):(  -0.88137358701954,  0               )
+(-0.5,0):(  -0.48121182505960,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.48121182505960,  0               )
+( 1.0,0):(   0.88137358701954,  0               )
+( 2.0,0):(   1.44363547517881,  0               )
+
+&asinh
+( 2, 3):(  1.96863792579310,  0.96465850440760)
+(-2, 3):( -1.96863792579310,  0.96465850440761)
+(-2,-3):( -1.96863792579310, -0.96465850440761)
+( 2,-3):(  1.96863792579310, -0.96465850440760)
+
+&acosh
+(-2.0,0):(   1.31695789692482,  3.14159265358979)
+(-1.0,0):(   0,                 3.14159265358979)
+(-0.5,0):(   0,                 2.09439510239320)
+( 0.0,0):(   0,                 1.57079632679490)
+( 0.5,0):(   0,                 1.04719755119660)
+( 1.0,0):(   0               ,  0               )
+( 2.0,0):(   1.31695789692482,  0               )
+
+&acosh
+( 2, 3):(  1.98338702991654,  1.00014354247380)
+(-2, 3):(  1.98338702991653,  2.14144911111600)
+(-2,-3):(  1.98338702991653, -2.14144911111600)
+( 2,-3):(  1.98338702991654, -1.00014354247380)
+
+&atanh
+(-2.0,0):(  -0.54930614433405,  1.57079632679490)
+(-0.5,0):(  -0.54930614433405,  0               )
+( 0.0,0):(   0               ,  0               )
+( 0.5,0):(   0.54930614433405,  0               )
+( 2.0,0):(   0.54930614433405,  1.57079632679490)
+
+&atanh
+( 2, 3):(  0.14694666622553,  1.33897252229449)
+(-2, 3):( -0.14694666622553,  1.33897252229449)
+(-2,-3):( -0.14694666622553, -1.33897252229449)
+( 2,-3):(  0.14694666622553, -1.33897252229449)
+
+&asech
+(-2.0,0):(   0               , 2.09439510239320)
+(-1.0,0):(   0               , 3.14159265358979)
+(-0.5,0):(   1.31695789692482, 3.14159265358979)
+( 0.5,0):(   1.31695789692482, 0               )
+( 1.0,0):(   0               , 0               )
+( 2.0,0):(   0               , 1.04719755119660)
+
+&asech
+( 2, 3):(  0.23133469857397, -1.42041072246703)
+(-2, 3):(  0.23133469857397, -1.72118193112276)
+(-2,-3):(  0.23133469857397,  1.72118193112276)
+( 2,-3):(  0.23133469857397,  1.42041072246703)
+
+&acsch
+(-2.0,0):(  -0.48121182505960, 0               )
+(-1.0,0):(  -0.88137358701954, 0               )
+(-0.5,0):(  -1.44363547517881, 0               )
+( 0.5,0):(   1.44363547517881, 0               )
+( 1.0,0):(   0.88137358701954, 0               )
+( 2.0,0):(   0.48121182505960, 0               )
+
+&acsch
+( 2, 3):(  0.15735549884499, -0.22996290237721)
+(-2, 3):( -0.15735549884499, -0.22996290237721)
+(-2,-3):( -0.15735549884499,  0.22996290237721)
+( 2,-3):(  0.15735549884499,  0.22996290237721)
+
+&acoth
+(-2.0,0):(  -0.54930614433405, 0               )
+(-0.5,0):(  -0.54930614433405, 1.57079632679490)
+( 0.5,0):(   0.54930614433405, 1.57079632679490)
+( 2.0,0):(   0.54930614433405, 0               )
+
+&acoth
+( 2, 3):(  0.14694666622553, -0.23182380450040)
+(-2, 3):( -0.14694666622553, -0.23182380450040)
+(-2,-3):( -0.14694666622553,  0.23182380450040)
+( 2,-3):(  0.14694666622553,  0.23182380450040)
+
+# eof
diff --git a/lib/Math/Trig.t b/lib/Math/Trig.t
new file mode 100755
index 0000000000..4246a47c40
--- /dev/null
+++ b/lib/Math/Trig.t
@@ -0,0 +1,200 @@
+#!./perl 
+
+#
+# Regression tests for the Math::Trig package
+#
+# The tests are quite modest as the Math::Complex tests exercise
+# these quite vigorously.
+# 
+# -- Jarkko Hietaniemi, April 1997
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::Trig;
+
+use strict;
+
+use vars qw($x $y $z);
+
+my $eps = 1e-11;
+
+if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
+    $eps = 1e-10;
+}
+
+sub near ($$;$) {
+    my $e = defined $_[2] ? $_[2] : $eps;
+    $_[1] ? (abs($_[0]/$_[1] - 1) < $e) : abs($_[0]) < $e;
+}
+
+print "1..26\n";
+
+$x = 0.9;
+print 'not ' unless (near(tan($x), sin($x) / cos($x)));
+print "ok 1\n";
+
+print 'not ' unless (near(sinh(2), 3.62686040784702));
+print "ok 2\n";
+
+print 'not ' unless (near(acsch(0.1), 2.99822295029797));
+print "ok 3\n";
+
+$x = asin(2);
+print 'not ' unless (ref $x eq 'Math::Complex');
+print "ok 4\n";
+
+# avoid using Math::Complex here
+$x =~ /^([^-]+)(-[^i]+)i$/;
+($y, $z) = ($1, $2);
+print 'not ' unless (near($y,  1.5707963267949) and
+		     near($z, -1.31695789692482));
+print "ok 5\n";
+
+print 'not ' unless (near(deg2rad(90), pi/2));
+print "ok 6\n";
+
+print 'not ' unless (near(rad2deg(pi), 180));
+print "ok 7\n";
+
+use Math::Trig ':radial';
+
+{
+    my ($r,$t,$z) = cartesian_to_cylindrical(1,1,1);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+	                (near($t, deg2rad(45))) and
+			(near($z, 1));
+    print "ok 8\n";
+
+    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+    print 'not ' unless (near($x, 1)) and
+	                (near($y, 1)) and
+			(near($z, 1));
+    print "ok 9\n";
+
+    ($r,$t,$z) = cartesian_to_cylindrical(1,1,0);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+	                (near($t, deg2rad(45))) and
+			(near($z, 0));
+    print "ok 10\n";
+
+    ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
+
+    print 'not ' unless (near($x, 1)) and
+	                (near($y, 1)) and
+			(near($z, 0));
+    print "ok 11\n";
+}
+
+{
+    my ($r,$t,$f) = cartesian_to_spherical(1,1,1);
+
+    print 'not ' unless (near($r, sqrt(3)))     and
+	                (near($t, deg2rad(45))) and
+			(near($f, atan2(sqrt(2), 1)));
+    print "ok 12\n";
+
+    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+    print 'not ' unless (near($x, 1)) and
+	                (near($y, 1)) and
+			(near($z, 1));
+    print "ok 13\n";
+
+    ($r,$t,$f) = cartesian_to_spherical(1,1,0);
+
+    print 'not ' unless (near($r, sqrt(2)))     and
+	                (near($t, deg2rad(45))) and
+			(near($f, deg2rad(90)));
+    print "ok 14\n";
+
+    ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
+
+    print 'not ' unless (near($x, 1)) and
+	                (near($y, 1)) and
+			(near($z, 0));
+    print "ok 15\n";
+}
+
+{
+    my ($r,$t,$z) = cylindrical_to_spherical(spherical_to_cylindrical(1,1,1));
+
+    print 'not ' unless (near($r, 1)) and
+	                (near($t, 1)) and
+			(near($z, 1));
+    print "ok 16\n";
+
+    ($r,$t,$z) = spherical_to_cylindrical(cylindrical_to_spherical(1,1,1));
+
+    print 'not ' unless (near($r, 1)) and
+	                (near($t, 1)) and
+			(near($z, 1));
+    print "ok 17\n";
+}
+
+{
+    use Math::Trig 'great_circle_distance';
+
+    print 'not '
+	unless (near(great_circle_distance(0, 0, 0, pi/2), pi/2));
+    print "ok 18\n";
+
+    print 'not '
+	unless (near(great_circle_distance(0, 0, pi, pi), pi));
+    print "ok 19\n";
+
+    # London to Tokyo.
+    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+    my $km = great_circle_distance(@L, @T, 6378);
+
+    print 'not ' unless (near($km, 9605.26637021388));
+    print "ok 20\n";
+}
+
+{
+    my $R2D = 57.295779513082320876798154814169;
+
+    sub frac { $_[0] - int($_[0]) }
+
+    my $lotta_radians = deg2rad(1E+20, 1);
+    print "not " unless near($lotta_radians,  1E+20/$R2D);
+    print "ok 21\n";
+
+    my $negat_degrees = rad2deg(-1E20, 1);
+    print "not " unless near($negat_degrees, -1E+20*$R2D);
+    print "ok 22\n";
+
+    my $posit_degrees = rad2deg(-10000, 1);
+    print "not " unless near($posit_degrees, -10000*$R2D);
+    print "ok 23\n";
+}
+
+{
+    use Math::Trig 'great_circle_direction';
+
+    print 'not '
+	unless (near(great_circle_direction(0, 0, 0, pi/2), pi));
+    print "ok 24\n";
+
+    print 'not '
+	unless (near(great_circle_direction(0, 0, pi, pi), -pi()/2));
+    print "ok 25\n";
+
+    # London to Tokyo.
+    my @L = (deg2rad(-0.5), deg2rad(90 - 51.3));
+    my @T = (deg2rad(139.8),deg2rad(90 - 35.7));
+
+    my $rad = great_circle_direction(@L, @T);
+
+    print 'not ' unless (near($rad, -0.546644569997376));
+    print "ok 26\n";
+}
+
+# eof
diff --git a/lib/NEXT/test.pl b/lib/NEXT/test.pl
new file mode 100644
index 0000000000..6328fd170c
--- /dev/null
+++ b/lib/NEXT/test.pl
@@ -0,0 +1,99 @@
+#! /usr/local/bin/perl -w
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN { print "1..20\n"; }
+
+use NEXT;
+
+print "ok 1\n";
+
+package A;
+sub A::method   { return ( 3, $_[0]->NEXT::method() ) }
+sub A::DESTROY  { $_[0]->NEXT::DESTROY() }
+
+package B;
+use base qw( A );
+sub B::AUTOLOAD { return ( 9, $_[0]->NEXT::AUTOLOAD() ) }
+sub B::DESTROY  { $_[0]->NEXT::DESTROY() }
+
+package C;
+sub C::DESTROY  { print "ok 18\n"; $_[0]->NEXT::DESTROY() }
+
+package D;
+@D::ISA = qw( B C E );
+sub D::method   { return ( 2, $_[0]->NEXT::method() ) }
+sub D::AUTOLOAD { return ( 8, $_[0]->NEXT::AUTOLOAD() ) }
+sub D::DESTROY  { print "ok 17\n"; $_[0]->NEXT::DESTROY() }
+sub D::oops     { $_[0]->NEXT::method() }
+
+package E;
+@E::ISA = qw( F G );
+sub E::method   { return ( 4,  $_[0]->NEXT::method(), $_[0]->NEXT::method() ) }
+sub E::AUTOLOAD { return ( 10, $_[0]->NEXT::AUTOLOAD() ) }
+sub E::DESTROY  { print "ok 19\n"; $_[0]->NEXT::DESTROY() }
+
+package F;
+sub F::method   { return ( 5  ) }
+sub F::AUTOLOAD { return ( 11 ) }
+sub F::DESTROY  { print "ok 20\n" }
+
+package G;
+sub G::method   { return ( 6 ) }
+sub G::AUTOLOAD { print "not "; return }
+sub G::DESTROY  { print "not ok 21"; return }
+
+package main;
+
+my $obj = bless {}, "D";
+
+my @vals;
+
+# TEST NORMAL REDISPATCH (ok 2..6)
+@vals = $obj->method();
+print map "ok $_\n", @vals;
+
+# RETEST NORMAL REDISPATCH SHOULD BE THE SAME (ok 7)
+@vals = $obj->method();
+print "not " unless join("", @vals) == "23456";
+print "ok 7\n";
+
+# TEST AUTOLOAD REDISPATCH (ok 8..11)
+@vals = $obj->missing_method();
+print map "ok $_\n", @vals;
+
+# NAMED METHOD CAN'T REDISPATCH TO NAMED METHOD OF DIFFERENT NAME (ok 12)
+eval { $obj->oops() } && print "not ";
+print "ok 12\n";
+
+# AUTOLOAD'ED METHOD CAN'T REDISPATCH TO NAMED METHOD (ok 13)
+eval q{
+	package C;
+	sub AUTOLOAD { $_[0]->NEXT::method() };
+};
+eval { $obj->missing_method(); } && print "not ";
+print "ok 13\n";
+
+# NAMED METHOD CAN'T REDISPATCH TO AUTOLOAD'ED METHOD (ok 14)
+eval q{ 
+	package C;
+	sub method { $_[0]->NEXT::AUTOLOAD() };
+};
+eval { $obj->method(); } && print "not ";
+print "ok 14\n";
+
+# BASE CLASS METHODS ONLY REDISPATCHED WITHIN HIERARCHY (ok 15..16)
+my $ob2 = bless {}, "B";
+@val = $ob2->method();         
+print "not " unless @val==1 && $val[0]==3;
+print "ok 15\n";
+
+@val = $ob2->missing_method(); 
+print "not " unless @val==1 && $val[0]==9;
+print "ok 16\n";
+
+# CAN REDISPATCH DESTRUCTORS (ok 17..20)
diff --git a/lib/Net/hostent.t b/lib/Net/hostent.t
new file mode 100644
index 0000000000..c3a12194ec
--- /dev/null
+++ b/lib/Net/hostent.t
@@ -0,0 +1,72 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSocket\b/ && 
+        !(($^O eq 'VMS') && $Config{d_socket})) {
+	print "1..0 # Test uses Socket, Socket not built\n";
+	exit 0;
+    }
+}
+
+BEGIN { $| = 1; print "1..7\n"; }
+
+END {print "not ok 1\n" unless $loaded;}
+
+use Net::hostent;
+
+$loaded = 1;
+print "ok 1\n";
+
+# test basic resolution of localhost <-> 127.0.0.1
+use Socket;
+
+my $h = gethost('localhost');
+print +(defined $h ? '' : 'not ') . "ok 2\n";
+my $i = gethostbyaddr(inet_aton("127.0.0.1"));
+print +(!defined $i ? 'not ' : '') . "ok 3\n";
+
+print "not " if inet_ntoa($h->addr) ne "127.0.0.1";
+print "ok 4\n";
+
+print "not " if inet_ntoa($i->addr) ne "127.0.0.1";
+print "ok 5\n";
+
+# need to skip the name comparisons on Win32 because windows will
+# return the name of the machine instead of "localhost" when resolving
+# 127.0.0.1 or even "localhost"
+
+# VMS returns "LOCALHOST" under tcp/ip services V4.1 ECO 2, possibly others
+# OS/390 returns localhost.YADDA.YADDA
+
+if ($^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'cygwin') {
+  print "ok $_ # skipped on win32\n" for (6,7);
+} else {
+  my $in_alias;
+  unless ($h->name =~ /^localhost(?:\..+)?$/i) {
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       $in_alias = 1;
+       last;
+      }
+    }
+    print "not " unless $in_alias;
+  } # Else we found it as the hostname
+  print "ok 6 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
+
+  if ($in_alias) {
+    # If we found it in the aliases before, expect to find it there again.
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       undef $in_alias; # This time, clear the flag if we see "localhost"
+       last;
+      }
+    }
+    print "not " if $in_alias;
+  } else {
+    print "not " unless $i->name =~ /^localhost(?:\..+)?$/i;
+  }
+  print "ok 7 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
+}
diff --git a/lib/Net/netent.t b/lib/Net/netent.t
new file mode 100644
index 0000000000..e73122ccc4
--- /dev/null
+++ b/lib/Net/netent.t
@@ -0,0 +1,36 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasne;
+    eval { my @n = getnetbyname "loopback" };
+    $hasne = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasne) { print "1..0 # Skip: no getnetbyname\n"; exit 0 }
+    use Config;
+    $hasne = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($hasne) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @netent = getnetbyname "loopback"; # This is the function getnetbyname.
+    unless (@netent) { print "1..0 # Skip: no loopback net\n"; exit 0 }
+}
+
+print "1..2\n";
+
+use Net::netent;
+
+print "ok 1\n";
+
+my $netent = getnetbyname "loopback"; # This is the OO getnetbyname.
+
+print "not " unless $netent->name   eq $netent[0];
+print "ok 2\n";
+
+# Testing pretty much anything else is unportable;
+# e.g. the canonical name of the "loopback" net may be "loop".
+
diff --git a/lib/Net/protoent.t b/lib/Net/protoent.t
new file mode 100644
index 0000000000..6c5a1547b3
--- /dev/null
+++ b/lib/Net/protoent.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haspe;
+    eval { my @n = getprotobyname "tcp" };
+    $haspe = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haspe) { print "1..0 # Skip: no getprotobyname\n"; exit 0 }
+    use Config;
+    $haspe = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($haspe) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @protoent = getprotobyname "tcp"; # This is the function getprotobyname.
+    unless (@protoent) { print "1..0 # Skip: no tcp protocol\n"; exit 0 }
+}
+
+print "1..3\n";
+
+use Net::protoent;
+
+print "ok 1\n";
+
+my $protoent = getprotobyname "tcp"; # This is the OO getprotobyname.
+
+print "not " unless $protoent->name   eq $protoent[0];
+print "ok 2\n";
+
+print "not " unless $protoent->proto  == $protoent[2];
+print "ok 3\n";
+
+# Testing pretty much anything else is unportable.
+
diff --git a/lib/Net/servent.t b/lib/Net/servent.t
new file mode 100644
index 0000000000..ef4a04dee8
--- /dev/null
+++ b/lib/Net/servent.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasse;
+    eval { my @n = getservbyname "echo", "tcp" };
+    $hasse = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasse) { print "1..0 # Skip: no getservbyname\n"; exit 0 }
+    use Config;
+    $hasse = 0 unless $Config{'i_netdb'} eq 'define';
+    unless ($hasse) { print "1..0 # Skip: no netdb.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @servent = getservbyname "echo", "tcp"; # This is the function getservbyname.
+    unless (@servent) { print "1..0 # Skip: no echo service\n"; exit 0 }
+}
+
+print "1..3\n";
+
+use Net::servent;
+
+print "ok 1\n";
+
+my $servent = getservbyname "echo", "tcp"; # This is the OO getservbyname.
+
+print "not " unless $servent->name   eq $servent[0];
+print "ok 2\n";
+
+print "not " unless $servent->port  == $servent[2];
+print "ok 3\n";
+
+# Testing pretty much anything else is unportable.
+
diff --git a/lib/Search/Dict.t b/lib/Search/Dict.t
new file mode 100755
index 0000000000..c36fdb8c34
--- /dev/null
+++ b/lib/Search/Dict.t
@@ -0,0 +1,87 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+$DICT = <<EOT;
+Aarhus
+Aaron
+Ababa
+aback
+abaft
+abandon
+abandoned
+abandoning
+abandonment
+abandons
+abase
+abased
+abasement
+abasements
+abases
+abash
+abashed
+abashes
+abashing
+abasing
+abate
+abated
+abatement
+abatements
+abater
+abates
+abating
+Abba
+EOT
+
+use Search::Dict;
+
+open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
+binmode DICT;			# To make length expected one.
+print DICT $DICT;
+
+my $pos = look *DICT, "Ababa";
+chomp($word = <DICT>);
+print "not " if $pos < 0 || $word ne "Ababa";
+print "ok 1\n";
+
+if (ord('a') > ord('A') ) {  # ASCII
+
+    $pos = look *DICT, "foo";
+    chomp($word = <DICT>);
+
+    print "not " if $pos != length($DICT);  # will search to end of file
+    print "ok 2\n";
+
+    my $pos = look *DICT, "abash";
+    chomp($word = <DICT>);
+    print "not " if $pos < 0 || $word ne "abash";
+    print "ok 3\n";
+
+}
+else { # EBCDIC systems e.g. os390
+
+    $pos = look *DICT, "FOO";
+    chomp($word = <DICT>);
+
+    print "not " if $pos != length($DICT);  # will search to end of file
+    print "ok 2\n";
+
+    my $pos = look *DICT, "Abba";
+    chomp($word = <DICT>);
+    print "not " if $pos < 0 || $word ne "Abba";
+    print "ok 3\n";
+}
+
+$pos = look *DICT, "aarhus", 1, 1;
+chomp($word = <DICT>);
+
+print "not " if $pos < 0 || $word ne "Aarhus";
+print "ok 4\n";
+
+close DICT or die "cannot close";
+unlink "dict-$$";
diff --git a/lib/SelectSaver.t b/lib/SelectSaver.t
new file mode 100755
index 0000000000..3b58d709ab
--- /dev/null
+++ b/lib/SelectSaver.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+use SelectSaver;
+
+open(FOO, ">foo-$$") || die;
+
+print "ok 1\n";
+{
+    my $saver = new SelectSaver(FOO);
+    print "foo\n";
+}
+
+# Get data written to file
+open(FOO, "foo-$$") || die;
+chomp($foo = <FOO>);
+close FOO;
+unlink "foo-$$";
+
+print "ok 2\n" if $foo eq "foo";
+
+print "ok 3\n";
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100755
index 0000000000..6987f6592b
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,208 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    $dir = "self-$$";
+    $sep = "/";
+
+    if ($^O eq 'MacOS') {
+	$dir = ":" . $dir;
+	$sep = ":";
+    }
+
+    @INC = $dir;
+    push @INC, '../lib';
+
+    print "1..19\n";
+
+    # First we must set up some selfloader files
+    mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+
+    open(FOO, ">$dir${sep}Foo.pm") or die;
+    print FOO <<'EOT';
+package Foo;
+use SelfLoader;
+
+sub new { bless {}, shift }
+sub foo;
+sub bar;
+sub bazmarkhianish;
+sub a;
+sub never;    # declared but definition should never be read
+1;
+__DATA__
+
+sub foo { shift; shift || "foo" };
+
+sub bar { shift; shift || "bar" }
+
+sub bazmarkhianish { shift; shift || "baz" }
+
+package sheep;
+sub bleat { shift; shift || "baa" }
+
+__END__
+sub never { die "D'oh" }
+EOT
+
+    close(FOO);
+
+    open(BAR, ">$dir${sep}Bar.pm") or die;
+    print BAR <<'EOT';
+package Bar;
+use SelfLoader;
+
+@ISA = 'Baz';
+
+sub new { bless {}, shift }
+sub a;
+
+1;
+__DATA__
+
+sub a { 'a Bar'; }
+sub b { 'b Bar' }
+
+__END__ DATA
+sub never { die "D'oh" }
+EOT
+
+    close(BAR);
+};
+
+
+package Baz;
+
+sub a { 'a Baz' }
+sub b { 'b Baz' }
+sub c { 'c Baz' }
+
+
+package main;
+use Foo;
+use Bar;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo';  # selfloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo';  # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+    $foo->will_fail;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 3\n";
+} else {
+    print "not ok 3 $@\n";
+}
+
+# Used to be trouble with this
+eval {
+    my $foo = new Foo;
+    die "oops";
+};
+if ($@ =~ /oops/) {
+    print "ok 4\n";
+} else {
+    print "not ok 4 $@\n";
+}
+
+# Pass regular expression variable to autoloaded function.  This used
+# to go wrong in AutoLoader because it used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# Check nested packages inside __DATA__
+print "not " unless sheep::bleat()  eq 'baa';
+print "ok 10\n";
+
+# Now check inheritance:
+
+$bar = new Bar;
+
+# Before anything is SelfLoaded there is no declaration of Foo::b so we should
+# get Baz::b
+print "not " unless $bar->b() eq 'b Baz';
+print "ok 11\n";
+
+# There is no Bar::c so we should get Baz::c
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 12\n";
+
+# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
+# effect
+print "not " unless $bar->a() eq 'a Bar';
+print "ok 13\n";
+
+print "not " unless $bar->b() eq 'b Bar';
+print "ok 14\n";
+
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 15\n";
+
+
+
+# Check that __END__ is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $foo->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 16\n";
+} else {
+    print "not ok 16 $@\n";
+}
+
+# Try to read from the data file handle
+my $foodata = <Foo::DATA>;
+close Foo::DATA;
+if (defined $foodata) {
+    print "not ok 17 # $foodata\n";
+} else {
+    print "ok 17\n";
+}
+
+# Check that __END__ DATA is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $bar->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 18\n";
+} else {
+    print "not ok 18 $@\n";
+}
+
+# Try to read from the data file handle
+my $bardata = <Bar::DATA>;
+close Bar::DATA;
+if ($bardata ne "sub never { die \"D'oh\" }\n") {
+    print "not ok 19 # $bardata\n";
+} else {
+    print "ok 19\n";
+}
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir${sep}Foo.pm", "$dir${sep}Bar.pm";
+rmdir "$dir";
+}
diff --git a/lib/Switch/test.pl b/lib/Switch/test.pl
new file mode 100644
index 0000000000..d1a8af191f
--- /dev/null
+++ b/lib/Switch/test.pl
@@ -0,0 +1,277 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Carp;
+use Switch qw(__ fallthrough);
+
+my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
+END{print"1..$C\n$M"}
+
+# NON-case THINGS;
+
+$case->{case} = { case => "case" };
+
+*case = \&case;
+
+# PREMATURE case
+
+eval { case 1 { ok(0) }; ok(0) } || ok(1);
+
+# H.O. FUNCS
+
+switch (__ > 2) {
+
+	case 1	{ ok(0) } else { ok(1) }
+	case 2	{ ok(0) } else { ok(1) }
+	case 3	{ ok(1) } else { ok(0) }
+}
+
+switch (3) {
+
+	eval { case __ <= 1 || __ > 2	{ ok(0) } } || ok(1);
+	case __ <= 2 		{ ok(0) };
+	case __ <= 3		{ ok(1) };
+}
+
+# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
+
+# 1. NUMERIC SWITCH
+
+for (1..3)
+{
+	switch ($_) {
+		# SELF
+		case ($_) { ok(1) } else { ok(0) }
+
+		# NUMERIC
+		case (1) { ok ($_==1) } else { ok($_!=1) }
+		case  1  { ok ($_==1) } else { ok($_!=1) }
+		case (3) { ok ($_==3) } else { ok($_!=3) }
+		case (4) { ok (0) } else { ok(1) }
+		case (2) { ok ($_==2) } else { ok($_!=2) }
+
+		# STRING
+		case ('a') { ok (0) } else { ok(1) }
+		case  'a'  { ok (0) } else { ok(1) }
+		case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
+		case ('3.0') { ok (0) } else { ok(1) }
+
+		# ARRAY
+		case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
+		case  [10,5,1]  { ok ($_==1) } else { ok($_!=1) }
+		case (['a','b']) { ok (0) } else { ok(1) }
+		case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
+		case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
+		case ([]) { ok (0) } else { ok(1) }
+
+		# HASH
+		case ({}) { ok (0) } else { ok (1) }
+		case {} { ok (0) } else { ok (1) }
+		case {1,1} { ok ($_==1) } else { ok($_!=1) }
+		case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
+
+		# SUB/BLOCK
+		case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
+		case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
+		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+		case {1} { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
+	}
+}
+
+
+# 2. STRING SWITCH
+
+for ('a'..'c','1')
+{
+	switch ($_) {
+		# SELF
+		case ($_) { ok(1) } else { ok(0) }
+
+		# NUMERIC
+		case (1)  { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
+		case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
+
+		# STRING
+		case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
+		case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
+		case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
+		case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
+		case ('d') { ok (0) } else { ok (1) }
+
+		# ARRAY
+		case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
+			else { ok ($_ ne 'a' && $_ ne '1') }
+		case (['z','2']) { ok (0) } else { ok(1) }
+		case ([]) { ok (0) } else { ok(1) }
+
+		# HASH
+		case ({}) { ok (0) } else { ok (1) }
+		case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
+			else { ok ($_ ne 'a' && $_ ne '1') }
+
+		# SUB/BLOCK
+		case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
+			else { ok($_ ne 'a') }
+		case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
+		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+		case {1} { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
+	}
+}
+
+
+# 3. ARRAY SWITCH
+
+my $iteration = 0;
+for ([],[1,'a'],[2,'b'])
+{
+	switch ($_) {
+	$iteration++;
+		# SELF
+		case ($_) { ok(1) }
+
+		# NUMERIC
+		case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
+		case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
+
+		# STRING
+		case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
+		case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
+		case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
+
+		# ARRAY
+		case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
+		case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
+		case ([]) { ok (0) } else { ok(1) }
+		case ([7..100]) { ok (0) } else { ok(1) }
+
+		# HASH
+		case ({}) { ok (0) } else { ok (1) }
+		case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+
+		# SUB/BLOCK
+		case {scalar grep /a/, @_} { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+		case {1} { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
+	}
+}
+
+
+# 4. HASH SWITCH
+
+$iteration = 0;
+for ({},{a=>1,b=>0})
+{
+	switch ($_) {
+	$iteration++;
+
+		# SELF
+		case ($_) { ok(1) } else { ok(0) }
+
+		# NUMERIC
+		case (1) { ok (0) } else { ok (1) }
+		case (1.0) { ok (0) } else { ok (1) }
+
+		# STRING
+		case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
+		case ('b') { ok (0) } else { ok (1) }
+		case ('c') { ok (0) } else { ok (1) }
+
+		# ARRAY
+		case (['a',2]) { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case (['b','a']) { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case (['b','c']) { ok (0) } else { ok (1) }
+		case ([]) { ok (0) } else { ok(1) }
+		case ([7..100]) { ok (0) } else { ok(1) }
+
+		# HASH
+		case ({}) { ok (0) } else { ok (1) }
+		case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
+
+		# SUB/BLOCK
+		case {$_[0]{a}} { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case (sub {$_[0]{a}}) { ok ($iteration==2) }
+			else { ok ($iteration!=2) }
+		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+		case {1} { ok (1) } else { ok (0) }	# ; -> SUB, NOT HASH
+	}
+}
+
+
+# 5. CODE SWITCH
+
+$iteration = 0;
+for ( sub {1},
+      sub { return 0 unless @_;
+	    my ($data) = @_;
+	    my $type = ref $data;
+	    return $type eq 'HASH'   && $data->{a}
+		|| $type eq 'Regexp' && 'a' =~ /$data/
+		|| $type eq ""       && $data eq '1';
+	  },
+      sub {0} )
+{
+	switch ($_) {
+	$iteration++;
+		# SELF
+		case ($_) { ok(1) } else { ok(0) }
+
+		# NUMERIC
+		case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
+		case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
+		case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
+
+		# STRING
+		case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
+		case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
+		case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
+		case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
+
+		# ARRAY
+		case ([1, 'a']) { ok ($iteration<=2) }
+			else { ok ($iteration>2) }
+		case (['b','a']) { ok ($iteration==1) }
+			else { ok ($iteration!=1) }
+		case (['b','c']) { ok ($iteration==1) }
+			else { ok ($iteration!=1) }
+		case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
+		case ([7..100]) { ok ($iteration==1) }
+			else { ok($iteration!=1) }
+
+		# HASH
+		case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
+		case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
+			else { ok ($iteration>2) }
+
+		# SUB/BLOCK
+		case {$_[0]->{a}} { ok (0) } else { ok (1) }
+		case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
+		case {0} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+		case {1} { ok (0) } else { ok (1) }	# ; -> SUB, NOT HASH
+	}
+}
+
+
+# NESTED SWITCHES
+
+for my $count (1..3)
+{
+	switch ([9,"a",11]) {
+		case (qr/\d/) {
+				switch ($count) {
+					case (1)     { ok($count==1) }
+						else { ok($count!=1) }
+					case ([5,6]) { ok(0) } else { ok(1) }
+				}
+			    }
+		ok(1) case (11);
+	}
+}
diff --git a/lib/Symbol.t b/lib/Symbol.t
new file mode 100755
index 0000000000..03449a3ed7
--- /dev/null
+++ b/lib/Symbol.t
@@ -0,0 +1,52 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..8\n";
+
+BEGIN { $_ = 'foo'; }  # because Symbol used to clobber $_
+
+use Symbol;
+
+# First check $_ clobbering
+print "not " if $_ ne 'foo';
+print "ok 1\n";
+
+
+# First test gensym()
+$sym1 = gensym;
+print "not " if ref($sym1) ne 'GLOB';
+print "ok 2\n";
+
+$sym2 = gensym;
+
+print "not " if $sym1 eq $sym2;
+print "ok 3\n";
+
+ungensym $sym1;
+
+$sym1 = $sym2 = undef;
+
+
+# Test qualify()
+package foo;
+
+use Symbol qw(qualify);  # must import into this package too
+
+qualify("x") eq "foo::x"          or print "not ";
+print "ok 4\n";
+
+qualify("x", "FOO") eq "FOO::x"   or print "not ";
+print "ok 5\n";
+
+qualify("BAR::x") eq "BAR::x"     or print "not ";
+print "ok 6\n";
+
+qualify("STDOUT") eq "main::STDOUT" or print "not ";
+print "ok 7\n";
+
+qualify("ARGV", "FOO") eq "main::ARGV" or print "not ";
+print "ok 8\n";
diff --git a/lib/Term/ANSIColor/test.pl b/lib/Term/ANSIColor/test.pl
new file mode 100755
index 0000000000..f38e905cdd
--- /dev/null
+++ b/lib/Term/ANSIColor/test.pl
@@ -0,0 +1,81 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# Test suite for the Term::ANSIColor Perl module.  Before `make install' is
+# performed this script should be runnable with `make test'.  After `make
+# install' it should work as `perl test.pl'.
+
+############################################################################
+# Ensure module can be loaded
+############################################################################
+
+BEGIN { $| = 1; print "1..8\n" }
+END   { print "not ok 1\n" unless $loaded }
+use Term::ANSIColor qw(:constants color colored);
+$loaded = 1;
+print "ok 1\n";
+
+
+############################################################################
+# Test suite
+############################################################################
+
+# Test simple color attributes.
+if (color ('blue on_green', 'bold') eq "\e[34;42;1m") {
+    print "ok 2\n";
+} else {
+    print "not ok 2\n";
+}
+
+# Test colored.
+if (colored ("testing", 'blue', 'bold') eq "\e[34;1mtesting\e[0m") {
+    print "ok 3\n";
+} else {
+    print "not ok 3\n";
+}
+
+# Test the constants.
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting") {
+    print "ok 4\n";
+} else {
+    print "not ok 4\n";
+}
+
+# Test AUTORESET.
+$Term::ANSIColor::AUTORESET = 1;
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting\e[0m\e[0m") {
+    print "ok 5\n";
+} else {
+    print "not ok 5\n";
+}
+
+# Test EACHLINE.
+$Term::ANSIColor::EACHLINE = "\n";
+if (colored ("test\n\ntest", 'bold')
+    eq "\e[1mtest\e[0m\n\n\e[1mtest\e[0m") {
+    print "ok 6\n";
+} else {
+    print colored ("test\n\ntest", 'bold'), "\n";
+    print "not ok 6\n";
+}
+
+# Test EACHLINE with multiple trailing delimiters.
+$Term::ANSIColor::EACHLINE = "\r\n";
+if (colored ("test\ntest\r\r\n\r\n", 'bold')
+    eq "\e[1mtest\ntest\r\e[0m\r\n\r\n") {
+    print "ok 7\n";
+} else {
+    print "not ok 7\n";
+}
+
+# Test the array ref form.
+$Term::ANSIColor::EACHLINE = "\n";
+if (colored (['bold', 'on_green'], "test\n", "\n", "test")
+    eq "\e[1;42mtest\e[0m\n\n\e[1;42mtest\e[0m") {
+    print "ok 8\n";
+} else {
+    print colored (['bold', 'on_green'], "test\n", "\n", "test");
+    print "not ok 8\n";
+}
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 18ee902439..e0c4dbe3f7 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -554,7 +554,7 @@ on TTY.  The width is the width of the "yada/blah..." string.
 sub _mk_leader {
     my ($te, $width) = @_;
 
-    chop($te);      # XXX chomp?
+    $te =~ s/\.\w+$/./;
 
     if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
     my $blank = (' ' x 77);
diff --git a/lib/Test/Harness.t b/lib/Test/Harness.t
new file mode 100644
index 0000000000..a4c423ddd3
--- /dev/null
+++ b/lib/Test/Harness.t
@@ -0,0 +1,205 @@
+#!perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+# For shutting up Test::Harness.
+package My::Dev::Null;
+use Tie::Handle;
+@My::Dev::Null::ISA = qw(Tie::StdHandle);
+
+sub WRITE { }
+
+
+package main;
+
+# Utility testing functions.
+my $test_num = 1;
+sub ok ($;$) {
+    my($test, $name) = @_;
+    my $okstring = '';
+    $okstring = "not " unless $test;
+    $okstring .= "ok $test_num";
+    $okstring .= " - $name" if defined $name;
+    print "$okstring\n";
+    $test_num++;
+}
+
+sub eqhash {
+    my($a1, $a2) = @_;
+    return 0 unless keys %$a1 == keys %$a2;
+
+    my $ok = 1;
+    foreach my $k (keys %$a1) {
+        $ok = $a1->{$k} eq $a2->{$k};
+        last unless $ok;
+    }
+
+    return $ok;
+}
+
+use vars qw($Total_tests %samples);
+
+my $loaded;
+BEGIN { $| = 1; $^W = 1; }
+END {print "not ok $test_num\n" unless $loaded;}
+print "1..$Total_tests\n";
+use Test::Harness;
+$loaded = 1;
+ok(1, 'compile');
+######################### End of black magic.
+
+BEGIN {
+    %samples = (
+                simple            => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                simple_fail      => {
+                                     bonus       => 0,
+                                     max         => 5,
+                                     'ok'          => 3,
+                                     files       => 1,
+                                     bad         => 1,
+                                     good        => 0,
+                                     tests       => 1,
+                                     sub_skipped => 0,
+                                     skipped     => 0,
+                                    },
+                descriptive       => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                no_nums           => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 4,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                todo              => {
+                                      bonus      => 1,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                skip              => {
+                                      bonus      => 0,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 1,
+                                      skipped    => 0,
+                                     },
+                bailout           => 0,
+                combined          => {
+                                      bonus      => 1,
+                                      max        => 10,
+                                      'ok'         => 8,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 1,
+                                      skipped    => 0
+                                     },
+                duplicates        => {
+                                      bonus      => 0,
+                                      max        => 10,
+                                      'ok'         => 11,
+                                      files      => 1,
+                                      bad        => 1,
+                                      good       => 0,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                header_at_end     => {
+                                      bonus      => 0,
+                                      max        => 4,
+                                      'ok'         => 4,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+                skip_all          => {
+                                      bonus      => 0,
+                                      max        => 0,
+                                      'ok'         => 0,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 1,
+                                     },
+                with_comments     => {
+                                      bonus      => 2,
+                                      max        => 5,
+                                      'ok'         => 5,
+                                      files      => 1,
+                                      bad        => 0,
+                                      good       => 1,
+                                      tests      => 1,
+                                      sub_skipped=> 0,
+                                      skipped    => 0,
+                                     },
+               );
+
+    $Total_tests = keys(%samples) + 1;
+}
+
+tie *NULL, 'My::Dev::Null' or die $!;
+
+while (my($test, $expect) = each %samples) {
+    # _run_all_tests() runs the tests but skips the formatting.
+    my($totals, $failed);
+    eval {
+        select NULL;    # _run_all_tests() isn't as quiet as it should be.
+        ($totals, $failed) = 
+          Test::Harness::_run_all_tests("lib/sample-tests/$test");
+    };
+    select STDOUT;
+
+    unless( $@ ) {
+        ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), 
+                                                                      $test );
+    }
+    else {      # special case for bailout
+        ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i),
+            $test );
+    }
+}
diff --git a/lib/Test/t/fail.t b/lib/Test/t/fail.t
new file mode 100644
index 0000000000..b431502b8a
--- /dev/null
+++ b/lib/Test/t/fail.t
@@ -0,0 +1,93 @@
+# -*-perl-*-
+use strict;
+use vars qw($Expect);
+use Test qw($TESTOUT $ntest ok skip plan); 
+plan tests => 14;
+
+open F, ">fails";
+$TESTOUT = *F{IO};
+
+my $r=0;
+{
+    # Shut up deprecated usage warning.
+    local $^W = 0;
+    $r |= skip(0,0);
+}
+$r |= ok(0);
+$r |= ok(0,1);
+$r |= ok(sub { 1+1 }, 3);
+$r |= ok(sub { 1+1 }, sub { 2 * 0});
+
+my @list = (0,0);
+$r |= ok @list, 1, "\@list=".join(',',@list);
+$r |= ok @list, 1, sub { "\@list=".join ',',@list };
+$r |= ok 'segmentation fault', '/bongo/';
+
+for (1..2) { $r |= ok(0); }
+
+$r |= ok(1, undef);
+$r |= ok(undef, 1);
+
+ok($r); # (failure==success :-)
+
+close F;
+$TESTOUT = *STDOUT{IO};
+$ntest = 1;
+
+open F, "fails";
+my $O;
+while (<F>) { $O .= $_; }
+close F;
+unlink "fails";
+
+ok join(' ', map { m/(\d+)/; $1 } grep /^not ok/, split /\n+/, $O),
+    join(' ', 1..13);
+
+my @got = split /not ok \d+\n/, $O;
+shift @got;
+
+$Expect =~ s/\n+$//;
+my @expect = split /\n\n/, $Expect;
+
+for (my $x=0; $x < @got; $x++) {
+    ok $got[$x], $expect[$x]."\n";
+}
+
+
+BEGIN {
+    $Expect = <<"EXPECT";
+# Failed test 1 in $0 at line 14
+
+# Failed test 2 in $0 at line 16
+
+# Test 3 got: '0' ($0 at line 17)
+#   Expected: '1'
+
+# Test 4 got: '2' ($0 at line 18)
+#   Expected: '3'
+
+# Test 5 got: '2' ($0 at line 19)
+#   Expected: '0'
+
+# Test 6 got: '2' ($0 at line 22)
+#   Expected: '1' (\@list=0,0)
+
+# Test 7 got: '2' ($0 at line 23)
+#   Expected: '1' (\@list=0,0)
+
+# Test 8 got: 'segmentation fault' ($0 at line 24)
+#   Expected: qr{bongo}
+
+# Failed test 9 in $0 at line 26
+
+# Failed test 10 in $0 at line 26 fail #2
+
+# Failed test 11 in $0 at line 28
+
+# Test 12 got: <UNDEF> ($0 at line 29)
+#    Expected: '1'
+
+# Failed test 13 in $0 at line 31
+EXPECT
+
+}
diff --git a/lib/Test/t/mix.t b/lib/Test/t/mix.t
new file mode 100644
index 0000000000..d911689845
--- /dev/null
+++ b/lib/Test/t/mix.t
@@ -0,0 +1,17 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { plan tests => 4, todo => [2,3] }
+
+ok(sub { 
+       my $r = 0;
+       for (my $x=0; $x < 10; $x++) {
+	   $r += $x*($r+1);
+       }
+       $r
+   }, 3628799);
+
+ok(0);
+ok(1);
+
+skip(1,0);
diff --git a/lib/Test/t/onfail.t b/lib/Test/t/onfail.t
new file mode 100644
index 0000000000..dce4373401
--- /dev/null
+++ b/lib/Test/t/onfail.t
@@ -0,0 +1,31 @@
+# -*-perl-*-
+
+use strict;
+use Test qw($ntest plan ok $TESTOUT);
+use vars qw($mycnt);
+
+BEGIN { plan test => 6, onfail => \&myfail }
+
+$mycnt = 0;
+
+my $why = "zero != one";
+# sneak in a test that Test::Harness wont see
+open J, ">junk";
+$TESTOUT = *J{IO};
+ok(0, 1, $why);
+$TESTOUT = *STDOUT{IO};
+close J;
+unlink "junk";
+$ntest = 1;
+
+sub myfail {
+    my ($f) = @_;
+    ok(@$f, 1);
+
+    my $t = $$f[0];
+    ok($$t{diagnostic}, $why);
+    ok($$t{'package'}, 'main');
+    ok($$t{repetition}, 1);
+    ok($$t{result}, 0);
+    ok($$t{expected}, 1);
+}
diff --git a/lib/Test/t/qr.t b/lib/Test/t/qr.t
new file mode 100644
index 0000000000..ea40f87308
--- /dev/null
+++ b/lib/Test/t/qr.t
@@ -0,0 +1,13 @@
+#!./perl -w
+
+use strict;
+BEGIN {
+    if ($] < 5.005) {
+	print "1..0\n";
+	print "ok 1 # skipped; this test requires at least perl 5.005\n";
+	exit;
+    }
+}
+use Test; plan tests => 1;
+
+ok 'abc', qr/b/;
diff --git a/lib/Test/t/skip.t b/lib/Test/t/skip.t
new file mode 100644
index 0000000000..7db35e65dc
--- /dev/null
+++ b/lib/Test/t/skip.t
@@ -0,0 +1,40 @@
+# -*-perl-*-
+use strict;
+use Test qw($TESTOUT $ntest plan ok skip); plan tests => 6;
+
+open F, ">skips" or die "open skips: $!";
+$TESTOUT = *F{IO};
+
+skip(1, 0);  #should skip
+
+my $skipped=1;
+skip('hop', sub { $skipped = 0 });
+skip(sub {'jump'}, sub { $skipped = 0 });
+skip('skipping stones is more fun', sub { $skipped = 0 });
+
+close F;
+
+$TESTOUT = *STDOUT{IO};
+$ntest = 1;
+open F, "skips" or die "open skips: $!";
+
+ok $skipped, 1, 'not skipped?';
+
+my @T = <F>;
+chop @T;
+my @expect = split /\n+/, join('',<DATA>);
+ok @T, 4;
+for (my $x=0; $x < @T; $x++) {
+    ok $T[$x], $expect[$x];
+}
+
+END { close F; unlink "skips" }
+
+__DATA__
+ok 1 # skip
+
+ok 2 # skip hop
+
+ok 3 # skip jump
+
+ok 4 # skip skipping stones is more fun
diff --git a/lib/Test/t/success.t b/lib/Test/t/success.t
new file mode 100644
index 0000000000..a580f0a567
--- /dev/null
+++ b/lib/Test/t/success.t
@@ -0,0 +1,11 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { plan tests => 11 }
+
+ok(ok(1));
+ok(ok('fixed', 'fixed'));
+ok(skip(1,0));
+ok(undef, undef);
+ok(ok 'the brown fox jumped over the lazy dog', '/lazy/');
+ok(ok 'the brown fox jumped over the lazy dog', 'm,fox,');
diff --git a/lib/Test/t/todo.t b/lib/Test/t/todo.t
new file mode 100644
index 0000000000..ae02a04f6b
--- /dev/null
+++ b/lib/Test/t/todo.t
@@ -0,0 +1,13 @@
+# -*-perl-*-
+use strict;
+use Test;
+BEGIN { 
+    my $tests = 5; 
+    plan tests => $tests, todo => [1..$tests]; 
+}
+
+ok(0);
+ok(1);
+ok(0,1);
+ok(0,1,"need more tuits");
+ok(1,1);
diff --git a/lib/Text/Balanced/t/genxt.t b/lib/Text/Balanced/t/genxt.t
new file mode 100644
index 0000000000..6889653841
--- /dev/null
+++ b/lib/Text/Balanced/t/genxt.t
@@ -0,0 +1,104 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..35\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	$str =~ s/\\n/\n/g;
+	if ($str =~ s/\A# USING://)
+	{
+		$neg = 0;
+		eval{local$^W;*f = eval $str || die};
+		next;
+	}
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	my @res;
+	$var = eval { @res = f($str) };
+	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval { scalar f($str) };
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+
+# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+	<A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged("BEGIN","END");
+	BEGIN at the BEGIN keyword and END at the END;
+	BEGIN at the beginning and end at the END;
+
+# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]});
+	<A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"});
+	; at the ;-) keyword
+
+# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+	<A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+	BEGIN at the beginning and end at the end;
+	BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+	BEGIN at the BEGIN keyword and END at the end;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"});
+	; at the ;-) keyword
+
+
+# USING: gen_extract_tagged();
+	<A>some text</A>;
+	<B>some text<A>other text</A></B>;
+	<A>some text<A>other text</A></A>;
+	<A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+	<A>some text
+	<A>some text<A>other text</A>;
+	<B>some text<A>other text</B>;
diff --git a/lib/Text/Balanced/t/xbrak.t b/lib/Text/Balanced/t/xbrak.t
new file mode 100644
index 0000000000..5a8e5249a8
--- /dev/null
+++ b/lib/Text/Balanced/t/xbrak.t
@@ -0,0 +1,81 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..19\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_bracketed );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	$var = eval "() = $cmd";
+	debug "\t list got: [$var]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval $cmd;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+
+# USING: extract_bracketed($str);
+{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s };
+
+# USING: extract_bracketed($str,'{}');
+{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s };
+
+# THESE SHOULD FAIL
+{an unmatched nested { isn't okay, nor are ( and < };
+{an unbalanced nested [ even with } and ] to match them;
+
+
+# USING: extract_bracketed($str,'<"`q>');
+<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >;
+
+# USING: extract_bracketed($str,'<">');
+<a quoted ">" unbalanced right bracket is okay >;
+
+# USING: extract_bracketed($str,'<"`>');
+<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >;
+
+# THIS SHOULD FAIL
+<a misquoted '>' unbalanced right bracket is bad >;
diff --git a/lib/Text/Balanced/t/xcode.t b/lib/Text/Balanced/t/xcode.t
new file mode 100644
index 0000000000..00be51e542
--- /dev/null
+++ b/lib/Text/Balanced/t/xcode.t
@@ -0,0 +1,94 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..37\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_codeblock );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	my @res;
+	$var = eval "\@res = $cmd";
+	debug "\t   Failed: $@ at " . $@+0 .")" if $@;
+	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+	print "ok ", $count++;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval $cmd;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+
+# USING: extract_codeblock($str,'<>');
+< %x = ( try => "this") >;
+< %x = () >;
+< %x = ( $try->{this}, "too") >;
+< %'x = ( $try->{this}, "too") >;
+< %'x'y = ( $try->{this}, "too") >;
+< %::x::y = ( $try->{this}, "too") >;
+
+# THIS SHOULD FAIL
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str);
+
+{ $a = /\}/; };
+{ sub { $_[0] /= $_[1] } };  # / here
+{ 1; };
+{ $a = 1; };
+
+
+# USING: extract_codeblock($str,undef,'=*');
+========{$a=1};
+
+# USING: extract_codeblock($str,'{}<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}',undef,'<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}');
+{ $a = $b; # what's this doing here? \n };'
+{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b };
+
+# THIS SHOULD FAIL
+{ $a = $b; # what's this doing here? };'
+{ $a = $b; # what's this doing here? ;'
diff --git a/lib/Text/Balanced/t/xdeli.t b/lib/Text/Balanced/t/xdeli.t
new file mode 100644
index 0000000000..7e5b06beca
--- /dev/null
+++ b/lib/Text/Balanced/t/xdeli.t
@@ -0,0 +1,95 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..45\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_delimited );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	$var = eval "() = $cmd";
+	debug "\t list got: [$var]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval $cmd;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+# USING: extract_delimited($str,'/#$',undef,'/#$');
+/a/;
+/a///;
+#b#;
+#b###;
+$c$;
+$c$$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
+# USING: extract_delimited($str,'/#$',undef,'\\');
+/a/;
+/a\//;
+#b#;
+#b\##;
+$c$;
+$c\$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str);
+'a';
+"b";
+`c`;
+'a\'';
+'a\\';
+'\\a';
+"a\\";
+"\\a";
+"b\'\"\'";
+`c '\`abc\`'`;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str,'/#$','-->');
+-->/a/;
+-->#b#;
+-->$c$;
+
+# THIS SHOULD FAIL
+$c$;
diff --git a/lib/Text/Balanced/t/xmult.t b/lib/Text/Balanced/t/xmult.t
new file mode 100644
index 0000000000..31dd7d4051
--- /dev/null
+++ b/lib/Text/Balanced/t/xmult.t
@@ -0,0 +1,316 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..85\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( :ALL );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+sub expect
+{
+	local $^W;
+	my ($l1, $l2) = @_;
+
+	if (@$l1 != @$l2)
+	{
+		print "\@l1: ", join(", ", @$l1), "\n";
+		print "\@l2: ", join(", ", @$l2), "\n";
+		print "not ";
+	}
+	else
+	{
+		for (my $i = 0; $i < @$l1; $i++)
+		{
+			if ($l1->[$i] ne $l2->[$i])
+			{
+				print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
+				print "not ";
+				last;
+			}
+		}
+	}
+
+	print "ok $count\n";
+	$count++;
+}
+
+sub divide
+{
+	my ($text, @index) = @_;
+	my @bits = ();
+	unshift @index, 0;
+	push @index, length($text);
+	for ( my $i= 0; $i < $#index; $i++)
+	{
+		push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
+	}
+	pop @bits;
+	return @bits;
+
+}
+
+
+$stdtext1 = q{$var = do {"val" && $val;};};
+
+# TESTS 2-4
+$text = $stdtext1;
+expect	[ extract_multiple($text,undef,1) ],
+	[ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 4 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 5-7
+$text = $stdtext1;
+expect	[ scalar extract_multiple($text,undef,1) ],
+	[ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 8-10
+$text = $stdtext1;
+expect	[ extract_multiple($text,undef,2) ],
+	[ divide($stdtext1 => 4, 10) ];
+
+expect [ pos $text], [ 10 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 11-13
+$text = $stdtext1;
+expect	[ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
+	[ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 14-16
+$text = $stdtext1;
+expect	[ extract_multiple($text,undef,3) ],
+	[ divide($stdtext1 => 4, 10, 26) ];
+
+expect [ pos $text], [ 26 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 17-19
+$text = $stdtext1;
+expect	[ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
+	[ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 20-22
+$text = $stdtext1;
+expect	[ extract_multiple($text,undef,4) ],
+	[ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 23-25
+$text = $stdtext1;
+expect	[ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
+	[ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 26-28
+$text = $stdtext1;
+expect	[ extract_multiple($text,undef,5) ],
+	[ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+
+# TESTS 29-31
+$text = $stdtext1;
+expect	[ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
+	[ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+
+# TESTS 32-34
+$stdtext2 = q{$var = "val" && (1,2,3);};
+
+$text = $stdtext2;
+expect	[ extract_multiple($text) ],
+	[ divide($stdtext2 => 4, 7, 12, 24) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 35-37
+$text = $stdtext2;
+expect	[ scalar extract_multiple($text) ],
+	[ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 38-40
+$text = $stdtext2;
+expect	[ extract_multiple($text,[\&extract_bracketed]) ],
+	[ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 41-43
+$text = $stdtext2;
+expect	[ scalar extract_multiple($text,[\&extract_bracketed]) ],
+	[ substr($stdtext2,0,15) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,15) ];
+
+
+# TESTS 44-46
+$text = $stdtext2;
+expect	[ extract_multiple($text,[\&extract_variable]) ],
+	[ substr($stdtext2,0,4), substr($stdtext2,4) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 47-49
+$text = $stdtext2;
+expect	[ scalar extract_multiple($text,[\&extract_variable]) ],
+	[ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 50-52
+$text = $stdtext2;
+expect	[ extract_multiple($text,[\&extract_quotelike]) ],
+	[ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 53-55
+$text = $stdtext2;
+expect	[ scalar extract_multiple($text,[\&extract_quotelike]) ],
+	[ substr($stdtext2,0,6) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,6) ];
+
+
+# TESTS 56-58
+$text = $stdtext2;
+expect	[ extract_multiple($text,[\&extract_quotelike],2,1) ],
+	[ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 23 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 59-61
+$text = $stdtext2;
+expect	[ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
+	[ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+
+# TESTS 62-64
+$text = $stdtext2;
+expect	[ extract_multiple($text,[\&extract_quotelike],1,1) ],
+	[ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 12 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 65-67
+$text = $stdtext2;
+expect	[ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
+	[ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+# TESTS 68-70
+my $stdtext3 = "a,b,c";
+
+$_ = $stdtext3;
+expect	[ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+	[ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 71-73
+
+$_ = $stdtext3;
+expect	[ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+	[ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 74-76
+
+$_ = $stdtext3;
+expect	[ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+	[ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 77-79
+
+$_ = $stdtext3;
+expect	[ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+	[ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 80-82
+
+$_ = $stdtext3;
+expect	[ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+	[ qw(a b c) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 83-85
+
+$_ = $stdtext3;
+expect	[ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+	[ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,2) ];
diff --git a/lib/Text/Balanced/t/xquot.t b/lib/Text/Balanced/t/xquot.t
new file mode 100644
index 0000000000..567e0a54b8
--- /dev/null
+++ b/lib/Text/Balanced/t/xquot.t
@@ -0,0 +1,118 @@
+#!./perl -ws
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..89\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_quotelike );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+# $DEBUG=1;
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+	$str =~ s/\\n/\n/g;
+	my $orig = $str;
+
+	 my @res;
+	eval qq{\@res = $cmd; };
+	debug "\t  got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
+	debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
+	debug "\t  pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
+	print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+	print "ok ", $count++;
+	print "\n";
+
+	$str = $orig;
+	debug "\tUsing: scalar $cmd\n";
+	debug "\t   on: [$str]\n";
+	$var = eval $cmd;
+	print " ($@)" if $@ && $DEBUG;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
+	debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print "\n";
+}
+
+__DATA__
+
+# USING: extract_quotelike($str);
+'';
+"";
+"a";
+'b';
+`cc`;
+
+
+<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
+     <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
+<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
+<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
+<<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
+<<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
+<<"   EOHERE"; done() \nline1\nline2\n   EOHERE\nand next
+<<""; done()\nline1\nline2\n\n and next
+<<; done()\nline1\nline2\n\n and next
+
+
+"this is a nested $var[$x] {";
+/a/gci;
+m/a/gci;
+
+q(d);
+qq(e);
+qx(f);
+qr(g);
+qw(h i j);
+q{d};
+qq{e};
+qx{f};
+qr{g};
+qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+q/slash/;
+q # slash #;
+qr qw qx;
+
+s/x/y/;
+s/x/y/cgimsox;
+s{a}{b};
+s{a}\n {b};
+s(a){b};
+s(a)/b/;
+s/'/\\'/g;
+tr/x/y/;
+y/x/y/;
+
+# THESE SHOULD FAIL
+s<$self->{pat}>{$self->{sub}};		# CAN'T HANDLE '>' in '->'
+s-$self->{pap}-$self->{sub}-;		# CAN'T HANDLE '-' in '->'
+<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next;	    # RDEL HAS NO ';'
+<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next;	    # RDEF HAS NO ';'
+     <<    EOTHERE; done();\nline1\nline2\n    EOTHERE\n; next;  # RDEL IS "" (!)
diff --git a/lib/Text/Balanced/t/xtagg.t b/lib/Text/Balanced/t/xtagg.t
new file mode 100644
index 0000000000..c883181c24
--- /dev/null
+++ b/lib/Text/Balanced/t/xtagg.t
@@ -0,0 +1,118 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..53\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_tagged gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	my @res;
+	$var = eval "\@res = $cmd";
+	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval $cmd;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
+	ignore\n this and then BEGINHERE at the ENDHERE;
+	ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+	ignore\n this and then BEGINHERE at the ENDHERE;
+	ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+	ignore\n this and then BEGINHERE at the ENDHERE;
+	ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# THIS SHOULD FAIL
+	ignore\n this and then BEGINTHIS at the ENDTHAT;
+
+# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)");
+	ignore\n this and then BEGIN at the END;
+
+# USING: extract_tagged($str);
+	<A-1 HREF="#section2">some text</A-1>;
+
+# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+	<A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,"BEGIN","END");
+	BEGIN at the BEGIN keyword and END at the END;
+	BEGIN at the beginning and end at the END;
+
+# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]});
+	<A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"});
+	; at the ;-) keyword
+
+# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+	<A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+	BEGIN at the beginning and end at the end;
+	BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+	BEGIN at the BEGIN keyword and END at the end;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"});
+	; at the ;-) keyword
+
+
+# USING: extract_tagged($str);
+	<A>some text</A>;
+	<B>some text<A>other text</A></B>;
+	<A>some text<A>other text</A></A>;
+	<A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+	<A>some text
+	<A>some text<A>other text</A>;
+	<B>some text<A>other text</B>;
diff --git a/lib/Text/Balanced/t/xvari.t b/lib/Text/Balanced/t/xvari.t
new file mode 100644
index 0000000000..dd35b9c032
--- /dev/null
+++ b/lib/Text/Balanced/t/xvari.t
@@ -0,0 +1,107 @@
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# 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.)
+
+BEGIN { $| = 1; print "1..81\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_variable );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+	chomp $str;
+	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	$str =~ s/\\n/\n/g;
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
+
+	my @res;
+	$var = eval "\@res = $cmd";
+	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list left: [$str]\n";
+	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+
+	pos $str = 0;
+	$var = eval $cmd;
+	$var = "<undef>" unless defined $var;
+	debug "\t scalar got: [$var]\n";
+	debug "\t scalar left: [$str]\n";
+	print "not " if ($str =~ '\A;')==$neg;
+	print "ok ", $count++;
+	print " ($@)" if $@ && $DEBUG;
+	print "\n";
+}
+
+__DATA__
+
+# USING: extract_variable($str);
+# THESE SHOULD FAIL
+$a->;
+$a (1..3) { print $a };
+
+# USING: extract_variable($str);
+*var;
+*$var;
+*{var};
+*{$var};
+*var{cat};
+\&var;
+\&mod::var;
+\&mod'var;
+$a;
+$_;
+$a[1];
+$_[1];
+$a{cat};
+$_{cat};
+$a->[1];
+$a->{"cat"}[1];
+@$listref;
+@{$listref};
+$obj->nextval;
+$obj->_nextval;
+$obj->next_val_;
+@{$obj->nextval};
+@{$obj->nextval($cat,$dog)->{new}};
+@{$obj->nextval($cat?$dog:$fish)->{new}};
+@{$obj->nextval(cat()?$dog:$fish)->{new}};
+$ a {'cat'};
+$a::b::c{d}->{$e->()};
+$a'b'c'd{e}->{$e->()};
+$a'b::c'd{e}->{$e->()};
+$#_;
+$#array;
+$#{array};
+$var[$#var];
+
+# THESE SHOULD FAIL
+$a->;
+@{$;
+$ a :: b :: c
+$ a ' b ' c
+
+# USING: extract_variable($str,'=*');
+========$a;
diff --git a/lib/Text/ParseWords.t b/lib/Text/ParseWords.t
new file mode 100755
index 0000000000..261d81f3a4
--- /dev/null
+++ b/lib/Text/ParseWords.t
@@ -0,0 +1,110 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use Text::ParseWords;
+
+print "1..18\n";
+
+@words = shellwords(qq(foo "bar quiz" zoo));
+print "not " if $words[0] ne 'foo';
+print "ok 1\n";
+print "not " if $words[1] ne 'bar quiz';
+print "ok 2\n";
+print "not " if $words[2] ne 'zoo';
+print "ok 3\n";
+
+{
+  # Gonna get some undefined things back
+  no warnings 'uninitialized' ;
+
+  # Test quotewords() with other parameters and null last field
+  @words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+  print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
+  print "ok 4\n";
+}
+
+# Test $keep eq 'delimiters' and last field zero
+@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
+print "ok 5\n";
+
+# Big ol' nasty test (thanks, Joerk!)
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
+
+# First with $keep == 1
+$result = join('|', parse_line('\s+', 1, $string));
+print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
+print "ok 6\n";
+
+# Now, $keep == 0
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
+print "ok 7\n";
+
+# Now test single quote behavior
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
+print "ok 8\n";
+
+# Make sure @nested_quotewords does the right thing
+@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
+print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
+print "ok 9\n";
+
+# Now test error return
+$string = 'foo bar baz"bach blech boop';
+
+@words = shellwords($string);
+print "not " if (@words);
+print "ok 10\n";
+
+@words = parse_line('s+', 0, $string);
+print "not " if (@words);
+print "ok 11\n";
+
+@words = quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 12\n";
+
+{
+  # Gonna get some more undefined things back
+  no warnings 'uninitialized' ;
+
+  @words = nested_quotewords('s+', 0, $string);
+  print "not " if (@words);
+  print "ok 13\n";
+
+  # Now test empty fields
+  $result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+  print "not " unless ($result eq 'foo||0||||');
+  print "ok 14\n";
+
+  # Test for 0 in quotes without $keep
+  $result = join('|', parse_line(':', 0, ':"0":'));
+  print "not " unless ($result eq '|0|');
+  print "ok 15\n";
+
+  # Test for \001 in quoted string
+  $result = join('|', parse_line(':', 0, ':"' . "\001" . '":'));
+  print "not " unless ($result eq "|\1|");
+  print "ok 16\n";
+
+}
+
+# Now test perlish single quote behavior
+$Text::ParseWords::PERL_SINGLE_QUOTE = 1;
+$string = 'aaaa"bbbbb" cc\ cc \\\\\"dddd\' eee\\\\\"\\\'ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\"dddd eee\\\\"\'ffff|gg';
+print "ok 17\n";
+
+# test whitespace in the delimiters
+@words = quotewords(' ', 1, '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4;3;2;1;0);
+print "ok 18\n";
diff --git a/lib/Text/Soundex.t b/lib/Text/Soundex.t
new file mode 100755
index 0000000000..d35f264c7a
--- /dev/null
+++ b/lib/Text/Soundex.t
@@ -0,0 +1,143 @@
+#!./perl
+#
+# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
+#
+# test module for soundex.pl
+#
+# $Log: soundex.t,v $
+# Revision 1.2  1994/03/24  00:30:27  mike
+# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
+# in the way I handles leasing characters which were different but had
+# the same soundex code.  This showed up comparing it with Oracle's
+# soundex output.
+#
+# Revision 1.1  1994/03/02  13:03:02  mike
+# Initial revision
+#
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Soundex;
+
+$test = 0;
+print "1..13\n";
+
+while (<DATA>)
+{
+  chop;
+  next if /^\s*;?#/;
+  next if /^\s*$/;
+
+  ++$test;
+  $bad = 0;
+
+  if (/^eval\s+/)
+  {
+    ($try = $_) =~ s/^eval\s+//;
+
+    eval ($try);
+    if ($@)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# eval '$try' returned $@";
+    }
+  }
+  elsif (/^\(/)
+  {
+    ($in, $out) = split (':');
+
+    $try = "\@expect = $out; \@got = &soundex $in;";
+    eval ($try);
+
+    if (@expect != @got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
+      print "# expected (", join (', ', @expect),
+	    ") got (", join (', ', @got), ")\n";
+    }
+    else
+    {
+      while (@got)
+      {
+	$expect = shift @expect;
+	$got = shift @got;
+
+	if ($expect ne $got)
+	{
+	  $bad++;
+	  print "not ok $test\n";
+	  print "# expected $expect, got $got\n";
+	}
+      }
+    }
+  }
+  else
+  {
+    ($in, $out) = split (':');
+
+    $try = "\$expect = $out; \$got = &soundex ($in);";
+    eval ($try);
+
+    if ($expect ne $got)
+    {
+      $bad++;
+      print "not ok $test\n";
+      print "# expected $expect, got $got\n";
+    }
+  }
+
+  print "ok $test\n" unless $bad;
+}
+
+__END__
+#
+# 1..6
+#
+# Knuth's test cases, scalar in, scalar out
+#
+'Euler':'E460'
+'Gauss':'G200'
+'Hilbert':'H416'
+'Knuth':'K530'
+'Lloyd':'L300'
+'Lukasiewicz':'L222'
+#
+# 7..8
+#
+# check default bad code
+#
+'2 + 2 = 4':undef
+undef:undef
+#
+# 9
+#
+# check array in, array out
+#
+('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
+#
+# 10
+#
+# check array with explicit undef
+#
+('Mike', undef, 'Stok'):('M200', undef, 'S320')
+#
+# 11..12
+#
+# check setting $Text::Soundex::noCode
+#
+eval $soundex_nocode = 'Z000';
+('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
+#
+# 13
+#
+# a subtle difference between me & oracle, spotted by Rich Pinder
+# <rpinder@hsc.usc.edu>
+#
+CZARKOWSKA:C622
diff --git a/lib/Text/Tabs.t b/lib/Text/Tabs.t
new file mode 100755
index 0000000000..2856aff75b
--- /dev/null
+++ b/lib/Text/Tabs.t
@@ -0,0 +1,141 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST 1 u
+                x
+END
+		x
+END
+TEST 2 e
+		x
+END
+                x
+END
+TEST 3 e
+	x
+		y
+			z
+END
+        x
+                y
+                        z
+END
+TEST 4 u
+        x
+                y
+                        z
+END
+	x
+		y
+			z
+END
+TEST 5 u
+This    Is      a       test    of      a       line with many embedded tabs
+END
+This	Is	a	test	of	a	line with many embedded tabs
+END
+TEST 6 e
+This	Is	a	test	of	a	line with many embedded tabs
+END
+This    Is      a       test    of      a       line with many embedded tabs
+END
+TEST 7 u
+            x
+END
+	    x
+END
+TEST 8 e
+	
+		
+   	
+
+           
+END
+        
+                
+        
+
+           
+END
+TEST 9 u
+           
+END
+	   
+END
+TEST 10 u
+	
+		
+   	
+
+           
+END
+	
+		
+	
+
+	   
+END
+TEST 11 u
+foobar                  IN	A		140.174.82.12
+
+END
+foobar			IN	A		140.174.82.12
+
+END
+DONE
+
+$| = 1;
+
+my $testcount = "1..";
+$testcount .= @tests/2;
+print "$testcount\n";
+
+use Text::Tabs;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+	my $in = shift(@tests);
+	my $out = shift(@tests);
+
+	$in =~ s/^TEST\s*(\d+)?\s*(\S+)?\n//;
+
+	if ($2 eq 'e') {
+		$f = \&expand;
+		$fn = 'expand';
+	} else {
+		$f = \&unexpand;
+		$fn = 'unexpand';
+	}
+
+	my $back = &$f($in);
+
+	if ($back eq $out) {
+		print "ok $tn\n";
+	} elsif ($rerun) {
+		my $oi = $in;
+		foreach ($in, $back, $out) {
+			s/\t/^I\t/gs;
+			s/\n/\$\n/gs;
+		}
+		print "------------ input ------------\n";
+		print $in;
+		print "\$\n------------ $fn -----------\n";
+		print $back;
+		print "\$\n------------ expected ---------\n";
+		print $out;
+		print "\$\n-------------------------------\n";
+		$Text::Tabs::debug = 1;
+		my $back = &$f($in);
+		exit(1);
+	} else {
+		print "not ok $tn\n";
+	}
+	$tn++;
+}
diff --git a/lib/Text/Wrap/fill.t b/lib/Text/Wrap/fill.t
new file mode 100755
index 0000000000..5ff3850caf
--- /dev/null
+++ b/lib/Text/Wrap/fill.t
@@ -0,0 +1,98 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Wrap qw(&fill);
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+Cyberdog Information
+
+Cyberdog & Netscape in the news
+Important Press Release regarding Cyberdog and Netscape. Check it out! 
+
+Cyberdog Plug-in Support!
+Cyberdog support for Netscape Plug-ins is now available to download! Go
+to the Cyberdog Beta Download page and download it now! 
+
+Cyberdog Book
+Check out Jesse Feiler's way-cool book about Cyberdog. You can find
+details out about the book as well as ordering information at Philmont
+Software Mill site. 
+
+Java!
+Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
+the Mac OS Runtime for Java and try it out! 
+
+Cyberdog 1.1 Beta 3
+We hope that Cyberdog and OpenDoc 1.1 will be available within the next
+two weeks. In the meantime, we have released another version of
+Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
+reported to us during out public beta period. You can check out our release
+notes to see what we fixed! 
+END
+    Cyberdog Information
+    Cyberdog & Netscape in the news Important Press Release regarding
+ Cyberdog and Netscape. Check it out! 
+    Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
+ available to download! Go to the Cyberdog Beta Download page and download
+ it now! 
+    Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
+ You can find details out about the book as well as ordering information at
+ Philmont Software Mill site. 
+    Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
+ install the Mac OS Runtime for Java and try it out! 
+    Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
+ available within the next two weeks. In the meantime, we have released
+ another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
+ several bugs that were reported to us during out public beta period. You
+ can check out our release notes to see what we fixed! 
+END
+DONE
+
+
+$| = 1;
+
+print "1..", @tests/2, "\n";
+
+use Text::Wrap;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+while (@tests) {
+	my $in = shift(@tests);
+	my $out = shift(@tests);
+
+	$in =~ s/^TEST(\d+)?\n//;
+
+	my $back = fill('    ', ' ', $in);
+
+	if ($back eq $out) {
+		print "ok $tn\n";
+	} elsif ($rerun) {
+		my $oi = $in;
+		open(F,">#o") and do { print F $back; close(F) };
+		open(F,">#e") and do { print F $out;  close(F) };
+		foreach ($in, $back, $out) {
+			s/\t/^I\t/gs;
+			s/\n/\$\n/gs;
+		}
+		print "------------ input ------------\n";
+		print $in;
+		print "\n------------ output -----------\n";
+		print $back;
+		print "\n------------ expected ---------\n";
+		print $out;
+		print "\n-------------------------------\n";
+		$Text::Wrap::debug = 1;
+		fill('    ', ' ', $oi);
+		exit(1);
+	} else {
+		print "not ok $tn\n";
+	}
+	$tn++;
+}
diff --git a/lib/Text/Wrap/wrap.t b/lib/Text/Wrap/wrap.t
new file mode 100755
index 0000000000..fee6ce070d
--- /dev/null
+++ b/lib/Text/Wrap/wrap.t
@@ -0,0 +1,209 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+@tests = (split(/\nEND\n/s, <<DONE));
+TEST1
+This 
+is
+a
+test
+END
+   This 
+ is
+ a
+ test
+END
+TEST2
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+END
+   This is a test of a very long line.	It should be broken up and put onto
+ multiple lines.
+ This is a test of a very long line.  It should be broken up and put onto
+ multiple lines.
+ 
+ This is a test of a very long line.  It should be broken up and put onto
+ multiple lines.
+END
+TEST3
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+END
+   This is a test of a very long line.	It should be broken up and put onto
+ multiple lines.
+END
+TEST4
+This is a test of a very long line.  It should be broken up and put onto multiple lines.
+
+END
+   This is a test of a very long line.	It should be broken up and put onto
+ multiple lines.
+
+END
+TEST5
+This is a test of a very long line. It should be broken up and put onto multiple This is a test of a very long line. It should be broken up and put
+END
+   This is a test of a very long line. It should be broken up and put onto
+ multiple This is a test of a very long line. It should be broken up and
+ put
+END
+TEST6
+11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+   11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888
+ 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff
+ gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn
+ ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
+END
+TEST7
+c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6 c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0 c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0 c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+   c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6
+ c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0
+ c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0
+ c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
+END
+TEST8
+A test of a very very long word.
+a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+   A test of a very very long word.
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+TEST9
+A test of a very very long word.  a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
+END
+   A test of a very very long word. 
+ a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
+ 4567
+END
+TEST10
+my mother once said
+"never eat paste my darling"
+would that I heeded
+END
+   my mother once said
+ "never eat paste my darling"
+ would that I heeded
+END
+TEST11
+This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn
+END
+   This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_pr
+ ogram_does_not_crash_and_burn
+END
+TEST12
+This
+
+Has
+
+Blank
+
+Lines
+
+END
+   This
+ 
+ Has
+ 
+ Blank
+ 
+ Lines
+
+END
+DONE
+
+
+$| = 1;
+
+print "1..", 1 +@tests, "\n";
+
+use Text::Wrap;
+
+$rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+$tn = 1;
+
+@st = @tests;
+while (@st) {
+	my $in = shift(@st);
+	my $out = shift(@st);
+
+	$in =~ s/^TEST(\d+)?\n//;
+
+	my $back = wrap('   ', ' ', $in);
+
+	if ($back eq $out) {
+		print "ok $tn\n";
+	} elsif ($rerun) {
+		my $oi = $in;
+		foreach ($in, $back, $out) {
+			s/\t/^I\t/gs;
+			s/\n/\$\n/gs;
+		}
+		print "------------ input ------------\n";
+		print $in;
+		print "\n------------ output -----------\n";
+		print $back;
+		print "\n------------ expected ---------\n";
+		print $out;
+		print "\n-------------------------------\n";
+		$Text::Wrap::debug = 1;
+		wrap('   ', ' ', $oi);
+		exit(1);
+	} else {
+		print "not ok $tn\n";
+	}
+	$tn++;
+
+}
+
+@st = @tests;
+while(@st) {
+	my $in = shift(@st);
+	my $out = shift(@st);
+
+	$in =~ s/^TEST(\d+)?\n//;
+
+	my @in = split("\n", $in, -1);
+	@in = ((map { "$_\n" } @in[0..$#in-1]), $in[-1]);
+	
+	my $back = wrap('   ', ' ', @in);
+
+	if ($back eq $out) {
+		print "ok $tn\n";
+	} elsif ($rerun) {
+		my $oi = $in;
+		foreach ($in, $back, $out) {
+			s/\t/^I\t/gs;
+			s/\n/\$\n/gs;
+		}
+		print "------------ input2 ------------\n";
+		print $in;
+		print "\n------------ output2 -----------\n";
+		print $back;
+		print "\n------------ expected2 ---------\n";
+		print $out;
+		print "\n-------------------------------\n";
+		$Text::Wrap::debug = 1;
+		wrap('   ', ' ', $oi);
+		exit(1);
+	} else {
+		print "not ok $tn\n";
+	}
+	$tn++;
+}
+
+$Text::Wrap::huge = 'overflow';
+
+my $tw = 'This_is_a_word_that_is_too_long_to_wrap_we_want_to_make_sure_that_the_program_does_not_crash_and_burn';
+my $w = wrap('zzz','yyy',$tw);
+print (($w eq "zzz$tw") ? "ok $tn\n" : "not ok $tn");
+$tn++;
+
diff --git a/lib/Tie/Array/push.t b/lib/Tie/Array/push.t
new file mode 100755
index 0000000000..b19aa0d0e8
--- /dev/null
+++ b/lib/Tie/Array/push.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+{
+ package Basic;
+ use Tie::Array;
+ @ISA = qw(Tie::Array);
+
+ sub TIEARRAY  { return bless [], shift }
+ sub FETCH     { $_[0]->[$_[1]] }
+ sub STORE     { $_[0]->[$_[1]] = $_[2] }
+ sub FETCHSIZE { scalar(@{$_[0]}) }
+ sub STORESIZE { $#{$_[0]} = $_[1]-1 }
+}
+
+tie @x,Basic;
+tie @get,Basic;
+tie @got,Basic;
+tie @tests,Basic;
+require "op/push.t"
diff --git a/lib/Tie/Array/splice.t b/lib/Tie/Array/splice.t
new file mode 100644
index 0000000000..d7ea6cc1dc
--- /dev/null
+++ b/lib/Tie/Array/splice.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+# bug id 20001020.002
+# -dlc 20001021
+
+use Tie::Array;
+tie @a,Tie::StdArray;
+undef *Tie::StdArray::SPLICE;
+require "op/splice.t"
+
+# Pre-fix, this failed tests 6-9
diff --git a/lib/Tie/Array/std.t b/lib/Tie/Array/std.t
new file mode 100755
index 0000000000..c4ae07102e
--- /dev/null
+++ b/lib/Tie/Array/std.t
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+use Tie::Array;
+tie @foo,Tie::StdArray;
+tie @ary,Tie::StdArray;
+tie @bar,Tie::StdArray;
+require "op/array.t"
diff --git a/lib/Tie/Array/stdpush.t b/lib/Tie/Array/stdpush.t
new file mode 100755
index 0000000000..31af30c32c
--- /dev/null
+++ b/lib/Tie/Array/stdpush.t
@@ -0,0 +1,11 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+use Tie::Array;
+tie @x,Tie::StdArray;
+require "op/push.t"
diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t
new file mode 100755
index 0000000000..f03f5d92f6
--- /dev/null
+++ b/lib/Tie/Handle/stdhandle.t
@@ -0,0 +1,47 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Handle;
+tie *tst,Tie::StdHandle;
+
+$f = 'tst';
+
+print "1..13\n";
+
+# my $file tests
+
+unlink("afile.new") if -f "afile";
+print "$!\nnot " unless open($f,"+>afile") && open($f, "+<", "afile");
+print "ok 1\n";
+print "$!\nnot " unless binmode($f);
+print "ok 2\n";
+print "not " unless -f "afile";
+print "ok 3\n";
+print "not " unless print $f "SomeData\n";
+print "ok 4\n";
+print "not " unless tell($f) == 9;
+print "ok 5\n";
+print "not " unless printf $f "Some %d value\n",1234;
+print "ok 6\n";
+print "not " unless seek($f,0,0);
+print "ok 7\n";
+$b = <$f>;
+print "not " unless $b eq "SomeData\n";
+print "ok 8\n";
+print "not " if eof($f);
+print "ok 9\n";
+read($f,($b=''),4);
+print "'$b' not " unless $b eq 'Some';
+print "ok 10\n";
+print "not " unless getc($f) eq ' ';
+print "ok 11\n";
+$b = <$f>;
+print "not " unless eof($f);
+print "ok 12\n";
+print "not " unless close($f);
+print "ok 13\n";
+unlink("afile");
diff --git a/lib/Tie/RefHash.t b/lib/Tie/RefHash.t
new file mode 100644
index 0000000000..d80b2e10fc
--- /dev/null
+++ b/lib/Tie/RefHash.t
@@ -0,0 +1,305 @@
+#!/usr/bin/perl -w
+# 
+# Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
+# 
+# The testing is in two parts: first, run lots of tests on both a tied
+# hash and an ordinary un-tied hash, and check they give the same
+# answer.  Then there are tests for those cases where the tied hashes
+# should behave differently to normal hashes, that is, when using
+# references as keys.
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+use strict;
+use Tie::RefHash;
+use Data::Dumper;
+my $numtests = 34;
+my $currtest = 1;
+print "1..$numtests\n";
+
+my $ref = []; my $ref1 = [];
+
+# Test standard hash functionality, by performing the same operations
+# on a tied hash and on a normal hash, and checking that the results
+# are the same.  This does of course assume that Perl hashes are not
+# buggy :-)
+# 
+my @tests = standard_hash_tests();
+
+my @ordinary_results = runtests(\@tests, undef);
+foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
+    my @tied_results = runtests(\@tests, $class);
+    my $all_ok = 1;
+
+    die if @ordinary_results != @tied_results;
+    foreach my $i (0 .. $#ordinary_results) {
+        my ($or, $ow, $oe) = @{$ordinary_results[$i]};
+        my ($tr, $tw, $te) = @{$tied_results[$i]};
+        
+        my $ok = 1;
+        local $^W = 0;
+        $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
+        $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
+        $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
+        
+        if (not $ok) {
+            print STDERR
+              "failed for $class: $tests[$i]\n",
+              "ordinary hash gave:\n",
+              defined $or ? "\tresult:    $or\n" : "\tundef result\n",
+              defined $ow ? "\twarning:   $ow\n" : "\tno warning\n",
+              defined $oe ? "\texception: $oe\n" : "\tno exception\n",
+              "tied $class hash gave:\n",
+              defined $tr ? "\tresult:    $tr\n" : "\tundef result\n",
+              defined $tw ? "\twarning:   $tw\n" : "\tno warning\n",
+              defined $te ? "\texception: $te\n" : "\tno exception\n",
+              "\n";
+            $all_ok = 0;
+        }
+    }
+    test($all_ok);
+}
+
+# Now test Tie::RefHash's special powers
+my (%h, $h);
+$h = eval { tie %h, 'Tie::RefHash' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash/);
+$h{$ref} = 'cholet';
+test($h{$ref} eq 'cholet');
+test(exists $h{$ref});
+test((keys %h) == 1);
+test(ref((keys %h)[0]) eq 'ARRAY');
+test((keys %h)[0] eq $ref);
+test((values %h) == 1);
+test((values %h)[0] eq 'cholet');
+my $count = 0;
+while (my ($k, $v) = each %h) {
+    if ($count++ == 0) {
+        test(ref($k) eq 'ARRAY');
+        test($k eq $ref);
+    }
+}
+test($count == 1);
+delete $h{$ref};
+test(not defined $h{$ref});
+test(not exists($h{$ref}));
+test((keys %h) == 0);
+test((values %h) == 0);
+undef $h;
+untie %h;
+
+# And now Tie::RefHash::Nestable's differences from Tie::RefHash.
+$h = eval { tie %h, 'Tie::RefHash::Nestable' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash::Nestable');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash::Nestable/);
+$h{$ref}->{$ref1} = 'bungo';
+test($h{$ref}->{$ref1} eq 'bungo');
+
+# Test that the nested hash is also tied (for current implementation)
+test(defined(tied(%{$h{$ref}}))
+     and tied(%{$h{$ref}}) =~ /^Tie::RefHash::Nestable=/ );
+
+test((keys %h) == 1);
+test((keys %h)[0] eq $ref);
+test((keys %{$h{$ref}}) == 1);
+test((keys %{$h{$ref}})[0] eq $ref1);
+
+
+die "expected to run $numtests tests, but ran ", $currtest - 1
+  if $currtest - 1 != $numtests;
+
+@tests = ();
+undef $ref;
+undef $ref1;
+
+exit();
+
+
+# Print 'ok X' if true, 'not ok X' if false
+# Uses global $currtest.
+# 
+sub test {
+    my $t = shift;
+    print 'not ' if not $t;
+    print 'ok ', $currtest++, "\n";
+}
+
+
+# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
+sub dumped {
+    my $s = shift;
+    my $d = Dumper($s);
+    $d =~ s/^\$VAR1 =\s*//;
+    $d =~ s/;$//;
+    chomp $d;
+    return $d;
+}
+
+# Crudely dump a hash into a canonical string representation (because
+# hash keys can appear in any order, Data::Dumper may give different
+# strings for the same hash).
+# 
+sub dumph {
+    my $h = shift;
+    my $r = '';
+    foreach (sort keys %$h) {
+        $r = dumped($_) . ' => ' . dumped($h->{$_}) . "\n";
+    }
+    return $r;
+}
+
+# Run the tests and give results.
+# 
+# Parameters: reference to list of tests to run
+#             name of class to use for tied hash, or undef if not tied
+# 
+# Returns: list of [R, W, E] tuples, one for each test.
+# R is the return value from running the test, W any warnings it gave,
+# and E any exception raised with 'die'.  E and W will be tidied up a
+# little to remove irrelevant details like line numbers :-)
+# 
+# Will also run a few of its own 'ok N' tests.
+# 
+sub runtests {
+    my ($tests, $class) = @_;
+    my @r;
+
+    my (%h, $h);
+    if (defined $class) {
+        $h = eval { tie %h, $class };
+        warn $@ if $@;
+        test(not $@);
+        test(ref($h) eq $class);
+        test(defined(tied(%h)) and tied(%h) =~ /^\Q$class\E/);
+    }
+
+    foreach (@$tests) {
+        my ($result, $warning, $exception);
+        local $SIG{__WARN__} = sub { $warning .= $_[0] };
+        $result = scalar(eval $_);
+        if ($@)
+         {
+          die "$@:$_" unless defined $class;
+          $exception = $@;
+         }
+
+        foreach ($warning, $exception) {
+            next if not defined;
+            s/ at .+ line \d+\.$//mg;
+            s/ at .+ line \d+, at .*//mg;
+            s/ at .+ line \d+, near .*//mg;
+        }
+
+        my (@warnings, %seen);
+        foreach (split /\n/, $warning) {
+            push @warnings, $_ unless $seen{$_}++;
+        }
+        $warning = join("\n", @warnings);
+
+        push @r, [ $result, $warning, $exception ];
+    }
+
+    return @r;
+}
+
+
+# Things that should work just the same for an ordinary hash and a
+# Tie::RefHash.
+# 
+# Each test is a code string to be eval'd, it should do something with
+# %h and give a scalar return value.  The global $ref and $ref1 may
+# also be used.
+# 
+# One thing we don't test is that the ordering from 'keys', 'values'
+# and 'each' is the same.  You can't reasonably expect that.
+# 
+sub standard_hash_tests {
+    my @r;
+
+    # Library of standard tests on keys, values and each
+    my $STD_TESTS = <<'END'
+    join $;, sort keys %h;
+    join $;, sort values %h;
+    { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
+    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
+END
+  ;
+    
+    # Tests on the existence of the element 'foo'
+    my $FOO_TESTS = <<'END'
+    defined $h{foo};
+    exists $h{foo};
+    $h{foo};    
+END
+  ;
+
+    # Test storing and deleting 'foo'
+    push @r, split /\n/, <<"END"
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = undef;
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = 'hello';
+    $STD_TESTS;
+    $FOO_TESTS;
+    delete  \$h{foo};
+    $STD_TESTS;
+    $FOO_TESTS;
+END
+  ;
+
+    # Test storing and removing under ordinary keys
+    my @things = ('boink', 0, 1, '', undef);
+    foreach my $key (map { dumped($_) } @things) {
+        foreach my $value ((map { dumped($_) } @things), '$ref') {
+            push @r, split /\n/, <<"END"
+            \$h{$key} = $value;
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+            delete \$h{$key};
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+END
+  ;
+        }
+    }
+    
+    # Test hash slices
+    my @slicetests;
+    @slicetests = split /\n/, <<'END'
+    @h{'b'} = ();
+    @h{'c'} = ('d');
+    @h{'e'} = ('f', 'g');
+    @h{'h', 'i'} = ();
+    @h{'j', 'k'} = ('l');
+    @h{'m', 'n'} = ('o', 'p');
+    @h{'q', 'r'} = ('s', 't', 'u');
+END
+  ;
+    my @aaa = @slicetests;
+    foreach (@slicetests) {
+        push @r, $_;
+        push @r, split(/\n/, $STD_TESTS);
+    }
+
+    # Test CLEAR
+    push @r, '%h = ();', split(/\n/, $STD_TESTS);
+
+    return @r;
+}
+
diff --git a/lib/Tie/SubstrHash.t b/lib/Tie/SubstrHash.t
new file mode 100644
index 0000000000..8256db7b58
--- /dev/null
+++ b/lib/Tie/SubstrHash.t
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+print "1..20\n";
+
+use strict;
+
+require Tie::SubstrHash;
+
+my %a;
+
+tie %a, 'Tie::SubstrHash', 3, 3, 3;
+
+$a{abc} = 123;
+$a{bcd} = 234;
+
+print "not " unless $a{abc} == 123;
+print "ok 1\n";
+
+print "not " unless keys %a == 2;
+print "ok 2\n";
+
+delete $a{abc};
+
+print "not " unless $a{bcd} == 234;
+print "ok 3\n";
+
+print "not " unless (values %a)[0] == 234;
+print "ok 4\n";
+
+eval { $a{abcd} = 123 };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 5\n";
+
+eval { $a{abc} = 1234 };
+print "not " unless $@ =~ /Value "1234" is not 3 characters long/;
+print "ok 6\n";
+
+eval { $a = $a{abcd}; $a++  };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 7\n";
+
+@a{qw(abc cde)} = qw(123 345); 
+
+print "not " unless $a{cde} == 345;
+print "ok 8\n";
+
+eval { $a{def} = 456 };
+print "not " unless $@ =~ /Table is full \(3 elements\)/;
+print "ok 9\n";
+
+%a = ();
+
+print "not " unless keys %a == 0;
+print "ok 10\n";
+
+# Tests 11..16 by Linc Madison.
+
+my $hashsize = 119;                # arbitrary values from my data
+my %test;
+tie %test, "Tie::SubstrHash", 13, 86, $hashsize;
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;           # fix to uniform 6-digit numbers
+        my $key2 = "abcdefg$key1";
+        $test{$key2} = ("abcdefgh" x 10) . "$key1";
+}
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;
+        my $key2 = "abcdefg$key1";
+	unless ($test{$key2}) {
+		print "not ";
+		last;
+	}
+}
+print "ok 11\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1) == 2;
+print "ok 12\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(2) == 2;
+print "ok 13\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(5.5) == 7;
+print "ok 14\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13) == 13;
+print "ok 15\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13.000001) == 17;
+print "ok 16\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(114) == 127;
+print "ok 17\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1000) == 1009;
+print "ok 18\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1024) == 1031;
+print "ok 19\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(10000) == 10007;
+print "ok 20\n";
+
diff --git a/lib/Time/Local.t b/lib/Time/Local.t
new file mode 100755
index 0000000000..100e0768aa
--- /dev/null
+++ b/lib/Time/Local.t
@@ -0,0 +1,90 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Time::Local;
+
+# Set up time values to test
+@time =
+  (
+   #year,mon,day,hour,min,sec 
+   [1970,  1,  2, 00, 00, 00],
+   [1980,  2, 28, 12, 00, 00],
+   [1980,  2, 29, 12, 00, 00],
+   [1999, 12, 31, 23, 59, 59],
+   [2000,  1,  1, 00, 00, 00],
+   [2010, 10, 12, 14, 13, 12],
+  );
+
+# use vmsish 'time' makes for oddness around the Unix epoch
+if ($^O eq 'VMS') { $time[0][2]++ }
+
+print "1..", @time * 2 + 5, "\n";
+
+$count = 1;
+for (@time) {
+    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    $year -= 1900;
+    $mon --;
+    my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+    # print scalar(localtime($time)), "\n";
+    my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+    if ($s == $sec &&
+	$m == $min &&
+	$h == $hour &&
+	$D == $mday &&
+	$M == $mon &&
+	$Y == $year
+       ) {
+	print "ok $count\n";
+    } else {
+	print "not ok $count\n";
+    }
+    $count++;
+
+    # Test gmtime function
+    $time = timegm($sec,$min,$hour,$mday,$mon,$year);
+    ($s,$m,$h,$D,$M,$Y) = gmtime($time);
+
+    if ($s == $sec &&
+	$m == $min &&
+	$h == $hour &&
+	$D == $mday &&
+	$M == $mon &&
+	$Y == $year
+       ) {
+	print "ok $count\n";
+    } else {
+	print "not ok $count\n";
+    }
+    $count++;
+}
+
+#print "Testing that the differences between a few dates makes sence...\n";
+
+timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 
+  or print "not ";
+print "ok ", $count++, "\n";
+
+# Diff beween Jan 1, 1970 and Mar 1, 1970 = (31 + 28 = 59 days)
+timegm(0,0,0, 1, 2, 70) - timegm(0,0,0, 1, 0, 70) == 59 * 24 * 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+
+#print "Testing timelocal.pl module too...\n";
+package test;
+require 'timelocal.pl';
+timegm(0,0,0,1,0,70) == main::timegm(0,0,0,1,0,70) or print "not ";
+print "ok ", $main::count++, "\n";
+
+timelocal(1,2,3,4,5,78) == main::timelocal(1,2,3,4,5,78) or print "not ";
+print "ok ", $main::count++, "\n";
diff --git a/lib/Time/gmtime.t b/lib/Time/gmtime.t
new file mode 100644
index 0000000000..853ec3b6e3
--- /dev/null
+++ b/lib/Time/gmtime.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasgm;
+    eval { my $n = gmtime 0 };
+    $hasgm = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasgm) { print "1..0 # Skip: no gmtime\n"; exit 0 }
+}
+
+BEGIN {
+    our @gmtime = gmtime 0; # This is the function gmtime.
+    unless (@gmtime) { print "1..0 # Skip: gmtime failed\n"; exit 0 }
+}
+
+print "1..10\n";
+
+use Time::gmtime;
+
+print "ok 1\n";
+
+my $gmtime = gmtime 0 ; # This is the OO gmtime.
+
+print "not " unless $gmtime->sec   == $gmtime[0];
+print "ok 2\n";
+
+print "not " unless $gmtime->min   == $gmtime[1];
+print "ok 3\n";
+
+print "not " unless $gmtime->hour  == $gmtime[2];
+print "ok 4\n";
+
+print "not " unless $gmtime->mday  == $gmtime[3];
+print "ok 5\n";
+
+print "not " unless $gmtime->mon   == $gmtime[4];
+print "ok 6\n";
+
+print "not " unless $gmtime->year  == $gmtime[5];
+print "ok 7\n";
+
+print "not " unless $gmtime->wday  == $gmtime[6];
+print "ok 8\n";
+
+print "not " unless $gmtime->yday  == $gmtime[7];
+print "ok 9\n";
+
+print "not " unless $gmtime->isdst == $gmtime[8];
+print "ok 10\n";
+
+
+
+
diff --git a/lib/Time/localtime.t b/lib/Time/localtime.t
new file mode 100644
index 0000000000..357615c780
--- /dev/null
+++ b/lib/Time/localtime.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haslocal;
+    eval { my $n = localtime 0 };
+    $haslocal = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haslocal) { print "1..0 # Skip: no localtime\n"; exit 0 }
+}
+
+BEGIN {
+    our @localtime = localtime 0; # This is the function localtime.
+    unless (@localtime) { print "1..0 # Skip: localtime failed\n"; exit 0 }
+}
+
+print "1..10\n";
+
+use Time::localtime;
+
+print "ok 1\n";
+
+my $localtime = localtime 0 ; # This is the OO localtime.
+
+print "not " unless $localtime->sec   == $localtime[0];
+print "ok 2\n";
+
+print "not " unless $localtime->min   == $localtime[1];
+print "ok 3\n";
+
+print "not " unless $localtime->hour  == $localtime[2];
+print "ok 4\n";
+
+print "not " unless $localtime->mday  == $localtime[3];
+print "ok 5\n";
+
+print "not " unless $localtime->mon   == $localtime[4];
+print "ok 6\n";
+
+print "not " unless $localtime->year  == $localtime[5];
+print "ok 7\n";
+
+print "not " unless $localtime->wday  == $localtime[6];
+print "ok 8\n";
+
+print "not " unless $localtime->yday  == $localtime[7];
+print "ok 9\n";
+
+print "not " unless $localtime->isdst == $localtime[8];
+print "ok 10\n";
+
+
+
+
diff --git a/lib/User/grent.t b/lib/User/grent.t
new file mode 100644
index 0000000000..760b814d54
--- /dev/null
+++ b/lib/User/grent.t
@@ -0,0 +1,44 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $hasgr;
+    eval { my @n = getgrgid 0 };
+    $hasgr = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($hasgr) { print "1..0 # Skip: no getgrgid\n"; exit 0 }
+    use Config;
+    $hasgr = 0 unless $Config{'i_grp'} eq 'define';
+    unless ($hasgr) { print "1..0 # Skip: no grp.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @grent = getgrgid 0; # This is the function getgrgid.
+    unless (@grent) { print "1..0 # Skip: no gid 0\n"; exit 0 }
+}
+
+print "1..5\n";
+
+use User::grent;
+
+print "ok 1\n";
+
+my $grent = getgrgid 0; # This is the OO getgrgid.
+
+print "not " unless $grent->gid    == 0;
+print "ok 2\n";
+
+print "not " unless $grent->name   == $grent[0];
+print "ok 3\n";
+
+print "not " unless $grent->passwd eq $grent[1];
+print "ok 4\n";
+
+print "not " unless $grent->gid    == $grent[2];
+print "ok 5\n";
+
+# Testing pretty much anything else is unportable.
+
diff --git a/lib/User/pwent.t b/lib/User/pwent.t
new file mode 100644
index 0000000000..e274265bd1
--- /dev/null
+++ b/lib/User/pwent.t
@@ -0,0 +1,63 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+    our $haspw;
+    eval { my @n = getpwuid 0 };
+    $haspw = 1 unless $@ && $@ =~ /unimplemented/;
+    unless ($haspw) { print "1..0 # Skip: no getpwuid\n"; exit 0 }
+    use Config;
+    $haspw = 0 unless $Config{'i_pwd'} eq 'define';
+    unless ($haspw) { print "1..0 # Skip: no pwd.h\n"; exit 0 }
+}
+
+BEGIN {
+    our @pwent = getpwuid 0; # This is the function getpwuid.
+    unless (@pwent) { print "1..0 # Skip: no uid 0\n"; exit 0 }
+}
+
+print "1..9\n";
+
+use User::pwent;
+
+print "ok 1\n";
+
+my $pwent = getpwuid 0; # This is the OO getpwuid.
+
+print "not " unless $pwent->uid    == 0;
+print "ok 2\n";
+
+print "not " unless $pwent->name   == $pwent[0];
+print "ok 3\n";
+
+print "not " unless $pwent->passwd eq $pwent[1];
+print "ok 4\n";
+
+print "not " unless $pwent->uid    == $pwent[2];
+print "ok 5\n";
+
+print "not " unless $pwent->gid    == $pwent[3];
+print "ok 6\n";
+
+# The quota and comment fields are unportable.
+
+print "not " unless $pwent->gecos  eq $pwent[6];
+print "ok 7\n";
+
+print "not " unless $pwent->dir    eq $pwent[7];
+print "ok 8\n";
+
+print "not " unless $pwent->shell  eq $pwent[8];
+print "ok 9\n";
+
+# The expire field is unportable.
+
+# Testing pretty much anything else is unportable:
+# there maybe more than one username with uid 0;
+# uid 0's home directory may be "/" or "/root' or something else,
+# and so on.
+
diff --git a/lib/autouse.t b/lib/autouse.t
new file mode 100644
index 0000000000..0a2d68003f
--- /dev/null
+++ b/lib/autouse.t
@@ -0,0 +1,57 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Test;
+BEGIN { plan tests => 10; }
+
+BEGIN {
+    require autouse;
+    eval {
+        "autouse"->import('List::Util' => 'List::Util::first(&@)');
+    };
+    ok( !$@ );
+
+    eval {
+        "autouse"->import('List::Util' => 'Foo::min');
+    };
+    ok( $@, qr/^autouse into different package attempted/ );
+
+    "autouse"->import('List::Util' => qw(max first(&@)));
+}
+
+my @a = (1,2,3,4,5.5);
+ok( max(@a), 5.5);
+
+
+# first() has a prototype of &@.  Make sure that's preserved.
+ok( (first { $_ > 3 } @a), 4);
+
+
+# Example from the docs.
+use autouse 'Carp' => qw(carp croak);
+
+{
+    my @warning;
+    local $SIG{__WARN__} = sub { push @warning, @_ };
+    carp "this carp was predeclared and autoused\n";
+    ok( scalar @warning, 1 );
+    ok( $warning[0], "this carp was predeclared and autoused\n" );
+
+    eval { croak "It is but a scratch!" };
+    ok( $@, qr/^It is but a scratch!/);
+}
+
+
+# Test that autouse's lazy module loading works.  We assume that nothing
+# involved in this test uses Text::Soundex, which is pretty safe.
+use autouse 'Text::Soundex' => qw(soundex);
+
+my $mod_file = 'Text/Soundex.pm'; # just fine and portable for %INC
+ok( !exists $INC{$mod_file} );
+ok( soundex('Basset'), 'B230' );
+ok( exists $INC{$mod_file} );
+
diff --git a/lib/bigfloat.t b/lib/bigfloat.t
new file mode 100755
index 0000000000..8e0a0ef724
--- /dev/null
+++ b/lib/bigfloat.t
@@ -0,0 +1,408 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigfloat.pl";
+
+$test = 0;
+$| = 1;
+print "1..355\n";
+while (<DATA>) {
+	chop;
+	if (/^&/) {
+		$f = $_;
+	} elsif (/^\$.*/) {
+		eval "$_;";
+	} else {
+		++$test;
+		@args = split(/:/,$_,99);
+		$ans = pop(@args);
+		$try = "$f('" . join("','", @args) . "');";
+		if (($ans1 = eval($try)) eq $ans) {
+			print "ok $test\n";
+		} else {
+			print "not ok $test\n";
+			print "# '$try' expected: '$ans' got: '$ans1'\n";
+		}
+	}
+} 
+__END__
+&fnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0E+0
++0:+0E+0
++00:+0E+0
++0 0 0:+0E+0
+000000  0000000   00000:+0E+0
+-0:+0E+0
+-0000:+0E+0
++1:+1E+0
++01:+1E+0
++001:+1E+0
++00000100000:+1E+5
+123456789:+123456789E+0
+-1:-1E+0
+-01:-1E+0
+-001:-1E+0
+-123456789:-123456789E+0
+-00000100000:-1E+5
+123.456a:NaN
+123.456:+123456E-3
+0.01:+1E-2
+.002:+2E-3
+-0.0003:-3E-4
+-.0000000004:-4E-10
+123456E2:+123456E+2
+123456E-2:+123456E-2
+-123456E2:-123456E+2
+-123456E-2:-123456E-2
+1e1:+1E+1
+2e-11:+2E-11
+-3e111:-3E+111
+-4e-1111:-4E-1111
+&fneg
+abd:NaN
++0:+0E+0
++1:-1E+0
+-1:+1E+0
++123456789:-123456789E+0
+-123456789:+123456789E+0
++123.456789:-123456789E-6
+-123456.789:+123456789E-3
+&fabs
+abc:NaN
++0:+0E+0
++1:+1E+0
+-1:+1E+0
++123456789:+123456789E+0
+-123456789:+123456789E+0
++123.456789:+123456789E-6
+-123456.789:+123456789E-3
+&fround
+$bigfloat::rnd_mode = 'trunc'
++10123456789:5:+10123E+6
+-10123456789:5:-10123E+6
++10123456789:9:+101234567E+2
+-10123456789:9:-101234567E+2
++101234500:6:+101234E+3
+-101234500:6:-101234E+3
+$bigfloat::rnd_mode = 'zero'
++20123456789:5:+20123E+6
+-20123456789:5:-20123E+6
++20123456789:9:+201234568E+2
+-20123456789:9:-201234568E+2
++201234500:6:+201234E+3
+-201234500:6:-201234E+3
+$bigfloat::rnd_mode = '+inf'
++30123456789:5:+30123E+6
+-30123456789:5:-30123E+6
++30123456789:9:+301234568E+2
+-30123456789:9:-301234568E+2
++301234500:6:+301235E+3
+-301234500:6:-301234E+3
+$bigfloat::rnd_mode = '-inf'
++40123456789:5:+40123E+6
+-40123456789:5:-40123E+6
++40123456789:9:+401234568E+2
+-40123456789:9:-401234568E+2
++401234500:6:+401234E+3
+-401234500:6:-401235E+3
+$bigfloat::rnd_mode = 'odd'
++50123456789:5:+50123E+6
+-50123456789:5:-50123E+6
++50123456789:9:+501234568E+2
+-50123456789:9:-501234568E+2
++501234500:6:+501235E+3
+-501234500:6:-501235E+3
+$bigfloat::rnd_mode = 'even'
++60123456789:5:+60123E+6
+-60123456789:5:-60123E+6
++60123456789:9:+601234568E+2
+-60123456789:9:-601234568E+2
++601234500:6:+601234E+3
+-601234500:6:-601234E+3
+&ffround
+$bigfloat::rnd_mode = 'trunc'
++1.23:-1:+12E-1
+-1.23:-1:-12E-1
++1.27:-1:+12E-1
+-1.27:-1:-12E-1
++1.25:-1:+12E-1
+-1.25:-1:-12E-1
++1.35:-1:+13E-1
+-1.35:-1:-13E-1
+-0.006:-1:+0E+0
+-0.006:-2:+0E+0
+$bigfloat::rnd_mode = 'zero'
++2.23:-1:+22E-1
+-2.23:-1:-22E-1
++2.27:-1:+23E-1
+-2.27:-1:-23E-1
++2.25:-1:+22E-1
+-2.25:-1:-22E-1
++2.35:-1:+23E-1
+-2.35:-1:-23E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '+inf'
++3.23:-1:+32E-1
+-3.23:-1:-32E-1
++3.27:-1:+33E-1
+-3.27:-1:-33E-1
++3.25:-1:+33E-1
+-3.25:-1:-32E-1
++3.35:-1:+34E-1
+-3.35:-1:-33E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '-inf'
++4.23:-1:+42E-1
+-4.23:-1:-42E-1
++4.27:-1:+43E-1
+-4.27:-1:-43E-1
++4.25:-1:+42E-1
+-4.25:-1:-43E-1
++4.35:-1:+43E-1
+-4.35:-1:-44E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'odd'
++5.23:-1:+52E-1
+-5.23:-1:-52E-1
++5.27:-1:+53E-1
+-5.27:-1:-53E-1
++5.25:-1:+53E-1
+-5.25:-1:-53E-1
++5.35:-1:+53E-1
+-5.35:-1:-53E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'even'
++6.23:-1:+62E-1
+-6.23:-1:-62E-1
++6.27:-1:+63E-1
+-6.27:-1:-63E-1
++6.25:-1:+62E-1
+-6.25:-1:-62E-1
++6.35:-1:+64E-1
+-6.35:-1:-64E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:+1E+0
++1:+1:+2E+0
+-1:+0:-1E+0
++0:-1:-1E+0
+-1:-1:-2E+0
+-1:+1:+0E+0
++1:-1:+0E+0
++9:+1:+1E+1
++99:+1:+1E+2
++999:+1:+1E+3
++9999:+1:+1E+4
++99999:+1:+1E+5
++999999:+1:+1E+6
++9999999:+1:+1E+7
++99999999:+1:+1E+8
++999999999:+1:+1E+9
++9999999999:+1:+1E+10
++99999999999:+1:+1E+11
++10:-1:+9E+0
++100:-1:+99E+0
++1000:-1:+999E+0
++10000:-1:+9999E+0
++100000:-1:+99999E+0
++1000000:-1:+999999E+0
++10000000:-1:+9999999E+0
++100000000:-1:+99999999E+0
++1000000000:-1:+999999999E+0
++10000000000:-1:+9999999999E+0
++123456789:+987654321:+111111111E+1
+-123456789:+987654321:+864197532E+0
+-123456789:-987654321:-111111111E+1
++123456789:-987654321:-864197532E+0
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:-1E+0
++1:+1:+0E+0
+-1:+0:-1E+0
++0:-1:+1E+0
+-1:-1:+0E+0
+-1:+1:-2E+0
++1:-1:+2E+0
++9:+1:+8E+0
++99:+1:+98E+0
++999:+1:+998E+0
++9999:+1:+9998E+0
++99999:+1:+99998E+0
++999999:+1:+999998E+0
++9999999:+1:+9999998E+0
++99999999:+1:+99999998E+0
++999999999:+1:+999999998E+0
++9999999999:+1:+9999999998E+0
++99999999999:+1:+99999999998E+0
++10:-1:+11E+0
++100:-1:+101E+0
++1000:-1:+1001E+0
++10000:-1:+10001E+0
++100000:-1:+100001E+0
++1000000:-1:+1000001E+0
++10000000:-1:+10000001E+0
++100000000:-1:+100000001E+0
++1000000000:-1:+1000000001E+0
++10000000000:-1:+10000000001E+0
++123456789:+987654321:-864197532E+0
+-123456789:+987654321:-111111111E+1
+-123456789:-987654321:+864197532E+0
++123456789:-987654321:+111111111E+1
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++0:+1:+0E+0
++1:+0:+0E+0
++0:-1:+0E+0
+-1:+0:+0E+0
++123456789123456789:+0:+0E+0
++0:+123456789123456789:+0E+0
+-1:-1:+1E+0
+-1:+1:-1E+0
++1:-1:-1E+0
++1:+1:+1E+0
++2:+3:+6E+0
+-2:+3:-6E+0
++2:-3:-6E+0
+-2:-3:+6E+0
++111:+111:+12321E+0
++10101:+10101:+102030201E+0
++1001001:+1001001:+1002003002001E+0
++100010001:+100010001:+10002000300020001E+0
++10000100001:+10000100001:+100002000030000200001E+0
++11111111111:+9:+99999999999E+0
++22222222222:+9:+199999999998E+0
++33333333333:+9:+299999999997E+0
++44444444444:+9:+399999999996E+0
++55555555555:+9:+499999999995E+0
++66666666666:+9:+599999999994E+0
++77777777777:+9:+699999999993E+0
++88888888888:+9:+799999999992E+0
++99999999999:+9:+899999999991E+0
+&fdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0E+0
++1:+0:NaN
++0:-1:+0E+0
+-1:+0:NaN
++1:+1:+1E+0
+-1:-1:+1E+0
++1:-1:-1E+0
+-1:+1:-1E+0
++1:+2:+5E-1
++2:+1:+2E+0
++10:+5:+2E+0
++100:+4:+25E+0
++1000:+8:+125E+0
++10000:+16:+625E+0
++10000:-16:-625E+0
++999999999999:+9:+111111111111E+0
++999999999999:+99:+10101010101E+0
++999999999999:+999:+1001001001E+0
++999999999999:+9999:+100010001E+0
++999999999999999:+99999:+10000100001E+0
++1000000000:+9:+1111111111111111111111111111111111111111E-31
++2000000000:+9:+2222222222222222222222222222222222222222E-31
++3000000000:+9:+3333333333333333333333333333333333333333E-31
++4000000000:+9:+4444444444444444444444444444444444444444E-31
++5000000000:+9:+5555555555555555555555555555555555555556E-31
++6000000000:+9:+6666666666666666666666666666666666666667E-31
++7000000000:+9:+7777777777777777777777777777777777777778E-31
++8000000000:+9:+8888888888888888888888888888888888888889E-31
++9000000000:+9:+1E+9
++35500000:+113:+3141592920353982300884955752212389380531E-34
++71000000:+226:+3141592920353982300884955752212389380531E-34
++106500000:+339:+3141592920353982300884955752212389380531E-34
++1000000000:+3:+3333333333333333333333333333333333333333E-31
+$bigfloat::div_scale = 20
++1000000000:+9:+11111111111111111111E-11
++2000000000:+9:+22222222222222222222E-11
++3000000000:+9:+33333333333333333333E-11
++4000000000:+9:+44444444444444444444E-11
++5000000000:+9:+55555555555555555556E-11
++6000000000:+9:+66666666666666666667E-11
++7000000000:+9:+77777777777777777778E-11
++8000000000:+9:+88888888888888888889E-11
++9000000000:+9:+1E+9
++35500000:+113:+314159292035398230088E-15
++71000000:+226:+314159292035398230088E-15
++106500000:+339:+31415929203539823009E-14
++1000000000:+3:+33333333333333333333E-11
+$bigfloat::div_scale = 40
+&fsqrt
++0:+0E+0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.456:NaN
++1:+1E+0
++1.44:+12E-1
++2:+141421356237309504880168872420969807857E-38
++4:+2E+0
++16:+4E+0
++100:+1E+1
++123.456:+1111107555549866648462149404118219234119E-38
++15241.383936:+123456E-3
diff --git a/lib/bigint.t b/lib/bigint.t
new file mode 100755
index 0000000000..034c5c6457
--- /dev/null
+++ b/lib/bigint.t
@@ -0,0 +1,282 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+	chop;
+	if (/^&/) {
+		$f = $_;
+	} else {
+		++$test;
+		@args = split(/:/,$_,99);
+		$ans = pop(@args);
+		$try = "$f('" . join("','", @args) . "');";
+		if (($ans1 = eval($try)) eq $ans) {
+			print "ok $test\n";
+		} else {
+			print "not ok $test\n";
+			print "# '$try' expected: '$ans' got: '$ans1'\n";
+		}
+	}
+} 
+__END__
+&bnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0
++0:+0
++00:+0
++0 0 0:+0
+000000  0000000   00000:+0
+-0:+0
+-0000:+0
++1:+1
++01:+1
++001:+1
++00000100000:+100000
+123456789:+123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+&bneg
+abd:NaN
++0:+0
++1:-1
+-1:+1
++123456789:-123456789
+-123456789:+123456789
+&babs
+abc:NaN
++0:+0
++1:+1
+-1:+1
++123456789:+123456789
+-123456789:+123456789
+&bcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&badd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:+1
++1:+1:+2
+-1:+0:-1
++0:-1:-1
+-1:-1:-2
+-1:+1:+0
++1:-1:+0
++9:+1:+10
++99:+1:+100
++999:+1:+1000
++9999:+1:+10000
++99999:+1:+100000
++999999:+1:+1000000
++9999999:+1:+10000000
++99999999:+1:+100000000
++999999999:+1:+1000000000
++9999999999:+1:+10000000000
++99999999999:+1:+100000000000
++10:-1:+9
++100:-1:+99
++1000:-1:+999
++10000:-1:+9999
++100000:-1:+99999
++1000000:-1:+999999
++10000000:-1:+9999999
++100000000:-1:+99999999
++1000000000:-1:+999999999
++10000000000:-1:+9999999999
++123456789:+987654321:+1111111110
+-123456789:+987654321:+864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++1:+0:+1
++0:+1:-1
++1:+1:+0
+-1:+0:-1
++0:-1:+1
+-1:-1:+0
+-1:+1:-2
++1:-1:+2
++9:+1:+8
++99:+1:+98
++999:+1:+998
++9999:+1:+9998
++99999:+1:+99998
++999999:+1:+999998
++9999999:+1:+9999998
++99999999:+1:+99999998
++999999999:+1:+999999998
++9999999999:+1:+9999999998
++99999999999:+1:+99999999998
++10:-1:+11
++100:-1:+101
++1000:-1:+1001
++10000:-1:+10001
++100000:-1:+100001
++1000000:-1:+1000001
++10000000:-1:+10000001
++100000000:-1:+100000001
++1000000000:-1:+1000000001
++10000000000:-1:+10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:+864197532
++123456789:-987654321:+1111111110
+&bmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+0
++1:+0:+0
++0:-1:+0
+-1:+0:+0
++123456789123456789:+0:+0
++0:+123456789123456789:+0
+-1:-1:+1
+-1:+1:-1
++1:-1:-1
++1:+1:+1
++2:+3:+6
+-2:+3:-6
++2:-3:-6
+-2:-3:+6
++111:+111:+12321
++10101:+10101:+102030201
++1001001:+1001001:+1002003002001
++100010001:+100010001:+10002000300020001
++10000100001:+10000100001:+100002000030000200001
++11111111111:+9:+99999999999
++22222222222:+9:+199999999998
++33333333333:+9:+299999999997
++44444444444:+9:+399999999996
++55555555555:+9:+499999999995
++66666666666:+9:+599999999994
++77777777777:+9:+699999999993
++88888888888:+9:+799999999992
++99999999999:+9:+899999999991
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1
diff --git a/lib/charnames.t b/lib/charnames.t
new file mode 100644
index 0000000000..124dad0971
--- /dev/null
+++ b/lib/charnames.t
@@ -0,0 +1,131 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+    }
+}
+
+$| = 1;
+print "1..16\n";
+
+use charnames ':full';
+
+print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?";
+print "ok 1\n";
+
+{
+  use bytes;			# TEST -utf8 can switch utf8 on
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames ":full";
+"Here: \N{CYRILLIC SMALL LETTER BE}!";
+1
+EOE
+      or $@ !~ /above 0xFF/;
+  print "ok 2\n";
+  # print "# \$res=$res \$\@='$@'\n";
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames 'cyrillic';
+"Here: \N{Be}!";
+1
+EOE
+      or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
+  print "ok 3\n";
+}
+
+# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
+if (ord('A') == 65) { # as on ASCII or UTF-8 machines
+    $encoded_be = "\320\261";
+    $encoded_alpha = "\316\261";
+    $encoded_bet = "\327\221";
+    $encoded_deseng = "\360\220\221\215";
+}
+else { # EBCDIC where UTF-EBCDIC may be used (this may be 1047 specific since
+       # UTF-EBCDIC is codepage specific)
+    $encoded_be = "\270\102\130";
+    $encoded_alpha = "\264\130";
+    $encoded_bet = "\270\125\130";
+    $encoded_deseng = "\336\102\103\124";
+}
+
+sub to_bytes {
+    pack"a*", shift;
+}
+
+{
+  use charnames ':full';
+
+  print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
+  print "ok 4\n";
+
+  use charnames qw(cyrillic greek :short);
+
+  print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
+    eq "$encoded_be,$encoded_alpha,$encoded_bet";
+  print "ok 5\n";
+}
+
+{
+    use charnames ':full';
+    print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
+    print "ok 6\n";
+    print "not " unless length("\x{263a}") == 1;
+    print "ok 7\n";
+    print "not " unless length("\N{WHITE SMILING FACE}") == 1;
+    print "ok 8\n";
+    print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
+    print "ok 9\n";
+    print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
+    print "ok 10\n";
+    print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 11\n";
+    print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 12\n";
+}
+
+{
+   use charnames qw(:full);
+   use utf8;
+   
+    my $x = "\x{221b}";
+    my $named = "\N{CUBE ROOT}";
+
+    print "not " unless ord($x) == ord($named);
+    print "ok 13\n";
+}
+
+{
+   use charnames qw(:full);
+   use utf8;
+   print "not " unless "\x{100}\N{CENT SIGN}" eq "\x{100}"."\N{CENT SIGN}";
+   print "ok 14\n";
+}
+
+{
+  use charnames ':full';
+
+  print "not "
+      unless to_bytes("\N{DESERET SMALL LETTER ENG}") eq $encoded_deseng;
+  print "ok 15\n";
+}
+
+{
+  # 20001114.001	
+
+  no utf8; # so that the naked 8-bit character won't gripe under use utf8
+
+  if (ord("�") == 0xc4) { # Try to do this only on Latin-1.
+      use charnames ':full';
+      my $text = "\N{LATIN CAPITAL LETTER A WITH DIAERESIS}";
+      print "not " unless $text eq "\xc4" && ord($text) == 0xc4;
+      print "ok 16\n";
+  } else {
+      print "ok 16 # Skip: not Latin-1\n";
+  }
+}
+
diff --git a/lib/constant.t b/lib/constant.t
new file mode 100644
index 0000000000..f932976f60
--- /dev/null
+++ b/lib/constant.t
@@ -0,0 +1,251 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use warnings;
+use vars qw{ @warnings };
+BEGIN {				# ...and save 'em for later
+    $SIG{'__WARN__'} = sub { push @warnings, @_ }
+}
+END { print @warnings }
+
+######################### We start with some black magic to print on failure.
+
+BEGIN { $| = 1; print "1..82\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use constant 1.01;
+$loaded = 1;
+#print "# Version: $constant::VERSION\n";
+print "ok 1\n";
+
+######################### End of black magic.
+
+use strict;
+
+sub test ($$;$) {
+    my($num, $bool, $diag) = @_;
+    if ($bool) {
+	print "ok $num\n";
+	return;
+    }
+    print "not ok $num\n";
+    return unless defined $diag;
+    $diag =~ s/\Z\n?/\n/;			# unchomp
+    print map "# $num : $_", split m/^/m, $diag;
+}
+
+use constant PI		=> 4 * atan2 1, 1;
+
+test 2, substr(PI, 0, 7) eq '3.14159';
+test 3, defined PI;
+
+sub deg2rad { PI * $_[0] / 180 }
+
+my $ninety = deg2rad 90;
+
+test 4, $ninety > 1.5707;
+test 5, $ninety < 1.5708;
+
+use constant UNDEF1	=> undef;	# the right way
+use constant UNDEF2	=>	;	# the weird way
+use constant 'UNDEF3'		;	# the 'short' way
+use constant EMPTY	=> ( )  ;	# the right way for lists
+
+test 6, not defined UNDEF1;
+test 7, not defined UNDEF2;
+test 8, not defined UNDEF3;
+my @undef = UNDEF1;
+test 9, @undef == 1;
+test 10, not defined $undef[0];
+@undef = UNDEF2;
+test 11, @undef == 0;
+@undef = UNDEF3;
+test 12, @undef == 0;
+@undef = EMPTY;
+test 13, @undef == 0;
+
+use constant COUNTDOWN	=> scalar reverse 1, 2, 3, 4, 5;
+use constant COUNTLIST	=> reverse 1, 2, 3, 4, 5;
+use constant COUNTLAST	=> (COUNTLIST)[-1];
+
+test 14, COUNTDOWN eq '54321';
+my @cl = COUNTLIST;
+test 15, @cl == 5;
+test 16, COUNTDOWN eq join '', @cl;
+test 17, COUNTLAST == 1;
+test 18, (COUNTLIST)[1] == 4;
+
+use constant ABC	=> 'ABC';
+test 19, "abc${\( ABC )}abc" eq "abcABCabc";
+
+use constant DEF	=> 'D', 'E', chr ord 'F';
+test 20, "d e f @{[ DEF ]} d e f" eq "d e f D E F d e f";
+
+use constant SINGLE	=> "'";
+use constant DOUBLE	=> '"';
+use constant BACK	=> '\\';
+my $tt = BACK . SINGLE . DOUBLE ;
+test 21, $tt eq q(\\'");
+
+use constant MESS	=> q('"'\\"'"\\);
+test 22, MESS eq q('"'\\"'"\\);
+test 23, length(MESS) == 8;
+
+use constant TRAILING	=> '12 cats';
+{
+    no warnings 'numeric';
+    test 24, TRAILING == 12;
+}
+test 25, TRAILING eq '12 cats';
+
+use constant LEADING	=> " \t1234";
+test 26, LEADING == 1234;
+test 27, LEADING eq " \t1234";
+
+use constant ZERO1	=> 0;
+use constant ZERO2	=> 0.0;
+use constant ZERO3	=> '0.0';
+test 28, ZERO1 eq '0';
+test 29, ZERO2 eq '0';
+test 30, ZERO3 eq '0.0';
+
+{
+    package Other;
+    use constant PI	=> 3.141;
+}
+
+test 31, (PI > 3.1415 and PI < 3.1416);
+test 32, Other::PI == 3.141;
+
+use constant E2BIG => $! = 7;
+test 33, E2BIG == 7;
+# This is something like "Arg list too long", but the actual message
+# text may vary, so we can't test much better than this.
+test 34, length(E2BIG) > 6;
+test 35, index(E2BIG, " ") > 0;
+
+test 36, @warnings == 0, join "\n", "unexpected warning", @warnings;
+@warnings = ();		# just in case
+undef &PI;
+test 37, @warnings &&
+    ($warnings[0] =~ /Constant sub.* undefined/),
+    shift @warnings;
+
+test 38, @warnings == 0, "unexpected warning";
+test 39, 1;
+
+use constant CSCALAR	=> \"ok 40\n";
+use constant CHASH	=> { foo => "ok 41\n" };
+use constant CARRAY	=> [ undef, "ok 42\n" ];
+use constant CPHASH	=> [ { foo => 1 }, "ok 43\n" ];
+use constant CCODE	=> sub { "ok $_[0]\n" };
+
+print ${+CSCALAR};
+print CHASH->{foo};
+print CARRAY->[1];
+print CPHASH->{foo};
+eval q{ CPHASH->{bar} };
+test 44, scalar($@ =~ /^No such pseudo-hash field/);
+print CCODE->(45);
+eval q{ CCODE->{foo} };
+test 46, scalar($@ =~ /^Constant is not a HASH/);
+
+# Allow leading underscore
+use constant _PRIVATE => 47;
+test 47, _PRIVATE == 47;
+
+# Disallow doubled leading underscore
+eval q{
+    use constant __DISALLOWED => "Oops";
+};
+test 48, $@ =~ /begins with '__'/;
+
+# Check on declared() and %declared. This sub should be EXACTLY the
+# same as the one quoted in the docs!
+sub declared ($) {
+    use constant 1.01;              # don't omit this!
+    my $name = shift;
+    $name =~ s/^::/main::/;
+    my $pkg = caller;
+    my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
+    $constant::declared{$full_name};
+}
+
+test 49, declared 'PI';
+test 50, $constant::declared{'main::PI'};
+
+test 51, !declared 'PIE';
+test 52, !$constant::declared{'main::PIE'};
+
+{
+    package Other;
+    use constant IN_OTHER_PACK => 42;
+    ::test 53, ::declared 'IN_OTHER_PACK';
+    ::test 54, $constant::declared{'Other::IN_OTHER_PACK'};
+    ::test 55, ::declared 'main::PI';
+    ::test 56, $constant::declared{'main::PI'};
+}
+
+test 57, declared 'Other::IN_OTHER_PACK';
+test 58, $constant::declared{'Other::IN_OTHER_PACK'};
+
+@warnings = ();
+eval q{
+    no warnings;
+    use warnings 'constant';
+    use constant 'BEGIN' => 1 ;
+    use constant 'INIT' => 1 ;
+    use constant 'CHECK' => 1 ;
+    use constant 'END' => 1 ;
+    use constant 'DESTROY' => 1 ;
+    use constant 'AUTOLOAD' => 1 ;
+    use constant 'STDIN' => 1 ;
+    use constant 'STDOUT' => 1 ;
+    use constant 'STDERR' => 1 ;
+    use constant 'ARGV' => 1 ;
+    use constant 'ARGVOUT' => 1 ;
+    use constant 'ENV' => 1 ;
+    use constant 'INC' => 1 ;
+    use constant 'SIG' => 1 ;
+};
+
+test 59, @warnings == 15 ;
+test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/;
+shift @warnings; #Constant subroutine BEGIN redefined at
+test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/;
+test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/;
+test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/;
+test 64, (shift @warnings) =~ /^Constant name 'DESTROY' is a Perl keyword at/;
+test 65, (shift @warnings) =~ /^Constant name 'AUTOLOAD' is a Perl keyword at/;
+test 66, (shift @warnings) =~ /^Constant name 'STDIN' is forced into package main:: a/;
+test 67, (shift @warnings) =~ /^Constant name 'STDOUT' is forced into package main:: at/;
+test 68, (shift @warnings) =~ /^Constant name 'STDERR' is forced into package main:: at/;
+test 69, (shift @warnings) =~ /^Constant name 'ARGV' is forced into package main:: at/;
+test 70, (shift @warnings) =~ /^Constant name 'ARGVOUT' is forced into package main:: at/;
+test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:: at/;
+test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
+test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
+@warnings = ();
+
+
+use constant {
+	THREE  => 3,
+	FAMILY => [ qw( John Jane Sally ) ],
+	AGES   => { John => 33, Jane => 28, Sally => 3 },
+	RFAM   => [ [ qw( John Jane Sally ) ] ],
+	SPIT   => sub { shift },
+	PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
+};
+
+test 74, @{+FAMILY} == THREE;
+test 75, @{+FAMILY} == @{RFAM->[0]};
+test 76, FAMILY->[2] eq RFAM->[0]->[2];
+test 77, AGES->{FAMILY->[1]} == 28;
+test 78, PHFAM->{John} == AGES->{John};
+test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
+test 80, @{+PHFAM} == SPIT->(THREE+1);
+test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
+test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];
diff --git a/lib/diagnostics.t b/lib/diagnostics.t
new file mode 100644
index 0000000000..14014f6b68
--- /dev/null
+++ b/lib/diagnostics.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir '..' if -d '../pod' && -d '../t';
+    @INC = 'lib';
+}
+
+
+######################### 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 warnings;
+
+use vars qw($Test_Num $Total_tests);
+
+my $loaded;
+BEGIN { $| = 1; $Test_Num = 1 }
+END {print "not ok $Test_Num\n" unless $loaded;}
+print "1..$Total_tests\n";
+BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
+$loaded = 1;
+ok($loaded, 'compile');
+######################### End of black magic.
+
+sub ok {
+	my($test, $name) = shift;
+	print "not " unless $test;
+	print "ok $Test_Num";
+	print " - $name" if defined $name;
+	print "\n";
+	$Test_Num++;
+}
+
+
+# Change this to your # of ok() calls + 1
+BEGIN { $Total_tests = 1 }
diff --git a/lib/fields.t b/lib/fields.t
new file mode 100755
index 0000000000..b4b5cce4ca
--- /dev/null
+++ b/lib/fields.t
@@ -0,0 +1,197 @@
+#!./perl -w
+
+my $w;
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+           return;
+       }
+       print $_[0];
+   };
+}
+
+use strict;
+use warnings;
+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)+15, "\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 "not " 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 ,"\n";
+
diff --git a/lib/h2ph.t b/lib/h2ph.t
new file mode 100755
index 0000000000..7b339b3927
--- /dev/null
+++ b/lib/h2ph.t
@@ -0,0 +1,37 @@
+#!./perl
+
+# quickie tests to see if h2ph actually runs and does more or less what is
+# expected
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my $extracted_program = '../utils/h2ph'; # unix, nt, ...
+if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2ph.com'; }
+if (!(-e $extracted_program)) {
+    print "1..0 # Skip: $extracted_program was not built\n";
+    exit 0;
+}
+
+print "1..2\n";
+
+# quickly compare two text files
+sub txt_compare {
+    local ($/, $A, $B);
+    for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ }
+    $A cmp $B;
+}
+
+# does it run?
+$ok = system("$^X \"-I../lib\" $extracted_program -d. \"-Q\" lib/h2ph.h");
+print(($ok == 0 ? "" : "not "), "ok 1\n");
+    
+# does it work? well, does it do what we expect? :-)
+$ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
+print(($ok == 0 ? "" : "not "), "ok 2\n");
+    
+# cleanup - should this be in an END block?
+unlink("lib/h2ph.ph");
+unlink("_h2ph_pre.ph");
diff --git a/lib/locale.t b/lib/locale.t
new file mode 100644
index 0000000000..19fba597c5
--- /dev/null
+++ b/lib/locale.t
@@ -0,0 +1,839 @@
+#!./perl -wT
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    unshift @INC, '.';
+    require Config; import Config;
+    if (!$Config{d_setlocale} || $Config{ccflags} =~ /\bD?NO_LOCALE\b/) {
+	print "1..0\n";
+	exit;
+    }
+    $| = 1;
+}
+
+use strict;
+
+my $debug = 1;
+
+use Dumpvalue;
+
+my $dumper = Dumpvalue->new(
+                            tick => qq{"},
+                            quoteHighBit => 0,
+                            unctrl => "quote"
+                           );
+sub debug {
+  return unless $debug;
+  my($mess) = join "", @_;
+  chop $mess;
+  print $dumper->stringify($mess,1), "\n";
+}
+
+sub debugf {
+    printf @_ if $debug;
+}
+
+my $have_setlocale = 0;
+eval {
+    require POSIX;
+    import POSIX ':locale_h';
+    $have_setlocale++;
+};
+
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
+
+my $last = $have_setlocale ? &last : &last_without_setlocale;
+
+print "1..$last\n";
+
+use vars qw(&LC_ALL);
+
+$a = 'abc %';
+
+sub ok {
+    my ($n, $result) = @_;
+
+    print 'not ' unless ($result);
+    print "ok $n\n";
+}
+
+# First we'll do a lot of taint checking for locales.
+# This is the easiest to test, actually, as any locale,
+# even the default locale will taint under 'use locale'.
+
+sub is_tainted { # hello, camel two.
+    no warnings 'uninitialized' ;
+    my $dummy;
+    not eval { $dummy = join("", @_), kill 0; 1 }
+}
+
+sub check_taint ($$) {
+    ok $_[0], is_tainted($_[1]);
+}
+
+sub check_taint_not ($$) {
+    ok $_[0], not is_tainted($_[1]);
+}
+
+use locale;	# engage locale and therefore locale taint.
+
+check_taint_not   1, $a;
+
+check_taint       2, uc($a);
+check_taint       3, "\U$a";
+check_taint       4, ucfirst($a);
+check_taint       5, "\u$a";
+check_taint       6, lc($a);
+check_taint       7, "\L$a";
+check_taint       8, lcfirst($a);
+check_taint       9, "\l$a";
+
+check_taint_not  10, sprintf('%e', 123.456);
+check_taint_not  11, sprintf('%f', 123.456);
+check_taint_not  12, sprintf('%g', 123.456);
+check_taint_not  13, sprintf('%d', 123.456);
+check_taint_not  14, sprintf('%x', 123.456);
+
+$_ = $a;	# untaint $_
+
+$_ = uc($a);	# taint $_
+
+check_taint      15, $_;
+
+/(\w)/;	# taint $&, $`, $', $+, $1.
+check_taint      16, $&;
+check_taint      17, $`;
+check_taint      18, $';
+check_taint      19, $+;
+check_taint      20, $1;
+check_taint_not  21, $2;
+
+/(.)/;	# untaint $&, $`, $', $+, $1.
+check_taint_not  22, $&;
+check_taint_not  23, $`;
+check_taint_not  24, $';
+check_taint_not  25, $+;
+check_taint_not  26, $1;
+check_taint_not  27, $2;
+
+/(\W)/;	# taint $&, $`, $', $+, $1.
+check_taint      28, $&;
+check_taint      29, $`;
+check_taint      30, $';
+check_taint      31, $+;
+check_taint      32, $1;
+check_taint_not  33, $2;
+
+/(\s)/;	# taint $&, $`, $', $+, $1.
+check_taint      34, $&;
+check_taint      35, $`;
+check_taint      36, $';
+check_taint      37, $+;
+check_taint      38, $1;
+check_taint_not  39, $2;
+
+/(\S)/;	# taint $&, $`, $', $+, $1.
+check_taint      40, $&;
+check_taint      41, $`;
+check_taint      42, $';
+check_taint      43, $+;
+check_taint      44, $1;
+check_taint_not  45, $2;
+
+$_ = $a;	# untaint $_
+
+check_taint_not  46, $_;
+
+/(b)/;		# this must not taint
+check_taint_not  47, $&;
+check_taint_not  48, $`;
+check_taint_not  49, $';
+check_taint_not  50, $+;
+check_taint_not  51, $1;
+check_taint_not  52, $2;
+
+$_ = $a;	# untaint $_
+
+check_taint_not  53, $_;
+
+$b = uc($a);	# taint $b
+s/(.+)/$b/;	# this must taint only the $_
+
+check_taint      54, $_;
+check_taint_not  55, $&;
+check_taint_not  56, $`;
+check_taint_not  57, $';
+check_taint_not  58, $+;
+check_taint_not  59, $1;
+check_taint_not  60, $2;
+
+$_ = $a;	# untaint $_
+
+s/(.+)/b/;	# this must not taint
+check_taint_not  61, $_;
+check_taint_not  62, $&;
+check_taint_not  63, $`;
+check_taint_not  64, $';
+check_taint_not  65, $+;
+check_taint_not  66, $1;
+check_taint_not  67, $2;
+
+$b = $a;	# untaint $b
+
+($b = $a) =~ s/\w/$&/;
+check_taint      68, $b;	# $b should be tainted.
+check_taint_not  69, $a;	# $a should be not.
+
+$_ = $a;	# untaint $_
+
+s/(\w)/\l$1/;	# this must taint
+check_taint      70, $_;
+check_taint      71, $&;
+check_taint      72, $`;
+check_taint      73, $';
+check_taint      74, $+;
+check_taint      75, $1;
+check_taint_not  76, $2;
+
+$_ = $a;	# untaint $_
+
+s/(\w)/\L$1/;	# this must taint
+check_taint      77, $_;
+check_taint      78, $&;
+check_taint      79, $`;
+check_taint      80, $';
+check_taint      81, $+;
+check_taint      82, $1;
+check_taint_not  83, $2;
+
+$_ = $a;	# untaint $_
+
+s/(\w)/\u$1/;	# this must taint
+check_taint      84, $_;
+check_taint      85, $&;
+check_taint      86, $`;
+check_taint      87, $';
+check_taint      88, $+;
+check_taint      89, $1;
+check_taint_not  90, $2;
+
+$_ = $a;	# untaint $_
+
+s/(\w)/\U$1/;	# this must taint
+check_taint      91, $_;
+check_taint      92, $&;
+check_taint      93, $`;
+check_taint      94, $';
+check_taint      95, $+;
+check_taint      96, $1;
+check_taint_not  97, $2;
+
+# After all this tainting $a should be cool.
+
+check_taint_not  98, $a;
+
+sub last_without_setlocale { 98 }
+
+# I think we've seen quite enough of taint.
+# Let us do some *real* locale work now,
+# unless setlocale() is missing (i.e. minitest).
+
+exit unless $have_setlocale;
+
+# Find locales.
+
+debug "# Scanning for locales...\n";
+
+# Note that it's okay that some languages have their native names
+# capitalized here even though that's not "right".  They are lowercased
+# anyway later during the scanning process (and besides, some clueless
+# vendor might have them capitalized errorneously anyway).
+
+my $locales = <<EOF;
+Afrikaans:af:za:1 15
+Arabic:ar:dz eg sa:6 arabic8
+Brezhoneg Breton:br:fr:1 15
+Bulgarski Bulgarian:bg:bg:5
+Chinese:zh:cn tw:cn.EUC eucCN eucTW euc.CN euc.TW Big5 GB2312 tw.EUC
+Hrvatski Croatian:hr:hr:2
+Cymraeg Welsh:cy:cy:1 14 15
+Czech:cs:cz:2
+Dansk Danish:dk:da:1 15
+Nederlands Dutch:nl:be nl:1 15
+English American British:en:au ca gb ie nz us uk zw:1 15 cp850
+Esperanto:eo:eo:3
+Eesti Estonian:et:ee:4 6 13
+Suomi Finnish:fi:fi:1 15
+Flamish::fl:1 15
+Deutsch German:de:at be ch de lu:1 15
+Euskaraz Basque:eu:es fr:1 15
+Galego Galician:gl:es:1 15
+Ellada Greek:el:gr:7 g8
+Frysk:fy:nl:1 15
+Greenlandic:kl:gl:4 6
+Hebrew:iw:il:8 hebrew8
+Hungarian:hu:hu:2
+Indonesian:in:id:1 15
+Gaeilge Irish:ga:IE:1 14 15
+Italiano Italian:it:ch it:1 15
+Nihongo Japanese:ja:jp:euc eucJP jp.EUC sjis
+Korean:ko:kr:
+Latine Latin:la:va:1 15
+Latvian:lv:lv:4 6 13
+Lithuanian:lt:lt:4 6 13
+Macedonian:mk:mk:1 15
+Maltese:mt:mt:3
+Moldovan:mo:mo:2
+Norsk Norwegian:no no\@nynorsk:no:1 15
+Occitan:oc:es:1 15
+Polski Polish:pl:pl:2
+Rumanian:ro:ro:2
+Russki Russian:ru:ru su ua:5 koi8 koi8r KOI8-R koi8u cp1251 cp866
+Serbski Serbian:sr:yu:5
+Slovak:sk:sk:2
+Slovene Slovenian:sl:si:2
+Sqhip Albanian:sq:sq:1 15
+Svenska Swedish:sv:fi se:1 15
+Thai:th:th:11 tis620
+Turkish:tr:tr:9 turkish8
+Yiddish:yi::1 15
+EOF
+
+if ($^O eq 'os390') {
+    # These cause heartburn.  Broken locales?
+    $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//;
+    $locales =~ s/Thai:th:th:11 tis620\n//;
+}
+
+sub in_utf8 () { $^H & 0x08 }
+
+if (in_utf8) {
+    require "locale/utf8";
+} else {
+    require "locale/latin1";
+}
+
+my @Locale;
+my $Locale;
+my @Alnum_;
+
+my @utf8locale;
+my %utf8skip;
+
+sub getalnum_ {
+    sort grep /\w/, map { chr } 0..255
+}
+
+sub trylocale {
+    my $locale = shift;
+    if (setlocale(LC_ALL, $locale)) {
+	push @Locale, $locale;
+    }
+}
+
+sub decode_encodings {
+    my @enc;
+
+    foreach (split(/ /, shift)) {
+	if (/^(\d+)$/) {
+	    push @enc, "ISO8859-$1";
+	    push @enc, "iso8859$1";	# HP
+	    if ($1 eq '1') {
+		 push @enc, "roman8";	# HP
+	    }
+	} else {
+	    push @enc, $_;
+   	    push @enc, "$_.UTF-8";
+	}
+    }
+    if ($^O eq 'os390') {
+	push @enc, qw(IBM-037 IBM-819 IBM-1047);
+    }
+
+    return @enc;
+}
+
+trylocale("C");
+trylocale("POSIX");
+foreach (0..15) {
+    trylocale("ISO8859-$_");
+    trylocale("iso8859$_");
+    trylocale("iso8859-$_");
+    trylocale("iso_8859_$_");
+    trylocale("isolatin$_");
+    trylocale("isolatin-$_");
+    trylocale("iso_latin_$_");
+}
+
+# Sanitize the environment so that we can run the external 'locale'
+# program without the taint mode getting grumpy.
+
+# $ENV{PATH} is special in VMS.
+delete $ENV{PATH} if $^O ne 'VMS' or $Config{d_setenv};
+
+# Other subversive stuff.
+delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
+
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
+    while (<LOCALES>) {
+        chomp;
+	trylocale($_);
+    }
+    close(LOCALES);
+} elsif ($^O eq 'VMS' && defined($ENV{'SYS$I18N_LOCALE'}) && -d 'SYS$I18N_LOCALE') {
+# The SYS$I18N_LOCALE logical name search list was not present on 
+# VAX VMS V5.5-12, but was on AXP && VAX VMS V6.2 as well as later versions.
+    opendir(LOCALES, "SYS\$I18N_LOCALE:");
+    while ($_ = readdir(LOCALES)) {
+        chomp;
+        trylocale($_);
+    }
+    close(LOCALES);
+} else {
+
+    # This is going to be slow.
+
+    foreach my $locale (split(/\n/, $locales)) {
+	my ($locale_name, $language_codes, $country_codes, $encodings) =
+	    split(/:/, $locale);
+	my @enc = decode_encodings($encodings);
+	foreach my $loc (split(/ /, $locale_name)) {
+	    trylocale($loc);
+	    foreach my $enc (@enc) {
+		trylocale("$loc.$enc");
+	    }
+	    $loc = lc $loc;
+	    foreach my $enc (@enc) {
+		trylocale("$loc.$enc");
+	    }
+	}
+	foreach my $lang (split(/ /, $language_codes)) {
+	    trylocale($lang);
+	    foreach my $country (split(/ /, $country_codes)) {
+		my $lc = "${lang}_${country}";
+		trylocale($lc);
+		foreach my $enc (@enc) {
+		    trylocale("$lc.$enc");
+		}
+		my $lC = "${lang}_\U${country}";
+		trylocale($lC);
+		foreach my $enc (@enc) {
+		    trylocale("$lC.$enc");
+		}
+	    }
+	}
+    }
+}
+
+setlocale(LC_ALL, "C");
+
+sub utf8locale { $_[0] =~ /utf-?8/i }
+
+@Locale = sort @Locale;
+
+debug "# Locales = @Locale\n";
+
+my %Problem;
+my %Okay;
+my %Testing;
+my @Neoalpha;
+my %Neoalpha;
+
+sub tryneoalpha {
+    my ($Locale, $i, $test) = @_;
+    unless ($test) {
+	$Problem{$i}{$Locale} = 1;
+	debug "# failed $i with locale '$Locale'\n";
+    } else {
+	push @{$Okay{$i}}, $Locale;
+    }
+}
+
+foreach $Locale (@Locale) {
+    debug "# Locale = $Locale\n";
+    @Alnum_ = getalnum_();
+    debug "# w = ", join("",@Alnum_), "\n";
+
+    unless (setlocale(LC_ALL, $Locale)) {
+	foreach (99..103) {
+	    $Problem{$_}{$Locale} = -1;
+	}
+	next;
+    }
+
+    # Sieve the uppercase and the lowercase.
+    
+    my %UPPER = ();
+    my %lower = ();
+    my %BoThCaSe = ();
+    for (@Alnum_) {
+	if (/[^\d_]/) { # skip digits and the _
+	    if (uc($_) eq $_) {
+		$UPPER{$_} = $_;
+	    }
+	    if (lc($_) eq $_) {
+		$lower{$_} = $_;
+	    }
+	}
+    }
+    foreach (keys %UPPER) {
+	$BoThCaSe{$_}++ if exists $lower{$_};
+    }
+    foreach (keys %lower) {
+	$BoThCaSe{$_}++ if exists $UPPER{$_};
+    }
+    foreach (keys %BoThCaSe) {
+	delete $UPPER{$_};
+	delete $lower{$_};
+    }
+
+    debug "# UPPER    = ", join("", sort keys %UPPER   ), "\n";
+    debug "# lower    = ", join("", sort keys %lower   ), "\n";
+    debug "# BoThCaSe = ", join("", sort keys %BoThCaSe), "\n";
+
+    # Find the alphabets that are not alphabets in the default locale.
+
+    {
+	no locale;
+    
+	@Neoalpha = ();
+	for (keys %UPPER, keys %lower) {
+	    push(@Neoalpha, $_) if (/\W/);
+	    $Neoalpha{$_} = $_;
+	}
+    }
+
+    @Neoalpha = sort @Neoalpha;
+
+    debug "# Neoalpha = ", join("",@Neoalpha), "\n";
+
+    if (@Neoalpha == 0) {
+	# If we have no Neoalphas the remaining tests are no-ops.
+	debug "# no Neoalpha, skipping tests 99..102 for locale '$Locale'\n";
+	foreach (99..102) {
+	    push @{$Okay{$_}}, $Locale;
+	}
+    } else {
+
+	# Test \w.
+    
+	if (utf8locale($Locale)) {
+	    # utf8 and locales do not mix.
+	    debug "# skipping UTF-8 locale '$Locale'\n";
+	    push @utf8locale, $Locale;
+            @utf8skip{99..102} = ();
+	} else {
+	    my $word = join('', @Neoalpha);
+
+	    $word =~ /^(\w+)$/;
+ 
+	    tryneoalpha($Locale, 99, $1 eq $word);
+	}
+	# Cross-check the whole 8-bit character set.
+
+	for (map { chr } 0..255) {
+	    tryneoalpha($Locale, 100,
+			(/\w/ xor /\W/) ||
+			(/\d/ xor /\D/) ||
+			(/\s/ xor /\S/));
+	}
+
+	# Test for read-only scalars' locale vs non-locale comparisons.
+
+	{
+	    no locale;
+	    $a = "qwerty";
+	    {
+		use locale;
+		tryneoalpha($Locale, 101, ($a cmp "qwerty") == 0);
+	    }
+	}
+
+	{
+	    my ($from, $to, $lesser, $greater,
+		@test, %test, $test, $yes, $no, $sign);
+
+	    for (0..9) {
+		# Select a slice.
+		$from = int(($_*@Alnum_)/10);
+		$to = $from + int(@Alnum_/10);
+		$to = $#Alnum_ if ($to > $#Alnum_);
+		$lesser  = join('', @Alnum_[$from..$to]);
+		# Select a slice one character on.
+		$from++; $to++;
+		$to = $#Alnum_ if ($to > $#Alnum_);
+		$greater = join('', @Alnum_[$from..$to]);
+		($yes, $no, $sign) = ($lesser lt $greater
+				      ? ("    ", "not ", 1)
+				      : ("not ", "    ", -1));
+		# all these tests should FAIL (return 0).
+		# Exact lt or gt cannot be tested because
+		# in some locales, say, eacute and E may test equal.
+		@test = 
+		    (
+		     $no.'    ($lesser  le $greater)',  # 1
+		     'not      ($lesser  ne $greater)', # 2
+		     '         ($lesser  eq $greater)', # 3
+		     $yes.'    ($lesser  ge $greater)', # 4
+		     $yes.'    ($lesser  ge $greater)', # 5
+		     $yes.'    ($greater le $lesser )', # 7
+		     'not      ($greater ne $lesser )', # 8
+		     '         ($greater eq $lesser )', # 9
+		     $no.'     ($greater ge $lesser )', # 10
+		     'not (($lesser cmp $greater) == -($sign))' # 11
+		     );
+		@test{@test} = 0 x @test;
+		$test = 0;
+		for my $ti (@test) {
+		    $test{$ti} = eval $ti;
+		    $test ||= $test{$ti}
+		}
+		tryneoalpha($Locale, 102, $test == 0);
+		if ($test) {
+		    debug "# lesser  = '$lesser'\n";
+		    debug "# greater = '$greater'\n";
+		    debug "# lesser cmp greater = ",
+		          $lesser cmp $greater, "\n";
+		    debug "# greater cmp lesser = ",
+		          $greater cmp $lesser, "\n";
+		    debug "# (greater) from = $from, to = $to\n";
+		    for my $ti (@test) {
+			debugf("# %-40s %-4s", $ti,
+			       $test{$ti} ? 'FAIL' : 'ok');
+			if ($ti =~ /\(\.*(\$.+ +cmp +\$[^\)]+)\.*\)/) {
+			    debugf("(%s == %4d)", $1, eval $1);
+			}
+			debug "\n#";
+		    }
+
+		    last;
+		}
+	    }
+	}
+    }
+
+    use locale;
+
+    my ($x, $y) = (1.23, 1.23);
+
+    $a = "$x";
+    printf ''; # printf used to reset locale to "C"
+    $b = "$y";
+
+    debug "# 103..107: a = $a, b = $b, Locale = $Locale\n";
+
+    tryneoalpha($Locale, 103, $a eq $b);
+
+    my $c = "$x";
+    my $z = sprintf ''; # sprintf used to reset locale to "C"
+    my $d = "$y";
+
+    debug "# 104..107: c = $c, d = $d, Locale = $Locale\n";
+
+    tryneoalpha($Locale, 104, $c eq $d); 
+
+    {
+	use warnings;
+	my $w = 0;
+	local $SIG{__WARN__} =
+	    sub {
+		print "# @_\n";
+		$w++;
+	    };
+
+	# The == (among other ops) used to warn for locales
+	# that had something else than "." as the radix character.
+
+	tryneoalpha($Locale, 105, $c == 1.23);
+
+	tryneoalpha($Locale, 106, $c == $x);
+
+	tryneoalpha($Locale, 107, $c == $d);
+
+	{
+#	    no locale; # XXX did this ever work correctly?
+	
+	    my $e = "$x";
+
+	    debug "# 108..110: e = $e, Locale = $Locale\n";
+
+	    tryneoalpha($Locale, 108, $e == 1.23);
+
+	    tryneoalpha($Locale, 109, $e == $x);
+	    
+	    tryneoalpha($Locale, 110, $e == $c);
+	}
+	
+	my $f = "1.23";
+	my $g = 2.34;
+
+	debug "# 111..115: f = $f, g = $g, locale = $Locale\n";
+
+	tryneoalpha($Locale, 111, $f == 1.23);
+
+	tryneoalpha($Locale, 112, $f == $x);
+	
+	tryneoalpha($Locale, 113, $f == $c);
+
+	tryneoalpha($Locale, 114, abs(($f + $g) - 3.57) < 0.01);
+
+	tryneoalpha($Locale, 115, $w == 0);
+    }
+
+    # Does taking lc separately differ from taking
+    # the lc "in-line"?  (This was the bug 19990704.002, change #3568.)
+    # The bug was in the caching of the 'o'-magic.
+    {
+	use locale;
+
+	sub lcA {
+	    my $lc0 = lc $_[0];
+	    my $lc1 = lc $_[1];
+	    return $lc0 cmp $lc1;
+	}
+
+        sub lcB {
+	    return lc($_[0]) cmp lc($_[1]);
+	}
+
+        my $x = "ab";
+        my $y = "aa";
+        my $z = "AB";
+
+        tryneoalpha($Locale, 116,
+		    lcA($x, $y) == 1 && lcB($x, $y) == 1 ||
+		    lcA($x, $z) == 0 && lcB($x, $z) == 0);
+    }
+
+    # Does lc of an UPPER (if different from the UPPER) match
+    # case-insensitively the UPPER, and does the UPPER match
+    # case-insensitively the lc of the UPPER.  And vice versa.
+    {
+        if (utf8locale($Locale)) {
+	    # utf8 and locales do not mix.
+	    debug "# skipping UTF-8 locale '$Locale'\n";
+	    push @utf8locale, $Locale;
+            $utf8skip{117}++;
+	} else {
+	    use locale;
+	    use locale;
+	    no utf8; # so that the native 8-bit characters work
+
+	    my @f = ();
+	    foreach my $x (keys %UPPER) {
+		my $y = lc $x;
+		next unless uc $y eq $x;
+		push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+	    }
+	    foreach my $x (keys %lower) {
+		my $y = uc $x;
+		next unless lc $y eq $x;
+		push @f, $x unless $x =~ /$y/i && $y =~ /$x/i;
+	    }
+	    tryneoalpha($Locale, 117, @f == 0);
+	    if (@f) {
+		print "# failed 117 locale '$Locale' characters @f\n"
+  	    }
+        }
+    }
+}
+
+# Recount the errors.
+
+foreach (&last_without_setlocale()+1..$last) {
+    if ($Problem{$_} || !defined $Okay{$_} || !@{$Okay{$_}}) {
+	if ($_ == 102) {
+	    print "# The failure of test 102 is not necessarily fatal.\n";
+	    print "# It usually indicates a problem in the enviroment,\n";
+	    print "# not in Perl itself.\n";
+	}
+	print "not ";
+    }
+    print "ok $_\n";
+}
+
+# Give final advice.
+
+my $didwarn = 0;
+
+foreach (99..$last) {
+    if ($Problem{$_}) {
+	my @f = sort keys %{ $Problem{$_} };
+	my $f = join(" ", @f);
+	$f =~ s/(.{50,60}) /$1\n#\t/g;
+	print
+	    "#\n",
+            "# The locale ", (@f == 1 ? "definition" : "definitions"), "\n#\n",
+	    "#\t", $f, "\n#\n",
+	    "# on your system may have errors because the locale test $_\n",
+            "# failed in ", (@f == 1 ? "that locale" : "those locales"),
+            ".\n";
+	print <<EOW;
+#
+# If your users are not using these locales you are safe for the moment,
+# but please report this failure first to perlbug\@perl.com using the
+# perlbug script (as described in the INSTALL file) so that the exact
+# details of the failures can be sorted out first and then your operating
+# system supplier can be alerted about these anomalies.
+#
+EOW
+	$didwarn = 1;
+    }
+}
+
+# Tell which locales were okay and which were not.
+
+if ($didwarn) {
+    my (@s, @F);
+    
+    foreach my $l (@Locale) {
+	my $p = 0;
+	foreach my $t (102..$last) {
+	    $p++ if $Problem{$t}{$l};
+	}
+	push @s, $l if $p == 0;
+      push @F, $l unless $p == 0;
+    }
+    
+    if (@s) {
+        my $s = join(" ", @s);
+        $s =~ s/(.{50,60}) /$1\n#\t/g;
+
+        warn
+    	    "# The following locales\n#\n",
+            "#\t", $s, "\n#\n",
+	    "# tested okay.\n#\n",
+    } else {
+        warn "# None of your locales were fully okay.\n";
+    }
+
+    if (@F) {
+        my $F = join(" ", @F);
+        $F =~ s/(.{50,60}) /$1\n#\t/g;
+
+        warn
+          "# The following locales\n#\n",
+          "#\t", $F, "\n#\n",
+          "# had problems.\n#\n",
+    } else {
+        warn "# None of your locales were broken.\n";
+    }
+
+    if (@utf8locale) {
+        my $S = join(" ", @utf8locale);
+        $S =~ s/(.{50,60}) /$1\n#\t/g;
+    
+        warn "#\n# The following locales\n#\n",
+             "#\t", $S, "\n#\n",
+             "# were skipped for the tests ",
+             join(" ", sort {$a<=>$b} keys %utf8skip), "\n",
+            "# because UTF-8 and locales do not work together in Perl.\n#\n";
+    }
+}
+
+sub last { 117 }
+
+# eof
diff --git a/lib/locale/latin1 b/lib/locale/latin1
new file mode 100644
index 0000000000..f40f7325e0
--- /dev/null
+++ b/lib/locale/latin1
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Catal� Catalan:ca:es:1 15
+Fran�ais French:fr:be ca ch fr lu:1 15
+G�idhlig Gaelic:gd:gb uk:1 14 15
+F�royskt Faroese:fo:fo:1 15
+�slensku Icelandic:is:is:1 15
+S�mi Lappish:::4 6 13
+Portugu�s Portuguese:po:po br:1 15
+Espan�l Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF
diff --git a/lib/locale/utf8 b/lib/locale/utf8
new file mode 100644
index 0000000000..fbbe94fb51
--- /dev/null
+++ b/lib/locale/utf8
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Català Catalan:ca:es:1 15
+Français French:fr:be ca ch fr lu:1 15
+Gáidhlig Gaelic:gd:gb uk:1 14 15
+Føroyskt Faroese:fo:fo:1 15
+Íslensku Icelandic:is:is:1 15
+Sámi Lappish:::4 6 13
+Português Portuguese:po:po br:1 15
+Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF
diff --git a/lib/overload.t b/lib/overload.t
new file mode 100644
index 0000000000..d07506261d
--- /dev/null
+++ b/lib/overload.t
@@ -0,0 +1,1050 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+package Oscalar;
+use overload ( 
+				# Anonymous subroutines:
+'+'	=>	sub {new Oscalar $ {$_[0]}+$_[1]},
+'-'	=>	sub {new Oscalar
+		       $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'<=>'	=>	sub {new Oscalar
+		       $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
+'cmp'	=>	sub {new Oscalar
+		       $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
+'*'	=>	sub {new Oscalar ${$_[0]}*$_[1]},
+'/'	=>	sub {new Oscalar 
+		       $_[2]? $_[1]/${$_[0]} :
+			 ${$_[0]}/$_[1]},
+'%'	=>	sub {new Oscalar
+		       $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
+'**'	=>	sub {new Oscalar
+		       $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
+
+qw(
+""	stringify
+0+	numify)			# Order of arguments unsignificant
+);
+
+sub new {
+  my $foo = $_[1];
+  bless \$foo, $_[0];
+}
+
+sub stringify { "${$_[0]}" }
+sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
+				# comparing to direct compilation based on
+				# stringify
+
+package main;
+
+$test = 0;
+$| = 1;
+print "1..",&last,"\n";
+
+sub test {
+  $test++; 
+  if (@_ > 1) {
+    if ($_[0] eq $_[1]) {
+      print "ok $test\n";
+    } else {
+      print "not ok $test: '$_[0]' ne '$_[1]'\n";
+    }
+  } else {
+    if (shift) {
+      print "ok $test\n";
+    } else {
+      print "not ok $test\n";
+    } 
+  }
+}
+
+$a = new Oscalar "087";
+$b= "$a";
+
+# All test numbers in comments are off by 1.
+# So much for hard-wiring them in :-) To fix this:
+test(1);			# 1
+
+test ($b eq $a);		# 2
+test ($b eq "087");		# 3
+test (ref $a eq "Oscalar");	# 4
+test ($a eq $a);		# 5
+test ($a eq "087");		# 6
+
+$c = $a + 7;
+
+test (ref $c eq "Oscalar");	# 7
+test (!($c eq $a));		# 8
+test ($c eq "94");		# 9
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 10
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 11
+test ( $a eq "087");		# 12
+test ( $b eq "88");		# 13
+test (ref $a eq "Oscalar");	# 14
+
+$c=$b;
+$c-=$a;
+
+test (ref $c eq "Oscalar");	# 15
+test ( $a eq "087");		# 16
+test ( $c eq "1");		# 17
+test (ref $a eq "Oscalar");	# 18
+
+$b=1;
+$b+=$a;
+
+test (ref $b eq "Oscalar");	# 19
+test ( $a eq "087");		# 20
+test ( $b eq "88");		# 21
+test (ref $a eq "Oscalar");	# 22
+
+eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 23
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 24
+test ( $a eq "087");		# 25
+test ( $b eq "88");		# 26
+test (ref $a eq "Oscalar");	# 27
+
+package Oscalar;
+$dummy=bless \$dummy;		# Now cache of method should be reloaded
+package main;
+
+$b=$a;
+$b++;				
+
+test (ref $b eq "Oscalar");	# 28
+test ( $a eq "087");		# 29
+test ( $b eq "88");		# 30
+test (ref $a eq "Oscalar");	# 31
+
+undef $b;			# Destroying updates tables too...
+
+eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
+
+$b=$a;
+
+test (ref $a eq "Oscalar");	# 32
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 33
+test ( $a eq "087");		# 34
+test ( $b eq "88");		# 35
+test (ref $a eq "Oscalar");	# 36
+
+package Oscalar;
+$dummy=bless \$dummy;		# Now cache of method should be reloaded
+package main;
+
+$b++;				
+
+test (ref $b eq "Oscalar");	# 37
+test ( $a eq "087");		# 38
+test ( $b eq "90");		# 39
+test (ref $a eq "Oscalar");	# 40
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar");	# 41
+test ( $a eq "087");		# 42
+test ( $b eq "89");		# 43
+test (ref $a eq "Oscalar");	# 44
+
+
+test ($b? 1:0);			# 45
+
+eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
+						   package Oscalar;
+						   local $new=$ {$_[0]};
+						   bless \$new } ) ];
+
+$b=new Oscalar "$a";
+
+test (ref $b eq "Oscalar");	# 46
+test ( $a eq "087");		# 47
+test ( $b eq "087");		# 48
+test (ref $a eq "Oscalar");	# 49
+
+$b++;
+
+test (ref $b eq "Oscalar");	# 50
+test ( $a eq "087");		# 51
+test ( $b eq "89");		# 52
+test (ref $a eq "Oscalar");	# 53
+test ($copies == 0);		# 54
+
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 55
+test ( $a eq "087");		# 56
+test ( $b eq "90");		# 57
+test (ref $a eq "Oscalar");	# 58
+test ($copies == 0);		# 59
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 60
+test ( $a eq "087");		# 61
+test ( $b eq "88");		# 62
+test (ref $a eq "Oscalar");	# 63
+test ($copies == 0);		# 64
+
+$b=$a;
+$b++;
+
+test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n";	# 65
+test ( $a eq "087");		# 66
+test ( $b eq "89");		# 67
+test (ref $a eq "Oscalar");	# 68
+test ($copies == 1);		# 69
+
+eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
+						   $_[0] } ) ];
+$c=new Oscalar;			# Cause rehash
+
+$b=$a;
+$b+=1;
+
+test (ref $b eq "Oscalar");	# 70
+test ( $a eq "087");		# 71
+test ( $b eq "90");		# 72
+test (ref $a eq "Oscalar");	# 73
+test ($copies == 2);		# 74
+
+$b+=$b;
+
+test (ref $b eq "Oscalar");	# 75
+test ( $b eq "360");		# 76
+test ($copies == 2);		# 77
+$b=-$b;
+
+test (ref $b eq "Oscalar");	# 78
+test ( $b eq "-360");		# 79
+test ($copies == 2);		# 80
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");	# 81
+test ( $b eq "360");		# 82
+test ($copies == 2);		# 83
+
+$b=abs($b);
+
+test (ref $b eq "Oscalar");	# 84
+test ( $b eq "360");		# 85
+test ($copies == 2);		# 86
+
+eval q[package Oscalar; 
+       use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
+					      : "_.${$_[0]}._" x $_[1])}) ];
+
+$a=new Oscalar "yy";
+$a x= 3;
+test ($a eq "_.yy.__.yy.__.yy._"); # 87
+
+eval q[package Oscalar; 
+       use overload ('.' => sub {new Oscalar ( $_[2] ? 
+					      "_.$_[1].__.$ {$_[0]}._"
+					      : "_.$ {$_[0]}.__.$_[1]._")}) ];
+
+$a=new Oscalar "xx";
+
+test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
+
+# Check inheritance of overloading;
+{
+  package OscalarI;
+  @ISA = 'Oscalar';
+}
+
+$aI = new OscalarI "$a";
+test (ref $aI eq "OscalarI");	# 89
+test ("$aI" eq "xx");		# 90
+test ($aI eq "xx");		# 91
+test ("b${aI}c" eq "_._.b.__.xx._.__.c._");		# 92
+
+# Here we test blessing to a package updates hash
+
+eval "package Oscalar; no overload '.'";
+
+test ("b${a}" eq "_.b.__.xx._"); # 93
+$x="1";
+bless \$x, Oscalar;
+test ("b${a}c" eq "bxxc");	# 94
+new Oscalar 1;
+test ("b${a}c" eq "bxxc");	# 95
+
+# Negative overloading:
+
+$na = eval { ~$a };
+test($@ =~ /no method found/);	# 96
+
+# Check AUTOLOADING:
+
+*Oscalar::AUTOLOAD = 
+  sub { *{"Oscalar::$AUTOLOAD"} = sub {"_!_" . shift() . "_!_"} ;
+	goto &{"Oscalar::$AUTOLOAD"}};
+
+eval "package Oscalar; sub comple; use overload '~' => 'comple'";
+
+$na = eval { ~$a };		# Hash was not updated
+test($@ =~ /no method found/);	# 97
+
+bless \$x, Oscalar;
+
+$na = eval { ~$a };		# Hash updated
+warn "`$na', $@" if $@;
+test !$@;			# 98
+test($na eq '_!_xx_!_');	# 99
+
+$na = 0;
+
+$na = eval { ~$aI };		# Hash was not updated
+test($@ =~ /no method found/);	# 100
+
+bless \$x, OscalarI;
+
+$na = eval { ~$aI };
+print $@;
+
+test !$@;			# 101
+test($na eq '_!_xx_!_');	# 102
+
+eval "package Oscalar; sub rshft; use overload '>>' => 'rshft'";
+
+$na = eval { $aI >> 1 };	# Hash was not updated
+test($@ =~ /no method found/);	# 103
+
+bless \$x, OscalarI;
+
+$na = 0;
+
+$na = eval { $aI >> 1 };
+print $@;
+
+test !$@;			# 104
+test($na eq '_!_xx_!_');	# 105
+
+# warn overload::Method($a, '0+'), "\n";
+test (overload::Method($a, '0+') eq \&Oscalar::numify); # 106
+test (overload::Method($aI,'0+') eq \&Oscalar::numify); # 107
+test (overload::Overloaded($aI)); # 108
+test (!overload::Overloaded('overload')); # 109
+
+test (! defined overload::Method($aI, '<<')); # 110
+test (! defined overload::Method($a, '<')); # 111
+
+test (overload::StrVal($aI) =~ /^OscalarI=SCALAR\(0x[\da-fA-F]+\)$/); # 112
+test (overload::StrVal(\$aI) eq "@{[\$aI]}"); # 113
+
+# Check overloading by methods (specified deep in the ISA tree).
+{
+  package OscalarII;
+  @ISA = 'OscalarI';
+  sub Oscalar::lshft {"_<<_" . shift() . "_<<_"}
+  eval "package OscalarI; use overload '<<' => 'lshft', '|' => 'lshft'";
+}
+
+$aaII = "087";
+$aII = \$aaII;
+bless $aII, 'OscalarII';
+bless \$fake, 'OscalarI';		# update the hash
+test(($aI | 3) eq '_<<_xx_<<_');	# 114
+# warn $aII << 3;
+test(($aII << 3) eq '_<<_087_<<_');	# 115
+
+{
+  BEGIN { $int = 7; overload::constant 'integer' => sub {$int++; shift}; }
+  $out = 2**10;
+}
+test($int, 9);		# 116
+test($out, 1024);		# 117
+
+$foo = 'foo';
+$foo1 = 'f\'o\\o';
+{
+  BEGIN { $q = $qr = 7; 
+	  overload::constant 'q' => sub {$q++; push @q, shift, ($_[1] || 'none'); shift},
+			     'qr' => sub {$qr++; push @qr, shift, ($_[1] || 'none'); shift}; }
+  $out = 'foo';
+  $out1 = 'f\'o\\o';
+  $out2 = "a\a$foo,\,";
+  /b\b$foo.\./;
+}
+
+test($out, 'foo');		# 118
+test($out, $foo);		# 119
+test($out1, 'f\'o\\o');		# 120
+test($out1, $foo1);		# 121
+test($out2, "a\afoo,\,");	# 122
+test("@q", "foo q f'o\\\\o q a\\a qq ,\\, qq");	# 123
+test($q, 11);			# 124
+test("@qr", "b\\b qq .\\. qq");	# 125
+test($qr, 9);			# 126
+
+{
+  $_ = '!<b>!foo!<-.>!';
+  BEGIN { overload::constant 'q' => sub {push @q1, shift, ($_[1] || 'none'); "_<" . (shift) . ">_"},
+			     'qr' => sub {push @qr1, shift, ($_[1] || 'none'); "!<" . (shift) . ">!"}; }
+  $out = 'foo';
+  $out1 = 'f\'o\\o';
+  $out2 = "a\a$foo,\,";
+  $res = /b\b$foo.\./;
+  $a = <<EOF;
+oups
+EOF
+  $b = <<'EOF';
+oups1
+EOF
+  $c = bareword;
+  m'try it';
+  s'first part'second part';
+  s/yet another/tail here/;
+  tr/A-Z/a-z/;
+}
+
+test($out, '_<foo>_');		# 117
+test($out1, '_<f\'o\\o>_');		# 128
+test($out2, "_<a\a>_foo_<,\,>_");	# 129
+test("@q1", "foo q f'o\\\\o q a\\a qq ,\\, qq oups
+ qq oups1
+ q second part q tail here s A-Z tr a-z tr");	# 130
+test("@qr1", "b\\b qq .\\. qq try it q first part q yet another qq");	# 131
+test($res, 1);			# 132
+test($a, "_<oups
+>_");	# 133
+test($b, "_<oups1
+>_");	# 134
+test($c, "bareword");	# 135
+
+{
+  package symbolic;		# Primitive symbolic calculator
+  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num,
+      '=' => \&cpy, '++' => \&inc, '--' => \&dec;
+
+  sub new { shift; bless ['n', @_] }
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+  sub inc { $_[0] = bless ['++', $_[0], 1]; }
+  sub dec { $_[0] = bless ['--', $_[0], 1]; }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  } 
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+  
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth} 
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }		# Around a bug
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+  sub STORE { 
+    my $obj = shift; 
+    $#$obj = 1; 
+    $obj->[1] = shift;
+  }
+}
+
+{
+  my $foo = new symbolic 11;
+  my $baz = $foo++;
+  test( (sprintf "%d", $foo), '12');
+  test( (sprintf "%d", $baz), '11');
+  my $bar = $foo;
+  $baz = ++$foo;
+  test( (sprintf "%d", $foo), '13');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '13');
+  my $ban = $foo;
+  $baz = ($foo += 1);
+  test( (sprintf "%d", $foo), '14');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '14');
+  test( (sprintf "%d", $ban), '13');
+  $baz = 0;
+  $baz = $foo++;
+  test( (sprintf "%d", $foo), '15');
+  test( (sprintf "%d", $baz), '14');
+  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+  my $iter = new symbolic 2;
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt) {
+    $cnt = $cnt - 1;		# The "simple" way
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my $iter = new symbolic 2;
+  my $side = new symbolic 1;
+  my $cnt = $iter;
+  
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my ($a, $b);
+  symbolic->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+  $a = 3; $b = 4;
+  test( (sprintf "%d", $c), '5');
+  $a = 12; $b = 5;
+  test( (sprintf "%d", $c), '13');
+}
+
+{
+  package symbolic1;		# Primitive symbolic calculator
+  # Mutator inc/dec
+  use overload nomethod => \&wrap, '""' => \&str, '0+' => \&num, '=' => \&cpy;
+
+  sub new { shift; bless ['n', @_] }
+  sub cpy {
+    my $self = shift;
+    bless [@$self], ref $self;
+  }
+  sub wrap {
+    my ($obj, $other, $inv, $meth) = @_;
+    if ($meth eq '++' or $meth eq '--') {
+      @$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
+      return $obj;
+    }
+    ($obj, $other) = ($other, $obj) if $inv;
+    bless [$meth, $obj, $other];
+  }
+  sub str {
+    my ($meth, $a, $b) = @{+shift};
+    $a = 'u' unless defined $a;
+    if (defined $b) {
+      "[$meth $a $b]";
+    } else {
+      "[$meth $a]";
+    }
+  } 
+  my %subr = ( 'n' => sub {$_[0]} );
+  foreach my $op (split " ", $overload::ops{with_assign}) {
+    $subr{$op} = $subr{"$op="} = eval "sub {shift() $op shift()}";
+  }
+  my @bins = qw(binary 3way_comparison num_comparison str_comparison);
+  foreach my $op (split " ", "@overload::ops{ @bins }") {
+    $subr{$op} = eval "sub {shift() $op shift()}";
+  }
+  foreach my $op (split " ", "@overload::ops{qw(unary func)}") {
+    $subr{$op} = eval "sub {$op shift()}";
+  }
+  $subr{'++'} = $subr{'+'};
+  $subr{'--'} = $subr{'-'};
+  
+  sub num {
+    my ($meth, $a, $b) = @{+shift};
+    my $subr = $subr{$meth} 
+      or die "Do not know how to ($meth) in symbolic";
+    $a = $a->num if ref $a eq __PACKAGE__;
+    $b = $b->num if ref $b eq __PACKAGE__;
+    $subr->($a,$b);
+  }
+  sub TIESCALAR { my $pack = shift; $pack->new(@_) }
+  sub FETCH { shift }
+  sub nop {  }		# Around a bug
+  sub vars { my $p = shift; tie($_, $p), $_->nop foreach @_; }
+  sub STORE { 
+    my $obj = shift; 
+    $#$obj = 1; 
+    $obj->[1] = shift;
+  }
+}
+
+{
+  my $foo = new symbolic1 11;
+  my $baz = $foo++;
+  test( (sprintf "%d", $foo), '12');
+  test( (sprintf "%d", $baz), '11');
+  my $bar = $foo;
+  $baz = ++$foo;
+  test( (sprintf "%d", $foo), '13');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '13');
+  my $ban = $foo;
+  $baz = ($foo += 1);
+  test( (sprintf "%d", $foo), '14');
+  test( (sprintf "%d", $bar), '12');
+  test( (sprintf "%d", $baz), '14');
+  test( (sprintf "%d", $ban), '13');
+  $baz = 0;
+  $baz = $foo++;
+  test( (sprintf "%d", $foo), '15');
+  test( (sprintf "%d", $baz), '14');
+  test( "$foo", '[++ [+= [++ [++ [n 11] 1] 1] 1] 1]');
+}
+
+{
+  my $iter = new symbolic1 2;
+  my $side = new symbolic1 1;
+  my $cnt = $iter;
+  
+  while ($cnt) {
+    $cnt = $cnt - 1;		# The "simple" way
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my $iter = new symbolic1 2;
+  my $side = new symbolic1 1;
+  my $cnt = $iter;
+  
+  while ($cnt--) {
+    $side = (sqrt(1 + $side**2) - 1)/$side;
+  }
+  my $pi = $side*(2**($iter+2));
+  test "$side", '[/ [- [sqrt [+ 1 [** [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]] 2]]] 1] [/ [- [sqrt [+ 1 [** [n 1] 2]]] 1] [n 1]]]';
+  test( (sprintf "%f", $pi), '3.182598');
+}
+
+{
+  my ($a, $b);
+  symbolic1->vars($a, $b);
+  my $c = sqrt($a**2 + $b**2);
+  $a = 3; $b = 4;
+  test( (sprintf "%d", $c), '5');
+  $a = 12; $b = 5;
+  test( (sprintf "%d", $c), '13');
+}
+
+{
+  package two_face;		# Scalars with separate string and
+                                # numeric values.
+  sub new { my $p = shift; bless [@_], $p }
+  use overload '""' => \&str, '0+' => \&num, fallback => 1;
+  sub num {shift->[1]}
+  sub str {shift->[0]}
+}
+
+{
+  my $seven = new two_face ("vii", 7);
+  test( (sprintf "seven=$seven, seven=%d, eight=%d", $seven, $seven+1),
+	'seven=vii, seven=7, eight=8');
+  test( scalar ($seven =~ /i/), '1')
+}
+
+{
+  package sorting;
+  use overload 'cmp' => \&comp;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub comp { my ($x,$y) = @_; ($$x * 3 % 10) <=> ($$y * 3 % 10) or $$x cmp $$y }
+}
+{
+  my @arr = map sorting->new($_), 0..12;
+  my @sorted1 = sort @arr;
+  my @sorted2 = map $$_, @sorted1;
+  test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
+}
+{
+  package iterator;
+  use overload '<>' => \&iter;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
+}
+
+# XXX iterator overload not intended to work with CORE::GLOBAL?
+if (defined &CORE::GLOBAL::glob) {
+  test '1', '1';	# 175
+  test '1', '1';	# 176
+  test '1', '1';	# 177
+}
+else {
+  my $iter = iterator->new(5);
+  my $acc = '';
+  my $out;
+  $acc .= " $out" while $out = <${iter}>;
+  test $acc, ' 5 4 3 2 1 0';	# 175
+  $iter = iterator->new(5);
+  test scalar <${iter}>, '5';	# 176
+  $acc = '';
+  $acc .= " $out" while $out = <$iter>;
+  test $acc, ' 4 3 2 1 0';	# 177
+}
+{
+  package deref;
+  use overload '%{}' => \&hderef, '&{}' => \&cderef, 
+    '*{}' => \&gderef, '${}' => \&sderef, '@{}' => \&aderef;
+  sub new { my ($p, $v) = @_; bless \$v, $p }
+  sub deref {
+    my ($self, $key) = (shift, shift);
+    my $class = ref $self;
+    bless $self, 'deref::dummy'; # Disable overloading of %{} 
+    my $out = $self->{$key};
+    bless $self, $class;	# Restore overloading
+    $out;
+  }
+  sub hderef {shift->deref('h')}
+  sub aderef {shift->deref('a')}
+  sub cderef {shift->deref('c')}
+  sub gderef {shift->deref('g')}
+  sub sderef {shift->deref('s')}
+}
+{
+  my $deref = bless { h => { foo => 5 , fake => 23 },
+		      c => sub {return shift() + 34},
+		      's' => \123,
+		      a => [11..13],
+		      g => \*srt,
+		    }, 'deref';
+  # Hash:
+  my @cont = sort %$deref;
+  if ("\t" eq "\011") { # ascii
+      test "@cont", '23 5 fake foo';	# 178
+  } 
+  else {                # ebcdic alpha-numeric sort order
+      test "@cont", 'fake foo 23 5';	# 178
+  }
+  my @keys = sort keys %$deref;
+  test "@keys", 'fake foo';	# 179
+  my @val = sort values %$deref;
+  test "@val", '23 5';		# 180
+  test $deref->{foo}, 5;	# 181
+  test defined $deref->{bar}, ''; # 182
+  my $key;
+  @keys = ();
+  push @keys, $key while $key = each %$deref;
+  @keys = sort @keys;
+  test "@keys", 'fake foo';	# 183  
+  test exists $deref->{bar}, ''; # 184
+  test exists $deref->{foo}, 1; # 185
+  # Code:
+  test $deref->(5), 39;		# 186
+  test &$deref(6), 40;		# 187
+  sub xxx_goto { goto &$deref }
+  test xxx_goto(7), 41;		# 188
+  my $srt = bless { c => sub {$b <=> $a}
+		  }, 'deref';
+  *srt = \&$srt;
+  my @sorted = sort srt 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 189
+  # Scalar
+  test $$deref, 123;		# 190
+  # Code
+  @sorted = sort $srt 11, 2, 5, 1, 22;
+  test "@sorted", '22 11 5 2 1'; # 191
+  # Array
+  test "@$deref", '11 12 13';	# 192
+  test $#$deref, '2';		# 193
+  my $l = @$deref;
+  test $l, 3;			# 194
+  test $deref->[2], '13';		# 195
+  $l = pop @$deref;
+  test $l, 13;			# 196
+  $l = 1;
+  test $deref->[$l], '12';	# 197
+  # Repeated dereference
+  my $double = bless { h => $deref,
+		     }, 'deref';
+  test $double->{foo}, 5;	# 198
+}
+
+{
+  package two_refs;
+  use overload '%{}' => \&gethash, '@{}' => sub { ${shift()} };
+  sub new { 
+    my $p = shift; 
+    bless \ [@_], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key] = shift;
+  }
+  sub FETCH { 
+    my $self = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $$self->[$key];
+  }
+}
+
+my $bar = new two_refs 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 199
+$bar->{three} = 13;
+test $bar->[3], 13;		# 200
+
+{
+  package two_refs_o;
+  @ISA = ('two_refs');
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 201
+$bar->{three} = 13;
+test $bar->[3], 13;		# 202
+
+{
+  package two_refs1;
+  use overload '%{}' => sub { ${shift()}->[1] },
+               '@{}' => sub { ${shift()}->[0] };
+  sub new { 
+    my $p = shift; 
+    my $a = [@_];
+    my %h;
+    tie %h, $p, $a;
+    bless \ [$a, \%h], $p;
+  }
+  sub gethash {
+    my %h;
+    my $self = shift;
+    tie %h, ref $self, $self;
+    \%h;
+  }
+
+  sub TIEHASH { my $p = shift; bless \ shift, $p }
+  my %fields;
+  my $i = 0;
+  $fields{$_} = $i++ foreach qw{zero one two three};
+  sub STORE { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key] = shift;
+  }
+  sub FETCH { 
+    my $a = ${shift()};
+    my $key = $fields{shift()};
+    defined $key or die "Out of band access";
+    $a->[$key];
+  }
+}
+
+$bar = new two_refs_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 203
+$bar->{three} = 13;
+test $bar->[3], 13;		# 204
+
+{
+  package two_refs1_o;
+  @ISA = ('two_refs1');
+}
+
+$bar = new two_refs1_o 3,4,5,6;
+$bar->[2] = 11;
+test $bar->{two}, 11;		# 205
+$bar->{three} = 13;
+test $bar->[3], 13;		# 206
+
+{
+  package B;
+  use overload bool => sub { ${+shift} };
+}
+
+my $aaa;
+{ my $bbbb = 0; $aaa = bless \$bbbb, B }
+
+test !$aaa, 1;			# 207
+
+unless ($aaa) {
+  test 'ok', 'ok';		# 208
+} else {
+  test 'is not', 'ok';		# 208
+}
+
+# check that overload isn't done twice by join
+{ my $c = 0;
+  package Join;
+  use overload '""' => sub { $c++ };
+  my $x = join '', bless([]), 'pq', bless([]);
+  main::test $x, '0pq1';		# 209
+};
+
+# Test module-specific warning
+{
+    # check the Odd number of arguments for overload::constant warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a eq "") ; # 210
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" ; ' ;
+    test($a =~ /^Odd number of arguments for overload::constant at/) ; # 211
+}
+
+{
+    # check the `$_[0]' is not an overloadable type warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a eq "") ; # 212
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "fred" => sub {} ; ' ;
+    test($a =~ /^`fred' is not an overloadable type at/); # 213
+}
+
+{
+    # check the `$_[1]' is not a code reference warning
+    my $a = "" ;
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a eq "") ; # 214
+    use warnings 'overload' ;
+    $x = eval ' overload::constant "integer" => 1; ' ;
+    test($a =~ /^`1' is not a code reference at/); # 215
+}
+
+{
+  my $c = 0;
+  package ov_int1;
+  use overload '""'    => sub { 3+shift->[0] },
+               '0+'    => sub { 10+shift->[0] },
+               'int'   => sub { 100+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package ov_int2;
+  use overload '""'    => sub { 5+shift->[0] },
+               '0+'    => sub { 30+shift->[0] },
+               'int'   => sub { 'ov_int1'->new(1000+shift->[0]) };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package noov_int;
+  use overload '""'    => sub { 2+shift->[0] },
+               '0+'    => sub { 9+shift->[0] };
+  sub new {my $p = shift; bless [shift], $p}
+
+  package main;
+
+  my $x = new noov_int 11;
+  my $int_x = int $x;
+  main::test("$int_x" eq 20);			# 216
+  $x = new ov_int1 31;
+  $int_x = int $x;
+  main::test("$int_x" eq 131);			# 217
+  $x = new ov_int2 51;
+  $int_x = int $x;
+  main::test("$int_x" eq 1054);			# 218
+}
+
+# make sure that we don't inifinitely recurse
+{
+  my $c = 0;
+  package Recurse;
+  use overload '""'    => sub { shift },
+               '0+'    => sub { shift },
+               'bool'  => sub { shift },
+               fallback => 1;
+  my $x = bless([]);
+  main::test("$x" =~ /Recurse=ARRAY/);		# 219
+  main::test($x);                               # 220
+  main::test($x+0 =~ /Recurse=ARRAY/);		# 221
+}
+
+# BugID 20010422.003
+package Foo;
+
+use overload
+  'bool' => sub { return !$_[0]->is_zero() || undef; }
+;
+ 
+sub is_zero
+  {
+  my $self = shift;
+  return $self->{var} == 0;
+  }
+
+sub new
+  {
+  my $class = shift;
+  my $self =  {};
+  $self->{var} = shift;
+  bless $self,$class;
+  }
+
+package main;
+
+use strict;
+
+my $r = Foo->new(8);
+$r = Foo->new(0);
+
+test(($r || 0) == 0); # 222
+
+# Last test is:
+sub last {222}
diff --git a/lib/ph.t b/lib/ph.t
new file mode 100755
index 0000000000..de27dee5e2
--- /dev/null
+++ b/lib/ph.t
@@ -0,0 +1,96 @@
+#!./perl
+
+# Check for presence and correctness of .ph files; for now,
+# just socket.ph and pals.
+#   -- Kurt Starsinic <kstar@isinet.com>
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# All the constants which Socket.pm tries to make available:
+my @possibly_defined = qw(
+    INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT
+    AF_CHAOS AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK
+    AF_INET AF_LAT AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP
+    AF_SNA AF_UNIX AF_UNSPEC AF_X25 MSG_DONTROUTE MSG_MAXIOVLEN MSG_OOB
+    MSG_PEEK PF_802 PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI
+    PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT
+    PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 SOCK_DGRAM
+    SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SOMAXCONN
+    SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR
+    SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO
+    SO_REUSEADDR SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK
+);
+
+
+# The libraries which I'm going to require:
+my @libs = qw(Socket "sys/types.ph" "sys/socket.ph" "netinet/in.ph");
+
+
+# These are defined by Socket.pm even if the C header files don't define them:
+my %ok_to_miss = (
+    INADDR_NONE         => 1,
+    INADDR_LOOPBACK     => 1,
+);
+
+
+my $total_tests = scalar @libs + scalar @possibly_defined;
+my $i           = 0;
+
+print "1..$total_tests\n";
+
+
+foreach (@libs) {
+    $i++;
+
+    if (eval "require $_" ) {
+        print "ok $i\n";
+    } else {
+        print "# Skipping tests; $_ may be missing\n";
+        foreach ($i .. $total_tests) { print "ok $_\n" }
+        exit;
+    }
+}
+
+
+foreach (@possibly_defined) {
+    $i++;
+
+    $pm_val = eval "Socket::$_()";
+    $ph_val = eval "main::$_()";
+
+    if (defined $pm_val and !defined $ph_val) {
+        if ($ok_to_miss{$_}) { print "ok $i\n" }
+        else                 { print "not ok $i\n" }
+        next;
+    } elsif (defined $ph_val and !defined $pm_val) {
+        print "not ok $i\n";
+        next;
+    }
+
+    # Socket.pm converts these to network byte order, so we convert the
+    # socket.ph version to match; note that these cases skip the following
+    # `elsif', which is only applied to _numeric_ values, not literal
+    # bitmasks.
+    if ($_ eq 'INADDR_ANY'
+    or  $_ eq 'INADDR_LOOPBACK'
+    or  $_ eq 'INADDR_NONE') {
+        $ph_val = pack("N*", $ph_val);  # htonl(3) equivalent
+    }
+
+    # Since Socket.pm and socket.ph wave their hands over macros differently,
+    # they could return functionally equivalent bitmaps with different numeric
+    # interpretations (due to sign extension).  The only apparent case of this
+    # is SO_DONTLINGER (only on Solaris, and deprecated, at that):
+    elsif ($pm_val != $ph_val) {
+        $pm_val = oct(sprintf "0x%lx", $pm_val);
+        $ph_val = oct(sprintf "0x%lx", $ph_val);
+    }
+
+    if ($pm_val == $ph_val) { print "ok $i\n" }
+    else                    { print "not ok $i\n" }
+}
+
+
diff --git a/lib/strict.t b/lib/strict.t
new file mode 100644
index 0000000000..8b9083f4fc
--- /dev/null
+++ b/lib/strict.t
@@ -0,0 +1,100 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_NetWare = $^O eq 'NetWare';
+my $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+
+my @prgs = () ;
+
+foreach (sort glob($^O eq 'MacOS' ? ":pragma:strict-*" : "pragma/strict-*")) {
+
+    next if /(~|\.orig|,v)$/;
+
+    open F, "<$_" or die "Cannot open $_: $!\n" ;
+    while (<F>) {
+	last if /^__END__/ ;
+    }
+
+    {
+        local $/ = undef;
+        @prgs = (@prgs, split "\n########\n", <F>) ;
+    }
+    close F ;
+}
+
+undef $/;
+
+print "1..", scalar @prgs, "\n";
+ 
+ 
+for (@prgs){
+    my $switch = "";
+    my @temps = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+	shift @files ;
+	die "Internal error test $i didn't split into pairs, got " . 
+		scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+	    if @files % 2 ;
+	while (@files > 2) {
+	    my $filename = shift @files ;
+	    my $code = shift @files ;
+	    $code =~ s|\./abc|:abc|g if $^O eq 'MacOS';
+    	    push @temps, $filename ;
+	    open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+	    print F $code ;
+	    close F ;
+	}
+	shift @files ;
+	$prog = shift @files ;
+	$prog =~ s|\./abc|:abc|g if $^O eq 'MacOS';
+    }
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
+    close TEST;
+    my $results = $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  $^O eq 'MacOS' ?
+                  `$^X -I::lib $switch $tmpfile` :
+                  $^O eq 'NetWare' ?
+                  `perl -I../lib $switch $tmpfile 2>&1` :
+                  `./perl $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+    $expected =~ s/\n+$//;
+    $expected =~ s|(\./)?abc\.pm|:abc.pm|g if $^O eq 'MacOS';
+    $expected =~ s|./abc|:abc|g if $^O eq 'MacOS';
+    my $prefix = ($results =~ s/^PREFIX\n//) ;
+    if ( $results =~ s/^SKIPPED\n//) {
+	print "$results\n" ;
+    }
+    elsif (($prefix and $results !~ /^\Q$expected/) or
+	   (!$prefix and $results ne $expected)){
+        print STDERR "PROG: $switch\n$prog\n";
+        print STDERR "EXPECTED:\n$expected\n";
+        print STDERR "GOT:\n$results\n";
+        print "not ";
+    }
+    print "ok ", ++$i, "\n";
+    foreach (@temps) 
+	{ unlink $_ if $_ } 
+}
diff --git a/lib/strict/refs b/lib/strict/refs
new file mode 100644
index 0000000000..10599b0bb2
--- /dev/null
+++ b/lib/strict/refs
@@ -0,0 +1,297 @@
+Check strict refs functionality
+
+__END__
+
+# no strict, should build & run ok.
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+$c = ${"def"} ;
+$c = @{"def"} ;
+$c = %{"def"} ;
+$c = *{"def"} ;
+$c = \&{"def"} ;
+$c = def->[0];
+$c = def->{xyz};
+EXPECT
+
+########
+
+# strict refs - error
+use strict ;
+my $fred ;
+my $a = ${"fred"} ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $fred ;
+my $a = ${"fred"} ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 6.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = $$b ;
+EXPECT
+Can't use an undefined value as a SCALAR reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = @$b ;
+EXPECT
+Can't use an undefined value as an ARRAY reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = %$b ;
+EXPECT
+Can't use an undefined value as a HASH reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $b ;
+my $a = *$b ;
+EXPECT
+Can't use an undefined value as a symbol reference at - line 5.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->[0] ;
+EXPECT
+Can't use bareword ("fred") as an ARRAY ref while "strict refs" in use at - line 4.
+########
+
+# strict refs - error
+use strict 'refs' ;
+my $a = fred->{barney} ;
+EXPECT
+Can't use bareword ("fred") as a HASH ref while "strict refs" in use at - line 4.
+########
+
+# strict refs - no error
+use strict ;
+no strict 'refs' ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+use strict qw(subs vars) ;
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+my $fred ;
+my $b = "fred" ;
+my $a = $$b ;
+use strict 'refs' ;
+EXPECT
+
+########
+
+# strict refs - no error
+use strict 'refs' ;
+my $fred ;
+my $b = \$fred ;
+my $a = $$b ;
+EXPECT
+
+########
+
+# Check runtime scope of strict refs pragma
+use strict 'refs';
+my $fred ;
+my $b = "fred" ;
+{
+    no strict ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    $a = sub { my $c = $$b ; }
+}
+&$a ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+
+--FILE-- abc
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+use strict 'refs' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'refs' ;
+1;
+--FILE-- 
+require "./abc";
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'refs' ;
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+${"Fred"} ;
+require "./abc";
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'refs' ;
+my $a = ${"Fred"} ;
+1;
+--FILE-- 
+my $a = ${"Fred"} ;
+use abc;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'refs' ;
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 6.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval {
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 5.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval {
+    no strict ;
+    my $a = ${"Fred"} ;
+};
+print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 9.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    my $a = ${"Fred"} ;
+'; print STDERR $@ ;
+my $a = ${"Fred"} ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'refs' ;
+    my $a = ${"Fred"} ;
+]; print STDERR $@;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval '
+    my $a = ${"Fred"} ;
+'; print STDERR $@ ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'refs' ;
+eval '
+    no strict ;
+    my $a = ${"Fred"} ;
+'; print STDERR $@;
+my $a = ${"Fred"} ;
+EXPECT
+Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8.
diff --git a/lib/strict/subs b/lib/strict/subs
new file mode 100644
index 0000000000..ed4fe7a443
--- /dev/null
+++ b/lib/strict/subs
@@ -0,0 +1,319 @@
+Check strict subs functionality
+
+__END__
+
+# no strict, should build & run ok.
+Fred ;
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+EXPECT
+
+########
+
+use strict qw(refs vars);
+Fred ;
+EXPECT
+
+########
+
+use strict ;
+no strict 'subs' ;
+Fred ;
+EXPECT
+
+########
+
+# strict subs - error
+use strict 'subs' ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my @a = (A..Z);
+EXPECT
+Bareword "Z" not allowed while "strict subs" in use at - line 4.
+Bareword "A" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict 'subs' ;
+my $a = (B..Y);
+EXPECT
+Bareword "Y" not allowed while "strict subs" in use at - line 4.
+Bareword "B" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - error
+use strict ;
+Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict subs - no error
+use strict 'subs' ;
+sub Fred {}
+Fred ;
+EXPECT
+
+########
+
+# Check compile time scope of strict subs pragma
+use strict 'subs' ;
+{
+    no strict ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict subs pragma
+no strict;
+{
+    use strict 'subs' ;
+    my $a = Fred ;
+}
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+{
+    no strict ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+no strict;
+{
+    use strict 'vars' ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check runtime scope of strict refs pragma
+use strict 'refs';
+my $fred ;
+my $b = "fred" ;
+{
+    no strict ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 10.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    my $a = $$b ;
+}
+my $a = $$b ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+# Check runtime scope of strict refs pragma
+no strict ;
+my $fred ;
+my $b = "fred" ;
+{
+    use strict 'refs' ;
+    $a = sub { my $c = $$b ; }
+}
+&$a ;
+EXPECT
+Can't use string ("fred") as a SCALAR ref while "strict refs" in use at - line 8.
+########
+
+use strict 'subs' ;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 3.
+Execution of - aborted due to compilation errors.
+########
+
+--FILE-- abc
+my $a = Fred ;
+1;
+--FILE-- 
+use strict 'subs' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+1;
+--FILE-- 
+require "./abc";
+my $a = Fred ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+require "./abc";
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'subs' ;
+my $a = Fred ;
+1;
+--FILE-- 
+Fred ;
+use abc;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'subs' ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 5.
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval {
+    no strict ;
+    my $a = Fred ;
+};
+print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 9.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+Fred ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'subs' ;
+    Fred ;
+]; print STDERR $@;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    Fred ;
+'; print STDERR $@ ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'subs' ;
+eval '
+    no strict ;
+    my $a = Fred ;
+'; print STDERR $@;
+my $a = Fred ;
+EXPECT
+Bareword "Fred" not allowed while "strict subs" in use at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# see if Foo->Bar(...) etc work under strictures
+use strict;
+package Foo; sub Bar { print "@_\n" }
+Foo->Bar('a',1);
+Bar Foo ('b',2);
+Foo->Bar(qw/c 3/);
+Bar Foo (qw/d 4/);
+Foo::->Bar('A',1);
+Bar Foo:: ('B',2);
+Foo::->Bar(qw/C 3/);
+Bar Foo:: (qw/D 4/);
+EXPECT
+Foo a 1
+Foo b 2
+Foo c 3
+Foo d 4
+Foo A 1
+Foo B 2
+Foo C 3
+Foo D 4
diff --git a/lib/strict/vars b/lib/strict/vars
new file mode 100644
index 0000000000..40b55572b8
--- /dev/null
+++ b/lib/strict/vars
@@ -0,0 +1,410 @@
+Check strict vars functionality
+
+__END__
+
+# no strict, should build & run ok.
+Fred ;
+my $fred ;
+$b = "fred" ;
+$a = $$b ;
+EXPECT
+
+########
+
+use strict qw(subs refs) ;
+$fred ;
+EXPECT
+
+########
+
+use strict ;
+no strict 'vars' ;
+$fred ;
+EXPECT
+
+########
+
+# strict vars - no error
+use strict 'vars' ;
+use vars qw( $freddy) ;
+BEGIN { *freddy = \$joe::shmoe; }
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars - no error
+use strict 'vars' ;
+use vars qw( $freddy) ;
+local $abc::joe ;
+my $fred ;
+my $b = \$fred ;
+$Fred::ABC = 1 ;
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars - error
+use strict ;
+$fred ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict vars - error
+use strict 'vars' ;
+<$fred> ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# strict vars - error
+use strict 'vars' ;
+local $fred ;
+EXPECT
+Global symbol "$fred" requires explicit package name at - line 4.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+use strict 'vars' ;
+{
+    no strict ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 8.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check compile time scope of strict vars pragma
+no strict;
+{
+    use strict 'vars' ;
+    $joe = 1 ;
+}
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+--FILE-- abc
+$joe = 1 ;
+1;
+--FILE-- 
+use strict 'vars' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'vars' ;
+1;
+--FILE-- 
+require "./abc";
+$joe = 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use strict 'vars' ;
+$joe = 1 ;
+1;
+--FILE-- 
+$joe = 1 ;
+require "./abc";
+EXPECT
+Variable "$joe" is not imported at ./abc line 2.
+Global symbol "$joe" requires explicit package name at ./abc line 2.
+Compilation failed in require at - line 2.
+########
+
+--FILE-- abc.pm
+use strict 'vars' ;
+$joe = 1 ;
+1;
+--FILE-- 
+$joe = 1 ;
+use abc;
+EXPECT
+Variable "$joe" is not imported at abc.pm line 2.
+Global symbol "$joe" requires explicit package name at abc.pm line 2.
+Compilation failed in require at - line 2.
+BEGIN failed--compilation aborted at - line 2.
+########
+
+--FILE-- abc.pm
+package Burp;
+use strict;
+$a = 1;$f = 1;$k = 1; # just to get beyond the limit...
+$b = 1;$g = 1;$l = 1;
+$c = 1;$h = 1;$m = 1;
+$d = 1;$i = 1;$n = 1;
+$e = 1;$j = 1;$o = 1;
+$p = 0b12;
+--FILE-- 
+use abc;
+EXPECT
+Global symbol "$f" requires explicit package name at abc.pm line 3.
+Global symbol "$k" requires explicit package name at abc.pm line 3.
+Global symbol "$g" requires explicit package name at abc.pm line 4.
+Global symbol "$l" requires explicit package name at abc.pm line 4.
+Global symbol "$c" requires explicit package name at abc.pm line 5.
+Global symbol "$h" requires explicit package name at abc.pm line 5.
+Global symbol "$m" requires explicit package name at abc.pm line 5.
+Global symbol "$d" requires explicit package name at abc.pm line 6.
+Global symbol "$i" requires explicit package name at abc.pm line 6.
+Global symbol "$n" requires explicit package name at abc.pm line 6.
+Global symbol "$e" requires explicit package name at abc.pm line 7.
+Global symbol "$j" requires explicit package name at abc.pm line 7.
+Global symbol "$o" requires explicit package name at abc.pm line 7.
+Global symbol "$p" requires explicit package name at abc.pm line 8.
+Illegal binary digit '2' at abc.pm line 8, at end of line
+abc.pm has too many errors.
+Compilation failed in require at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval {
+    use strict 'vars' ;
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 6.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval {
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 5.
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval {
+    no strict ;
+    $joe = 1 ;
+};
+print STDERR $@;
+$joe = 1 ;
+EXPECT
+Variable "$joe" is not imported at - line 9.
+Global symbol "$joe" requires explicit package name at - line 9.
+Execution of - aborted due to compilation errors.
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval '
+    $joe = 1 ;
+'; print STDERR $@ ;
+$joe = 1 ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no strict ;
+eval q[ 
+    use strict 'vars' ;
+    $joe = 1 ;
+]; print STDERR $@;
+EXPECT
+Global symbol "$joe" requires explicit package name at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval '
+    $joe = 1 ;
+'; print STDERR $@ ;
+EXPECT
+Global symbol "$joe" requires explicit package name at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use strict 'vars' ;
+eval '
+    no strict ;
+    $joe = 1 ;
+'; print STDERR $@;
+$joe = 1 ;
+EXPECT
+Global symbol "$joe" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# Check if multiple evals produce same errors
+use strict 'vars';
+my $ret = eval q{ print $x; };
+print $@;
+print "ok 1\n" unless defined $ret;
+$ret = eval q{ print $x; };
+print $@;
+print "ok 2\n" unless defined $ret;
+EXPECT
+Global symbol "$x" requires explicit package name at (eval 1) line 1.
+ok 1
+Global symbol "$x" requires explicit package name at (eval 2) line 1.
+ok 2
+########
+
+# strict vars with outer our - no error
+use strict 'vars' ;
+our $freddy;
+local $abc::joe ;
+my $fred ;
+my $b = \$fred ;
+$Fred::ABC = 1 ;
+$freddy = 2 ;
+EXPECT
+
+########
+
+# strict vars with inner our - no error
+use strict 'vars' ;
+sub foo {
+    our $fred;
+    $fred;
+}
+EXPECT
+
+########
+
+# strict vars with outer our, inner use - no error
+use strict 'vars' ;
+our $fred;
+sub foo {
+    $fred;
+}
+EXPECT
+
+########
+
+# strict vars with nested our - no error
+use strict 'vars' ;
+our $fred;
+sub foo {
+    our $fred;
+    $fred;
+}
+$fred ;
+EXPECT
+
+########
+
+# strict vars with elapsed our - error
+use strict 'vars' ;
+sub foo {
+    our $fred;
+    $fred;
+}
+$fred ;
+EXPECT
+Variable "$fred" is not imported at - line 8.
+Global symbol "$fred" requires explicit package name at - line 8.
+Execution of - aborted due to compilation errors.
+########
+
+# nested our with local - no error
+$fred = 1;
+use strict 'vars';
+{
+    local our $fred = 2;
+    print $fred,"\n";
+}
+print our $fred,"\n";
+EXPECT
+2
+1
+########
+
+# "nailed" our declaration visibility across package boundaries
+use strict 'vars';
+our $foo;
+$foo = 20;
+package Foo;
+print $foo, "\n";
+EXPECT
+20
+########
+
+# multiple our declarations in same scope, different packages, no warning
+use strict 'vars';
+use warnings;
+our $foo;
+${foo} = 10;
+package Foo;
+our $foo = 20;
+print $foo, "\n";
+EXPECT
+20
+########
+
+# multiple our declarations in same scope, same package, warning
+use strict 'vars';
+use warnings;
+our $foo;
+${foo} = 10;
+our $foo;
+EXPECT
+"our" variable $foo masks earlier declaration in same scope at - line 7.
+########
+
+# multiple our declarations in same scope, same package, warning
+use strict 'vars';
+use warnings;
+{ our $x = 1 }
+{ our $x = 0 }
+our $foo;
+{
+    our $foo;
+    package Foo;
+    our $foo;
+}
+EXPECT
+"our" variable $foo redeclared at - line 9.
+	(Did you mean "local" instead of "our"?)
+Name "Foo::foo" used only once: possible typo at - line 11.
+########
+
+# Make sure the strict vars failure still occurs
+# now that the `@i should be written as \@i' failure does not occur
+# 20000522 mjd@plover.com (MJD)
+use strict 'vars';
+no warnings;
+"@i_like_crackers";
+EXPECT
+Global symbol "@i_like_crackers" requires explicit package name at - line 7.
+Execution of - aborted due to compilation errors.
diff --git a/lib/subs.t b/lib/subs.t
new file mode 100644
index 0000000000..2f684b41ed
--- /dev/null
+++ b/lib/subs.t
@@ -0,0 +1,162 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+undef $/;
+my @prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_NetWare = $^O eq 'NetWare';
+my $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
+
+for (@prgs){
+    my $switch = "";
+    my @temps = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+	shift @files ;
+	die "Internal error test $i didn't split into pairs, got " . 
+		scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+	    if @files % 2 ;
+	while (@files > 2) {
+	    my $filename = shift @files ;
+	    my $code = shift @files ;
+    	    push @temps, $filename ;
+	    open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+	    print F $code ;
+	    close F ;
+	}
+	shift @files ;
+	$prog = shift @files ;
+    }
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
+    close TEST;
+    my $results = $Is_VMS ?
+                  `./perl $switch $tmpfile 2>&1` :
+		  $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+		  $Is_NetWare ?
+                  `perl -I../lib $switch $tmpfile 2>&1` :
+                  `./perl $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+    $results =~ s/^(syntax|parse) error/syntax error/mig;
+    $expected =~ s/\n+$//;
+    my $prefix = ($results =~ s/^PREFIX\n//) ;
+    if ( $results =~ s/^SKIPPED\n//) {
+	print "$results\n" ;
+    }
+    elsif (($prefix and $results !~ /^\Q$expected/) or
+	   (!$prefix and $results ne $expected)){
+        print STDERR "PROG: $switch\n$prog\n";
+        print STDERR "EXPECTED:\n$expected\n";
+        print STDERR "GOT:\n$results\n";
+        print "not ";
+    }
+    print "ok ", ++$i, "\n";
+    foreach (@temps) 
+	{ unlink $_ if $_ } 
+}
+
+__END__
+
+# Error - not predeclaring a sub
+Fred 1,2 ;
+sub Fred {}
+EXPECT
+Number found where operator expected at - line 3, near "Fred 1"
+	(Do you need to predeclare Fred?)
+syntax error at - line 3, near "Fred 1"
+Execution of - aborted due to compilation errors.
+########
+
+# Error - not predeclaring a sub in time
+Fred 1,2 ;
+use subs qw( Fred ) ;
+sub Fred {}
+EXPECT
+Number found where operator expected at - line 3, near "Fred 1"
+	(Do you need to predeclare Fred?)
+syntax error at - line 3, near "Fred 1"
+BEGIN not safe after errors--compilation aborted at - line 4.
+########
+
+# AOK
+use subs qw( Fred) ;
+Fred 1,2 ;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function
+use subs qw( open ) ;
+open 1,2 ;
+sub open { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function, call after definition
+use subs qw( open ) ;
+sub open { print $_[0] + $_[1], "\n" }
+open 1,2 ;
+EXPECT
+3
+########
+
+# override a built-in function, call with ()
+use subs qw( open ) ;
+open (1,2) ;
+sub open { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# override a built-in function, call with () after definition
+use subs qw( open ) ;
+sub open { print $_[0] + $_[1], "\n" }
+open (1,2) ;
+EXPECT
+3
+########
+
+--FILE-- abc
+Fred 1,2 ;
+1;
+--FILE--
+use subs qw( Fred ) ;
+require "./abc" ;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3
+########
+
+# check that it isn't affected by block scope
+{
+    use subs qw( Fred ) ;
+}
+Fred 1, 2;
+sub Fred { print $_[0] + $_[1], "\n" }
+EXPECT
+3
diff --git a/lib/utf8.t b/lib/utf8.t
new file mode 100644
index 0000000000..850470e0e8
--- /dev/null
+++ b/lib/utf8.t
@@ -0,0 +1,103 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# NOTE!
+#
+# Think carefully before adding tests here.  In general this should be
+# used only for about three categories of tests:
+#
+# (1) tests that absolutely require 'use utf8', and since that in general
+#     shouldn't be needed as the utf8 is being obsoleted, this should
+#     have rather few tests.  If you want to test Unicode and regexes,
+#     you probably want to go to op/regexp or op/pat; if you want to test
+#     split, go to op/split; pack, op/pack; appending or joining,
+#     op/append or op/join, and so forth
+#
+# (2) tests that have to do with Unicode tokenizing (though it's likely
+#     that all the other Unicode tests sprinkled around the t/**/*.t are
+#     going to catch that)
+#
+# (3) complicated tests that simultaneously stress so many Unicode features
+#     that deciding into which other test script the tests should go to
+#     is hard -- maybe consider breaking up the complicated test
+#
+#
+
+use Test;
+plan tests => 15;
+
+{
+    # bug id 20001009.001
+
+    my ($a, $b);
+
+    { use bytes; $a = "\xc3\xa4" }
+    { use utf8;  $b = "\xe4"     }
+
+    my $test = 68;
+
+    ok($a ne $b);
+
+    { use utf8; ok($a ne $b) }
+}
+
+
+{
+    # bug id 20000730.004
+
+    my $smiley = "\x{263a}";
+
+    for my $s ("\x{263a}",
+	       $smiley,
+		
+	       "" . $smiley,
+	       "" . "\x{263a}",
+
+	       $smiley    . "",
+	       "\x{263a}" . "",
+	       ) {
+	my $length_chars = length($s);
+	my $length_bytes;
+	{ use bytes; $length_bytes = length($s) }
+	my @regex_chars = $s =~ m/(.)/g;
+	my $regex_chars = @regex_chars;
+	my @split_chars = split //, $s;
+	my $split_chars = @split_chars;
+	ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
+	   "1/1/1/3");
+    }
+
+    for my $s ("\x{263a}" . "\x{263a}",
+	       $smiley    . $smiley,
+
+	       "\x{263a}\x{263a}",
+	       "$smiley$smiley",
+	       
+	       "\x{263a}" x 2,
+	       $smiley    x 2,
+	       ) {
+	my $length_chars = length($s);
+	my $length_bytes;
+	{ use bytes; $length_bytes = length($s) }
+	my @regex_chars = $s =~ m/(.)/g;
+	my $regex_chars = @regex_chars;
+	my @split_chars = split //, $s;
+	my $split_chars = @split_chars;
+	ok("$length_chars/$regex_chars/$split_chars/$length_bytes" eq
+	   "2/2/2/6");
+    }
+}
+
+
+{
+    my $w = 0;
+    local $SIG{__WARN__} = sub { print "#($_[0])\n"; $w++ };
+    my $x = eval q/"\\/ . "\x{100}" . q/"/;;
+   
+    ok($w == 0 && $x eq "\x{100}");
+}
+
diff --git a/lib/vars.t b/lib/vars.t
new file mode 100644
index 0000000000..3075f8e5ff
--- /dev/null
+++ b/lib/vars.t
@@ -0,0 +1,105 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';
+}
+
+$| = 1;
+
+print "1..27\n";
+
+# catch "used once" warnings
+my @warns;
+BEGIN { $SIG{__WARN__} = sub { push @warns, @_ }; $^W = 1 };
+
+%x = ();
+$y = 3;
+@z = ();
+$X::x = 13;
+
+use vars qw($p @q %r *s &t $X::p);
+
+my $e = !(grep /^Name "X::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 1\n";
+$e = !(grep /^Name "main::x" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 2\n";
+$e = !(grep /^Name "main::y" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 3\n";
+$e = !(grep /^Name "main::z" used only once: possible typo/, @warns) && 'not ';
+print "${e}ok 4\n";
+($e, @warns) = @warns != 4 && 'not ';
+print "${e}ok 5\n";
+
+# this is inside eval() to avoid creation of symbol table entries and
+# to avoid "used once" warnings
+eval <<'EOE';
+$e = ! $main::{p} && 'not ';
+print "${e}ok 6\n";
+$e = ! *q{ARRAY} && 'not ';
+print "${e}ok 7\n";
+$e = ! *r{HASH} && 'not ';
+print "${e}ok 8\n";
+$e = ! $main::{s} && 'not ';
+print "${e}ok 9\n";
+$e = ! *t{CODE} && 'not ';
+print "${e}ok 10\n";
+$e = defined $X::{q} && 'not ';
+print "${e}ok 11\n";
+$e = ! $X::{p} && 'not ';
+print "${e}ok 12\n";
+EOE
+$e = $@ && 'not ';
+print "${e}ok 13\n";
+
+eval q{use vars qw(@X::y !abc); $e = ! *X::y{ARRAY} && 'not '};
+print "${e}ok 14\n";
+$e = $@ !~ /^'!abc' is not a valid variable name/ && 'not ';
+print "${e}ok 15\n";
+
+eval 'use vars qw($x[3])';
+$e = $@ !~ /^Can't declare individual elements of hash or array/ && 'not ';
+print "${e}ok 16\n";
+
+{ local $^W;
+  eval 'use vars qw($!)';
+  ($e, @warns) = ($@ || @warns) ? 'not ' : '';
+  print "${e}ok 17\n";
+};
+
+# NB the next test only works because vars.pm has already been loaded
+eval 'use warnings "vars"; use vars qw($!)';
+$e = ($@ || (shift(@warns)||'') !~ /^No need to declare built-in vars/)
+			&& 'not ';
+print "${e}ok 18\n";
+
+no strict 'vars';
+eval 'use vars qw(@x%%)';
+$e = $@ && 'not ';
+print "${e}ok 19\n";
+$e = ! *{'x%%'}{ARRAY} && 'not ';
+print "${e}ok 20\n";
+eval '$u = 3; @v = (); %w = ()';
+$e = $@ && 'not ';
+print "${e}ok 21\n";
+
+use strict 'vars';
+eval 'use vars qw(@y%%)';
+$e = $@ !~ /^'\@y%%' is not a valid variable name under strict vars/ && 'not ';
+print "${e}ok 22\n";
+$e = *{'y%%'}{ARRAY} && 'not ';
+print "${e}ok 23\n";
+eval '$u = 3; @v = (); %w = ()';
+my @errs = split /\n/, $@;
+$e = @errs != 3 && 'not ';
+print "${e}ok 24\n";
+$e = !(grep(/^Global symbol "\$u" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 25\n";
+$e = !(grep(/^Global symbol "\@v" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 26\n";
+$e = !(grep(/^Global symbol "\%w" requires explicit package name/, @errs))
+			&& 'not ';
+print "${e}ok 27\n";
diff --git a/lib/warnings/1global b/lib/warnings/1global
new file mode 100644
index 0000000000..0af80221b2
--- /dev/null
+++ b/lib/warnings/1global
@@ -0,0 +1,189 @@
+Check existing $^W functionality
+
+
+__END__
+
+# warnable code, warnings disabled
+$a =+ 3 ;
+EXPECT
+
+########
+-w
+# warnable code, warnings enabled via command line switch
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 4.
+Name "main::a" used only once: possible typo at - line 4.
+########
+
+# compile-time warnable code, warnings enabled via runtime $^W
+# so no warning printed.
+$^W = 1 ;
+$a =+ 3 ;
+EXPECT
+
+########
+
+# warnable code, warnings enabled via runtime $^W
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+# warnings enabled at compile time, disabled at run time
+BEGIN { $^W = 1 }
+$^W = 0 ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# warnings disabled at compile time, enabled at run time
+BEGIN { $^W = 0 }
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+$^W = 0;
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+
+########
+
+--FILE-- abcd
+$^W = 1;
+1 ;
+--FILE-- 
+$^W =0 ;
+require "./abcd";
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+$^W = 1;
+eval 'my $b ; chop $b ;' ;
+print $@ ;
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 1.
+########
+
+eval '$^W = 1;' ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+eval {$^W = 1;} ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+{
+    local ($^W) = 1;
+}
+my $b ; chop $b ;
+EXPECT
+
+########
+
+my $a ; chop $a ;
+{
+    local ($^W) = 1;
+    my $b ; chop $b ;
+}
+my $c ; chop $c ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value in -e at - line 2.
+########
+
+$^W = 1 + 2 ;
+EXPECT
+
+########
+
+$^W = $a ;
+EXPECT
+
+########
+
+sub fred {}
+$^W = fred() ;
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 0 ;
+  fred() ;
+}
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 1 ;
+  fred() ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 2.
diff --git a/lib/warnings/2use b/lib/warnings/2use
new file mode 100644
index 0000000000..e25d43adbb
--- /dev/null
+++ b/lib/warnings/2use
@@ -0,0 +1,354 @@
+Check lexical warnings functionality
+
+TODO
+  check that the warning hierarchy works.
+
+__END__
+
+#  check illegal category is caught
+use warnings 'this-should-never-be-a-warning-category' ;
+EXPECT
+unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
+BEGIN failed--compilation aborted at - line 3.
+########
+
+# Check compile time scope of pragma
+use warnings 'syntax' ;
+{
+    no warnings ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check compile time scope of pragma
+no warnings;
+{
+    use warnings 'syntax' ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 6.
+########
+
+# Check runtime scope of pragma
+use warnings 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+use warnings 'syntax' ;
+my $a =+ 1 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+
+--FILE-- abc
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+1;
+--FILE-- 
+require "./abc";
+my $a =+ 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'syntax' ;
+my $a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 7.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval {
+        no warnings ;
+        my $b ; chop $b ;
+    }; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval {
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval {
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 7.
+Reversed += operator at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval {
+        no warnings ;
+        my $a =+ 1 ;
+    }; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    ]; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 9.
+Reversed += operator at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+########
+
+# Check the additive nature of the pragma
+my $a =+ 1 ;
+my $a ; chop $a ;
+use warnings 'syntax' ;
+$a =+ 1 ;
+my $b ; chop $b ;
+use warnings 'uninitialized' ;
+my $c ; chop $c ;
+no warnings 'syntax' ;
+$a =+ 1 ;
+EXPECT
+Reversed += operator at - line 6.
+Use of uninitialized value in scalar chop at - line 9.
diff --git a/lib/warnings/3both b/lib/warnings/3both
new file mode 100644
index 0000000000..a4d9ba806d
--- /dev/null
+++ b/lib/warnings/3both
@@ -0,0 +1,266 @@
+Check interaction of $^W and lexical
+
+__END__
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 0 }
+fred() ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 1 }
+fred() ;
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 0 }
+{
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 0 }
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check scope of pragma with eval
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
diff --git a/lib/warnings/4lint b/lib/warnings/4lint
new file mode 100644
index 0000000000..848822dd30
--- /dev/null
+++ b/lib/warnings/4lint
@@ -0,0 +1,216 @@
+Check lint
+
+__END__
+-W
+# lint: check compile time $^W is zapped
+BEGIN { $^W = 0 ;}
+$a = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Reversed += operator at - line 5.
+print() on closed filehandle STDIN at - line 6.
+########
+-W
+# lint: check runtime $^W is zapped
+$^W = 0 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+print() on closed filehandle STDIN at - line 4.
+########
+-W
+# lint: check runtime $^W is zapped
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-W
+# lint: check "no warnings" is zapped
+no warnings ;
+$a = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Reversed += operator at - line 5.
+print() on closed filehandle STDIN at - line 6.
+########
+-W
+# lint: check "no warnings" is zapped
+{
+  no warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-Ww
+# lint: check combination of -w and -W
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle STDIN at - line 5.
+########
+-W
+--FILE-- abc.pm
+no warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+no warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc.pm
+BEGIN {$^W = 0}
+my $a = 0 ;
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 0 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+BEGIN {$^W = 0}
+my $a = 0 ;
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 0 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Reversed += operator at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+# Check scope of pragma with eval
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 8.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 9.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+Use of uninitialized value in scalar chop at - line 10.
+########
+-W
+# Check scope of pragma with eval
+use warnings;
+{
+    my $a = "1"; my $b = "2";
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        $a =+ 1 ;
+    ]; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 11.
+Reversed += operator at (eval 1) line 3.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'syntax' ;
+    eval '
+        $a =+ 1 ;
+    '; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 10.
+Reversed += operator at (eval 1) line 2.
+########
+-W
+# Check scope of pragma with eval
+no warnings;
+{
+    my $a = "1"; my $b = "2";
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        $a =+ 1 ;
+    '; print STDERR $@;
+    $a =+ 1 ;
+}
+EXPECT
+Reversed += operator at - line 11.
+Reversed += operator at (eval 1) line 3.
diff --git a/lib/warnings/5nolint b/lib/warnings/5nolint
new file mode 100644
index 0000000000..56158a20be
--- /dev/null
+++ b/lib/warnings/5nolint
@@ -0,0 +1,204 @@
+syntax anti-lint
+
+__END__
+-X
+# nolint: check compile time $^W is zapped
+BEGIN { $^W = 1 ;}
+$a = $b = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+$^W = 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+use warnings ;
+$a = $b = 1 ;
+$a =+ 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+{
+  use warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-Xw
+# nolint: check combination of -w and -X
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+--FILE-- abc.pm
+use warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+use warnings 'syntax' ;
+my $a = 0;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc.pm
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 1 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+$a =+ 1 ;
+1;
+--FILE-- 
+$^W = 1 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'uninitialized' ;
+        my $b ; chop $b ;
+    ]; print STDERR $@;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'uninitialized' ;
+    eval '
+        no warnings ;
+        my $b ; chop $b ;
+    '; print STDERR $@ ;
+    my $b ; chop $b ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@ ;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings 'syntax' ;
+        my $a =+ 1 ;
+    ]; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+
+########
+-X
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'syntax' ;
+    eval '
+        no warnings ;
+        my $a =+ 1 ;
+    '; print STDERR $@;
+    my $a =+ 1 ;
+}
+EXPECT
+
diff --git a/lib/warnings/6default b/lib/warnings/6default
new file mode 100644
index 0000000000..a8aafeeb22
--- /dev/null
+++ b/lib/warnings/6default
@@ -0,0 +1,121 @@
+Check default warnings
+
+__END__
+# default warnings should be displayed if you don't add anything
+# optional shouldn't
+my $a = oct "7777777777777777777777777777777777779" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# no warnings should be displayed 
+no warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+########
+# check scope
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+{
+    no warnings ;
+    my $a = oct "7777777777777777777777777777777777778" ;
+}    
+my $c = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+Integer overflow in octal number at - line 8.
+Illegal octal digit '8' ignored at - line 8.
+Octal number > 037777777777 non-portable at - line 8.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0xfffffffffffffffffg" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+Illegal hexadecimal digit 'g' ignored at - line 3.
+Hexadecimal number > 0xffffffff non-portable at - line 3.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
+EXPECT
+Integer overflow in binary number at - line 3.
+Illegal binary digit '2' ignored at - line 3.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval '
+	my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+use warnings;
+{
+    no warnings ;
+    eval q[ 
+        use warnings ;
+	my $a = oct "0xfffffffffffffffffg" ;
+    ]; print STDERR $@;
+    my $a = oct "0xfffffffffffffffffg" ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 3.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 3.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings ;
+    eval '
+	my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+Integer overflow in hexadecimal number at (eval 1) line 2.
+Illegal hexadecimal digit 'g' ignored at (eval 1) line 2.
+Hexadecimal number > 0xffffffff non-portable at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings;
+    eval '
+        no warnings ;
+	my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@ ;
+}
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings;
+{
+    use warnings 'deprecated' ;
+    eval '
+	my $a = oct "0xfffffffffffffffffg" ;
+    '; print STDERR $@;
+}
+EXPECT
+
diff --git a/lib/warnings/7fatal b/lib/warnings/7fatal
new file mode 100644
index 0000000000..a25fa2c2ea
--- /dev/null
+++ b/lib/warnings/7fatal
@@ -0,0 +1,312 @@
+Check FATAL functionality
+
+__END__
+
+# Check compile time warning
+use warnings FATAL => 'syntax' ;
+{
+    no warnings ;
+    $a =+ 1 ;
+}
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check compile time warning
+use warnings FATAL => 'all' ;
+{
+    no warnings ;
+    my $a =+ 1 ;
+}
+my $a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check runtime scope of pragma
+use warnings FATAL => 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+use warnings FATAL => 'all' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings FATAL => 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings FATAL => 'all' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+--FILE-- abc
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'syntax' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings FATAL => 'syntax' ;
+1;
+--FILE-- 
+require "./abc";
+$a =+ 1 ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'syntax' ;
+$a =+ 1 ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 6.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    no warnings ;
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'syntax' ;
+    $a =+ 1 ;
+}; print STDERR "-- $@" ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 6.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval {
+    $a =+ 1 ;
+}; print STDERR "-- $@" ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 5.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval {
+    no warnings ;
+    $a =+ 1 ;
+}; print STDERR $@ ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'syntax' ;
+}; print STDERR $@ ;
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+The End.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+]; print STDERR "-- $@";
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    my $b ; chop $b ;
+'; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    no warnings ;
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'syntax' ;
+    $a =+ 1 ;
+]; print STDERR "-- $@";
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Reversed += operator at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval '
+    $a =+ 1 ;
+'; print STDERR "-- $@";
+print STDERR "The End.\n" ;
+EXPECT
+-- Reversed += operator at (eval 1) line 2.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'syntax' ;
+eval '
+    no warnings ;
+    $a =+ 1 ;
+'; print STDERR "-- $@";
+$a =+ 1 ;
+print STDERR "The End.\n" ;
+EXPECT
+Reversed += operator at - line 8.
+########
+
+use warnings 'void' ;
+
+time ;
+
+{
+    use warnings FATAL => qw(void) ;
+    length "abc" ;
+}
+
+join "", 1,2,3 ;
+
+print "done\n" ;
+EXPECT
+Useless use of time in void context at - line 4.
+Useless use of length in void context at - line 8.
+########
+
+use warnings ;
+
+time ;
+
+{
+    use warnings FATAL => qw(void) ;
+    length "abc" ;
+}
+
+join "", 1,2,3 ;
+
+print "done\n" ;
+EXPECT
+Useless use of time in void context at - line 4.
+Useless use of length in void context at - line 8.
diff --git a/lib/warnings/8signal b/lib/warnings/8signal
new file mode 100644
index 0000000000..cc1b9d926d
--- /dev/null
+++ b/lib/warnings/8signal
@@ -0,0 +1,18 @@
+Check interaction of __WARN__, __DIE__ & lexical Warnings
+
+TODO
+
+__END__
+# 8signal
+BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } }
+BEGIN { $SIG{__DIE__}  = sub { print "DIE -- @_" } }
+$a =+ 1 ;
+use warnings qw(syntax) ;
+$a =+ 1 ;
+use warnings FATAL => qw(syntax) ;
+$a =+ 1 ;
+print "The End.\n" ;
+EXPECT
+WARN -- Reversed += operator at - line 6.
+DIE -- Reversed += operator at - line 8.
+Reversed += operator at - line 8.
diff --git a/lib/warnings/9enabled b/lib/warnings/9enabled
new file mode 100755
index 0000000000..f5579b2dde
--- /dev/null
+++ b/lib/warnings/9enabled
@@ -0,0 +1,1162 @@
+Check warnings::enabled & warnings::warn
+
+__END__
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'syntax' ;
+print "ok1\n" if   warnings::enabled('io') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+print "ok3\n" if   warnings::enabled("io") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+no warnings;
+use abc ;
+1;
+--FILE-- 
+use warnings;
+use def ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+print "ok3\n" if !warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+use warnings 'syntax' ;
+print "ok4\n" if !warnings::enabled('all') ;
+print "ok5\n" if warnings::enabled("io") ;
+use abc ;
+1;
+--FILE--
+use warnings 'io' ;
+use def ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+  print "ok3\n" if warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { use warnings 'io' ; abc::check() ; };
+abc::check() ; 
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+# check warnings::warn
+use warnings ;
+eval { warnings::warn() } ;
+print $@ ;
+eval { warnings::warn("fred", "joe") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warn([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+########
+
+# check warnings::warnif
+use warnings ;
+eval { warnings::warnif() } ;
+print $@ ;
+eval { warnings::warnif("fred", "joe") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warnif([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("misc", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL deprecated ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+	eval {...} called at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL io ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+	eval {...} called at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if warnings::enabled("io") ;
+print "ok2\n" if warnings::enabled("all") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if !warnings::enabled("io") ;
+print "ok2\n" if !warnings::enabled("all") ;
+1;
+--FILE-- 
+use warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok\n" if ! warnings::enabled() ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  warnings::warn("fred") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  warnings::warnif("fred") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at abc.pm line 4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if warnings::enabled ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings "abc" ;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL deprecated ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+	eval {...} called at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL abc ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+	eval {...} called at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use warnings 'all';
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  warnings::warnif("my message 1") ;
+  warnings::warnif('abc', "my message 2") ;
+  warnings::warnif('io', "my message 3") ;
+  warnings::warnif('all', "my message 4") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
+  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- def.pm
+package def ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
+  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- 
+use abc ;
+use def ;
+use warnings 'abc';
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+no warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings;
+abc::check() ;
+def::check() ;
+no warnings 'abc' ;
+abc::check() ;
+def::check() ;
+EXPECT
+abc self enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all enabled
+def self enabled
+def abc enabled
+def all enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-w
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  warnings::warnif("my message 1") ;
+  warnings::warnif('abc', "my message 2") ;
+  warnings::warnif('io', "my message 3") ;
+  warnings::warnif('all', "my message 4") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+BEGIN { $^W = 1 ; }
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+$^W = 1 ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('abc', "my message 3") ;
+  warnings::warnif('io', "my message 4") ;
+  warnings::warnif('all', "my message 5") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+abc::in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+my message 1 at - line 3
+my message 2 at - line 3
+my message 3 at - line 3
+########
+
+--FILE-- def.pm
+package def ;
+no warnings ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("def") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('def', "my message 3") ;
+  warnings::warnif('io', "my message 4") ;
+  warnings::warnif('all', "my message 5") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+use def ;
+use warnings 'def';
+sub in1 { def::in1() ; }
+1;
+--FILE-- 
+use abc ;
+no warnings;
+abc::in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+my message 1 at abc.pm line 5
+	abc::in1() called at - line 3
+my message 2 at abc.pm line 5
+	abc::in1() called at - line 3
+my message 3 at abc.pm line 5
+	abc::in1() called at - line 3
+########
+
+--FILE-- def.pm
+$| = 1;
+package def ;
+no warnings ;
+use warnings::register ;
+require Exporter;
+@ISA = qw( Exporter ) ;
+@EXPORT = qw( in1 ) ;
+sub check { 
+  print "ok1\n" if  warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  print "ok5\n" if !warnings::enabled("def") ;
+  warnings::warn("my message 1") ;
+  warnings::warnif("my message 2") ;
+  warnings::warnif('abc', "my message 3") ;
+  warnings::warnif('def', "my message 4") ;
+  warnings::warnif('io', "my message 5") ;
+  warnings::warnif('all', "my message 6") ;
+}
+sub in2 { no warnings ; check() }
+sub in1 { no warnings ; in2() }
+1;
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+use def ;
+#@ISA = qw(def) ;
+1;
+--FILE-- 
+use abc ;
+no warnings;
+use warnings 'abc';
+abc::in1() ;
+EXPECT
+ok2
+ok3
+ok4
+ok5
+my message 1 at - line 4
+my message 3 at - line 4
+########
+
+--FILE-- def.pm
+package def ;
+no warnings ;
+use warnings::register ;
+
+sub new
+{
+    my $class = shift ;
+    bless [], $class ;
+}
+
+sub check 
+{ 
+  my $self = shift ;
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+  print "ok4\n" if  warnings::enabled("abc") ;
+  print "ok5\n" if !warnings::enabled("def") ;
+  print "ok6\n" if  warnings::enabled($self) ;
+
+  warnings::warn("my message 1") ;
+  warnings::warn($self, "my message 2") ;
+
+  warnings::warnif("my message 3") ;
+  warnings::warnif('abc', "my message 4") ;
+  warnings::warnif('def', "my message 5") ;
+  warnings::warnif('io', "my message 6") ;
+  warnings::warnif('all', "my message 7") ;
+  warnings::warnif($self, "my message 8") ;
+}
+sub in2 
+{
+  no warnings ; 
+  my $self = shift ;
+  $self->check() ;
+}
+sub in1 
+{ 
+  no warnings ;
+  my $self = shift ;
+  $self->in2();
+}
+1;
+--FILE-- abc.pm
+$| = 1;
+package abc ;
+use warnings::register ;
+use def ;
+@ISA = qw(def) ;
+sub new
+{
+    my $class = shift ;
+    bless [], $class ;
+}
+
+1;
+--FILE-- 
+use abc ;
+no warnings;
+use warnings 'abc';
+$a = new abc ;
+$a->in1() ;
+print "**\n";
+$b = new def ;
+$b->in1() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+ok6
+my message 1 at - line 5
+my message 2 at - line 5
+my message 4 at - line 5
+my message 8 at - line 5
+**
+ok1
+ok2
+ok3
+ok4
+ok5
+my message 1 at - line 8
+my message 2 at - line 8
+my message 4 at - line 8
diff --git a/lib/warnings/av b/lib/warnings/av
new file mode 100644
index 0000000000..79bd3b7600
--- /dev/null
+++ b/lib/warnings/av
@@ -0,0 +1,9 @@
+  av.c	
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  av_reify called on tied array		[av_reify]
+
+  Attempt to clear deleted array	[av_clear]
+  
+__END__
diff --git a/lib/warnings/doio b/lib/warnings/doio
new file mode 100644
index 0000000000..2a357e2755
--- /dev/null
+++ b/lib/warnings/doio
@@ -0,0 +1,209 @@
+  doio.c	
+
+  Can't open bidirectional pipe		[Perl_do_open9]
+    open(F, "| true |");
+
+  Missing command in piped open		[Perl_do_open9]
+    open(F, "| ");
+
+  Missing command in piped open		[Perl_do_open9]
+    open(F, " |");
+
+  warn(warn_nl, "open");		[Perl_do_open9]
+    open(F, "true\ncd")
+
+  close() on unopened filehandle %s	[Perl_do_close]
+    $a = "fred";close("$a")
+
+  tell() on closed filehandle		[Perl_do_tell]
+    $a = "fred";$a = tell($a)
+
+  seek() on closed filehandle		[Perl_do_seek]
+    $a = "fred";$a = seek($a,1,1)
+
+  sysseek() on closed filehandle	[Perl_do_sysseek]
+    $a = "fred";$a = seek($a,1,1)
+
+  warn(warn_uninit);			[Perl_do_print]
+    print $a ;
+
+  -x on closed filehandle %s 		[Perl_my_stat]
+    close STDIN ; -x STDIN ;
+
+  warn(warn_nl, "stat");		[Perl_my_stat]
+    stat "ab\ncd"
+
+  warn(warn_nl, "lstat");		[Perl_my_lstat]
+    lstat "ab\ncd"
+
+  Can't exec \"%s\": %s 		[Perl_do_aexec5]
+
+  Can't exec \"%s\": %s 		[Perl_do_exec3]
+
+  Filehandle %s opened only for output	[Perl_do_eof]
+	my $a = eof STDOUT
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  Can't do inplace edit: %s is not a regular file	[Perl_nextargv]
+     edit a directory
+
+  Can't do inplace edit: %s would not be unique		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't remove %s: %s, skipping file			[Perl_nextargv]
+  Can't do inplace edit on %s: %s			[Perl_nextargv]
+  
+
+__END__
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(F);
+no warnings 'io' ;
+open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(G);
+EXPECT
+Can't open bidirectional pipe at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "|      ");
+no warnings 'io' ;
+open(G, "|      ");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "      |");
+no warnings 'io' ;
+open(G, "      |");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "<true\ncd");
+no warnings 'io' ;
+open(G, "<true\ncd");
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+close() on unopened filehandle fred at - line 3.
+########
+# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
+use warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+stat(STDIN) ;
+$a = "fred";
+tell($a);
+seek($a,1,1);
+sysseek($a,1,1);
+-x $a; # ok
+stat($a); # ok
+no warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+stat(STDIN) ;
+$a = "fred";
+tell($a);
+seek($a,1,1);
+sysseek($a,1,1);
+-x $a;
+stat($a);
+EXPECT
+tell() on closed filehandle STDIN at - line 4.
+seek() on closed filehandle STDIN at - line 5.
+sysseek() on closed filehandle STDIN at - line 6.
+-x on closed filehandle STDIN at - line 7.
+stat() on closed filehandle STDIN at - line 8.
+tell() on unopened filehandle at - line 10.
+seek() on unopened filehandle at - line 11.
+sysseek() on unopened filehandle at - line 12.
+########
+# doio.c [Perl_do_print]
+use warnings 'uninitialized' ;
+print $a ;
+no warnings 'uninitialized' ;
+print $b ;
+EXPECT
+Use of uninitialized value in print at - line 3.
+########
+# doio.c [Perl_my_stat Perl_my_lstat]
+use warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+no warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+Unsuccessful stat on filename containing newline at - line 4.
+########
+# doio.c [Perl_do_aexec5]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls": .+
+########
+# doio.c [Perl_do_exec3]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
+########
+# doio.c [Perl_nextargv]
+$^W = 0 ;
+my $filename = "./temp.dir" ;
+mkdir $filename, 0777 
+  or die "Cannot create directory $filename: $!\n" ;
+{
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    no warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    use warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+rmdir $filename ;
+EXPECT
+Can't do inplace edit: ./temp.dir is not a regular file at - line 9.
+Can't do inplace edit: ./temp.dir is not a regular file at - line 21.
+
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle STDOUT opened only for output at - line 3.
diff --git a/lib/warnings/doop b/lib/warnings/doop
new file mode 100644
index 0000000000..5803b44581
--- /dev/null
+++ b/lib/warnings/doop
@@ -0,0 +1,6 @@
+# doop.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+chop ;
+EXPECT
+########
diff --git a/lib/warnings/gv b/lib/warnings/gv
new file mode 100644
index 0000000000..5ed4eca018
--- /dev/null
+++ b/lib/warnings/gv
@@ -0,0 +1,54 @@
+  gv.c AOK
+
+     Can't locate package %s for @%s::ISA
+	@ISA = qw(Fred); joe()
+
+     Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
+	sub Other::AUTOLOAD { 1 } sub Other::fred {}
+	@ISA = qw(Other) ;
+	fred() ;
+
+     Use of $# is deprecated
+     Use of $* is deprecated
+
+	$a = ${"#"} ;
+ 	$a = ${"*"} ;
+
+  Mandatory Warnings ALL TODO
+  ------------------
+
+    Had to create %s unexpectedly		[gv_fetchpv]
+    Attempt to free unreferenced glob pointers	[gp_free]
+    
+__END__
+# gv.c
+use warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @main::ISA at - line 3.
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+no warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+sub Other::AUTOLOAD { 1 } sub Other::fred {}
+@ISA = qw(Other) ;
+use warnings 'deprecated' ;
+fred() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
+########
+# gv.c
+use warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+no warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+EXPECT
+Use of $# is deprecated at - line 3.
+Use of $* is deprecated at - line 4.
diff --git a/lib/warnings/hv b/lib/warnings/hv
new file mode 100644
index 0000000000..c9eec028f1
--- /dev/null
+++ b/lib/warnings/hv
@@ -0,0 +1,8 @@
+  hv.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Attempt to free non-existent shared string	[unsharepvn]
+
+__END__
diff --git a/lib/warnings/malloc b/lib/warnings/malloc
new file mode 100644
index 0000000000..2f8b096a51
--- /dev/null
+++ b/lib/warnings/malloc
@@ -0,0 +1,9 @@
+  malloc.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    %s free() ignored		[Perl_mfree]
+    %s", "Bad free() ignored	[Perl_mfree]
+
+__END__
diff --git a/lib/warnings/mg b/lib/warnings/mg
new file mode 100644
index 0000000000..f2243357b3
--- /dev/null
+++ b/lib/warnings/mg
@@ -0,0 +1,44 @@
+  mg.c	AOK
+
+  No such signal: SIG%s
+    $SIG{FRED} = sub {}
+
+  SIG%s handler \"%s\" not defined.
+    $SIG{"INT"} = "ok3"; kill "INT",$$;
+
+  Mandatory Warnings TODO
+  ------------------
+  Can't break at that line	[magic_setdbline]
+
+__END__
+# mg.c
+use warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+No such signal: SIGFRED at - line 3.
+########
+# mg.c
+no warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+
+########
+# mg.c
+use warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+SIGINT handler "fred" not defined.
+########
+# mg.c
+no warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+    print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+
diff --git a/lib/warnings/op b/lib/warnings/op
new file mode 100644
index 0000000000..2f847ad14c
--- /dev/null
+++ b/lib/warnings/op
@@ -0,0 +1,928 @@
+  op.c		AOK
+
+     "my" variable %s masks earlier declaration in same scope
+	my $x;
+	my $x ;
+
+     Variable "%s" may be unavailable 
+	sub x {
+      	    my $x;
+      	    sub y {
+         	$x
+      	    }
+   	}
+
+     Variable "%s" will not stay shared 
+	sub x {
+      	    my $x;
+      	    sub y {
+         	sub { $x }
+      	    }
+   	}
+
+     Found = in conditional, should be ==
+	1 if $a = 1 ;
+
+     Use of implicit split to @_ is deprecated
+	split ;
+
+     Use of implicit split to @_ is deprecated
+	$a = split ;
+
+     Useless use of time in void context
+     Useless use of a variable in void context
+     Useless use of a constant in void context
+	time ;
+	$a ;
+	"abc"
+
+     Applying %s to %s will act on scalar(%s)
+	my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+	@a =~ /abc/ ;
+	@a =~ s/a/b/ ;
+	@a =~ tr/a/b/ ;
+	@$b =~ /abc/ ;
+	@$b =~ s/a/b/ ;
+	@$b =~ tr/a/b/ ;
+	%a =~ /abc/ ;
+	%a =~ s/a/b/ ;
+	%a =~ tr/a/b/ ;
+	%$c =~ /abc/ ;
+	%$c =~ s/a/b/ ;
+	%$c =~ tr/a/b/ ;
+
+
+     Parentheses missing around "my" list at -e line 1.
+       my $a, $b = (1,2);
+ 
+     Parentheses missing around "local" list at -e line 1.
+       local $a, $b = (1,2);
+ 
+     Bareword found in conditional at -e line 1.
+       use warnings 'bareword'; my $x = print(ABC || 1);
+ 
+     Value of %s may be \"0\"; use \"defined\" 
+	$x = 1 if $x = <FH> ;
+	$x = 1 while $x = <FH> ;
+
+     Subroutine fred redefined at -e line 1.
+       sub fred{1;} sub fred{1;}
+ 
+     Constant subroutine %s redefined 
+        sub fred() {1;} sub fred() {1;}
+ 
+     Format FRED redefined at /tmp/x line 5.
+       format FRED =
+       .
+       format FRED =
+       .
+ 
+     Array @%s missing the @ in argument %d of %s() 
+	push fred ;
+ 
+     Hash %%%s missing the %% in argument %d of %s() 
+	keys joe ;
+ 
+     Statement unlikely to be reached
+     	(Maybe you meant system() when you said exec()?
+ 	exec "true" ; my $a
+
+     defined(@array) is deprecated
+     	(Maybe you should just omit the defined()?)
+	my @a ; defined @a ;
+	defined (@a = (1,2,3)) ;
+
+     defined(%hash) is deprecated
+     	(Maybe you should just omit the defined()?)
+	my %h ; defined %h ;
+    
+     /---/ should probably be written as "---"
+        join(/---/, @foo);
+
+    %s() called too early to check prototype		[Perl_peep]
+        fred() ; sub fred ($$) {}
+
+
+    Mandatory Warnings 
+    ------------------
+    Prototype mismatch:		[cv_ckproto]
+        sub fred() ;
+        sub fred($) {}
+
+    %s never introduced		[pad_leavemy]	TODO
+    Runaway prototype		[newSUB]	TODO
+    oops: oopsAV		[oopsAV]	TODO
+    oops: oopsHV		[oopsHV]	TODO
+    
+
+__END__
+# op.c
+use warnings 'misc' ;
+my $x ;
+my $x ;
+no warnings 'misc' ;
+my $x ;
+EXPECT
+"my" variable $x masks earlier declaration in same scope at - line 4.
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+Variable "$x" will not stay shared at - line 7.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      our $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+Variable "$x" may be unavailable at - line 6.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'syntax' ;
+1 if $a = 1 ;
+no warnings 'syntax' ;
+1 if $a = 1 ;
+EXPECT
+Found = in conditional, should be == at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+split ;
+no warnings 'deprecated' ;
+split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+$a = split ;
+no warnings 'deprecated' ;
+$a = split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'deprecated';
+my (@foo, %foo);
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+no warnings 'deprecated';
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+EXPECT
+Using a hash as a reference is deprecated at - line 4.
+Using a hash as a reference is deprecated at - line 5.
+Using an array as a reference is deprecated at - line 6.
+Using an array as a reference is deprecated at - line 7.
+Using a hash as a reference is deprecated at - line 8.
+Using a hash as a reference is deprecated at - line 9.
+Using an array as a reference is deprecated at - line 10.
+Using an array as a reference is deprecated at - line 11.
+########
+# op.c
+use warnings 'void' ; close STDIN ;
+1 x 3 ;			# OP_REPEAT
+			# OP_GVSV
+wantarray ; 		# OP_WANTARRAY
+			# OP_GV
+			# OP_PADSV
+			# OP_PADAV
+			# OP_PADHV
+			# OP_PADANY
+			# OP_AV2ARYLEN
+ref ;			# OP_REF
+\@a ;			# OP_REFGEN
+\$a ;			# OP_SREFGEN
+defined $a ;		# OP_DEFINED
+hex $a ;		# OP_HEX
+oct $a ;		# OP_OCT
+length $a ;		# OP_LENGTH
+substr $a,1 ;		# OP_SUBSTR
+vec $a,1,2 ;		# OP_VEC
+index $a,1,2 ;		# OP_INDEX
+rindex $a,1,2 ;		# OP_RINDEX
+sprintf $a ;		# OP_SPRINTF
+$a[0] ;			# OP_AELEM
+			# OP_AELEMFAST
+@a[0] ;			# OP_ASLICE
+#values %a ;		# OP_VALUES
+#keys %a ;		# OP_KEYS
+$a{0} ;			# OP_HELEM
+@a{0} ;			# OP_HSLICE
+unpack "a", "a" ;	# OP_UNPACK
+pack $a,"" ;		# OP_PACK
+join "" ;		# OP_JOIN
+(@a)[0,1] ;		# OP_LSLICE
+			# OP_ANONLIST
+			# OP_ANONHASH
+sort(1,2) ;		# OP_SORT
+reverse(1,2) ;		# OP_REVERSE
+			# OP_RANGE
+			# OP_FLIP
+(1 ..2) ;		# OP_FLOP
+caller ;		# OP_CALLER
+fileno STDIN ;		# OP_FILENO
+eof STDIN ;		# OP_EOF
+tell STDIN ;		# OP_TELL
+readlink 1;		# OP_READLINK
+time ;			# OP_TIME
+localtime ;		# OP_LOCALTIME
+gmtime ;		# OP_GMTIME
+eval { getgrnam 1 };	# OP_GGRNAM
+eval { getgrgid 1 };	# OP_GGRGID
+eval { getpwnam 1 };	# OP_GPWNAM
+eval { getpwuid 1 };	# OP_GPWUID
+EXPECT
+Useless use of repeat (x) in void context at - line 3.
+Useless use of wantarray in void context at - line 5.
+Useless use of reference-type operator in void context at - line 12.
+Useless use of reference constructor in void context at - line 13.
+Useless use of single ref constructor in void context at - line 14.
+Useless use of defined operator in void context at - line 15.
+Useless use of hex in void context at - line 16.
+Useless use of oct in void context at - line 17.
+Useless use of length in void context at - line 18.
+Useless use of substr in void context at - line 19.
+Useless use of vec in void context at - line 20.
+Useless use of index in void context at - line 21.
+Useless use of rindex in void context at - line 22.
+Useless use of sprintf in void context at - line 23.
+Useless use of array element in void context at - line 24.
+Useless use of array slice in void context at - line 26.
+Useless use of hash element in void context at - line 29.
+Useless use of hash slice in void context at - line 30.
+Useless use of unpack in void context at - line 31.
+Useless use of pack in void context at - line 32.
+Useless use of join or string in void context at - line 33.
+Useless use of list slice in void context at - line 34.
+Useless use of sort in void context at - line 37.
+Useless use of reverse in void context at - line 38.
+Useless use of range (or flop) in void context at - line 41.
+Useless use of caller in void context at - line 42.
+Useless use of fileno in void context at - line 43.
+Useless use of eof in void context at - line 44.
+Useless use of tell in void context at - line 45.
+Useless use of readlink in void context at - line 46.
+Useless use of time in void context at - line 47.
+Useless use of localtime in void context at - line 48.
+Useless use of gmtime in void context at - line 49.
+Useless use of getgrnam in void context at - line 50.
+Useless use of getgrgid in void context at - line 51.
+Useless use of getpwnam in void context at - line 52.
+Useless use of getpwuid in void context at - line 53.
+########
+# op.c
+no warnings 'void' ; close STDIN ;
+1 x 3 ;			# OP_REPEAT
+			# OP_GVSV
+wantarray ; 		# OP_WANTARRAY
+			# OP_GV
+			# OP_PADSV
+			# OP_PADAV
+			# OP_PADHV
+			# OP_PADANY
+			# OP_AV2ARYLEN
+ref ;			# OP_REF
+\@a ;			# OP_REFGEN
+\$a ;			# OP_SREFGEN
+defined $a ;		# OP_DEFINED
+hex $a ;		# OP_HEX
+oct $a ;		# OP_OCT
+length $a ;		# OP_LENGTH
+substr $a,1 ;		# OP_SUBSTR
+vec $a,1,2 ;		# OP_VEC
+index $a,1,2 ;		# OP_INDEX
+rindex $a,1,2 ;		# OP_RINDEX
+sprintf $a ;		# OP_SPRINTF
+$a[0] ;			# OP_AELEM
+			# OP_AELEMFAST
+@a[0] ;			# OP_ASLICE
+#values %a ;		# OP_VALUES
+#keys %a ;		# OP_KEYS
+$a{0} ;			# OP_HELEM
+@a{0} ;			# OP_HSLICE
+unpack "a", "a" ;	# OP_UNPACK
+pack $a,"" ;		# OP_PACK
+join "" ;		# OP_JOIN
+(@a)[0,1] ;		# OP_LSLICE
+			# OP_ANONLIST
+			# OP_ANONHASH
+sort(1,2) ;		# OP_SORT
+reverse(1,2) ;		# OP_REVERSE
+			# OP_RANGE
+			# OP_FLIP
+(1 ..2) ;		# OP_FLOP
+caller ;		# OP_CALLER
+fileno STDIN ;		# OP_FILENO
+eof STDIN ;		# OP_EOF
+tell STDIN ;		# OP_TELL
+readlink 1;		# OP_READLINK
+time ;			# OP_TIME
+localtime ;		# OP_LOCALTIME
+gmtime ;		# OP_GMTIME
+eval { getgrnam 1 };	# OP_GGRNAM
+eval { getgrgid 1 };	# OP_GGRGID
+eval { getpwnam 1 };	# OP_GPWNAM
+eval { getpwuid 1 };	# OP_GPWUID
+EXPECT
+########
+# op.c
+use warnings 'void' ;
+for (@{[0]}) { "$_" }		# check warning isn't duplicated
+no warnings 'void' ;
+for (@{[0]}) { "$_" }		# check warning isn't duplicated
+EXPECT
+Useless use of string in void context at - line 3.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_telldir}) {
+        print <<EOM ;
+SKIPPED
+# telldir not present
+EOM
+        exit 
+    }
+}
+telldir 1 ;		# OP_TELLDIR
+no warnings 'void' ;
+telldir 1 ;		# OP_TELLDIR
+EXPECT
+Useless use of telldir in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getppid}) {
+        print <<EOM ;
+SKIPPED
+# getppid not present
+EOM
+        exit 
+    }
+}
+getppid ;		# OP_GETPPID
+no warnings 'void' ;
+getppid ;		# OP_GETPPID
+EXPECT
+Useless use of getppid in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getpgrp}) {
+        print <<EOM ;
+SKIPPED
+# getpgrp not present
+EOM
+        exit 
+    }
+}
+getpgrp ;		# OP_GETPGRP
+no warnings 'void' ;
+getpgrp ;		# OP_GETPGRP
+EXPECT
+Useless use of getpgrp in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_times}) {
+        print <<EOM ;
+SKIPPED
+# times not present
+EOM
+        exit 
+    }
+}
+times ;			# OP_TMS
+no warnings 'void' ;
+times ;			# OP_TMS
+EXPECT
+Useless use of times in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22
+        print <<EOM ;
+SKIPPED
+# getpriority not present
+EOM
+        exit 
+    }
+}
+getpriority 1,2;	# OP_GETPRIORITY
+no warnings 'void' ;
+getpriority 1,2;	# OP_GETPRIORITY
+EXPECT
+Useless use of getpriority in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getlogin}) {
+        print <<EOM ;
+SKIPPED
+# getlogin not present
+EOM
+        exit 
+    }
+}
+getlogin ;			# OP_GETLOGIN
+no warnings 'void' ;
+getlogin ;			# OP_GETLOGIN
+EXPECT
+Useless use of getlogin in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ; BEGIN {
+if ( ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# getsockname not present
+# getpeername not present
+# gethostbyname not present
+# gethostbyaddr not present
+# gethostent not present
+# getnetbyname not present
+# getnetbyaddr not present
+# getnetent not present
+# getprotobyname not present
+# getprotobynumber not present
+# getprotoent not present
+# getservbyname not present
+# getservbyport not present
+# getservent not present
+EOM
+    exit 
+} }
+getsockname STDIN ;	# OP_GETSOCKNAME
+getpeername STDIN ;	# OP_GETPEERNAME
+gethostbyname 1 ;	# OP_GHBYNAME
+gethostbyaddr 1,2;	# OP_GHBYADDR
+gethostent ;		# OP_GHOSTENT
+getnetbyname 1 ;	# OP_GNBYNAME
+getnetbyaddr 1,2 ;	# OP_GNBYADDR
+getnetent ;		# OP_GNETENT
+getprotobyname 1;	# OP_GPBYNAME
+getprotobynumber 1;	# OP_GPBYNUMBER
+getprotoent ;		# OP_GPROTOENT
+getservbyname 1,2;	# OP_GSBYNAME
+getservbyport 1,2;	# OP_GSBYPORT
+getservent ;		# OP_GSERVENT
+
+no warnings 'void' ;
+getsockname STDIN ;	# OP_GETSOCKNAME
+getpeername STDIN ;	# OP_GETPEERNAME
+gethostbyname 1 ;	# OP_GHBYNAME
+gethostbyaddr 1,2;	# OP_GHBYADDR
+gethostent ;		# OP_GHOSTENT
+getnetbyname 1 ;	# OP_GNBYNAME
+getnetbyaddr 1,2 ;	# OP_GNBYADDR
+getnetent ;		# OP_GNETENT
+getprotobyname 1;	# OP_GPBYNAME
+getprotobynumber 1;	# OP_GPBYNUMBER
+getprotoent ;		# OP_GPROTOENT
+getservbyname 1,2;	# OP_GSBYNAME
+getservbyport 1,2;	# OP_GSBYPORT
+getservent ;		# OP_GSERVENT
+INIT {
+   # some functions may not be there, so we exit without running
+   exit;
+}
+EXPECT
+Useless use of getsockname in void context at - line 24.
+Useless use of getpeername in void context at - line 25.
+Useless use of gethostbyname in void context at - line 26.
+Useless use of gethostbyaddr in void context at - line 27.
+Useless use of gethostent in void context at - line 28.
+Useless use of getnetbyname in void context at - line 29.
+Useless use of getnetbyaddr in void context at - line 30.
+Useless use of getnetent in void context at - line 31.
+Useless use of getprotobyname in void context at - line 32.
+Useless use of getprotobynumber in void context at - line 33.
+Useless use of getprotoent in void context at - line 34.
+Useless use of getservbyname in void context at - line 35.
+Useless use of getservbyport in void context at - line 36.
+Useless use of getservent in void context at - line 37.
+########
+# op.c
+use warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+no warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+EXPECT
+Useless use of a variable in void context at - line 3.
+Useless use of a variable in void context at - line 4.
+Useless use of a variable in void context at - line 5.
+Useless use of a variable in void context at - line 6.
+########
+# op.c
+use warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+no warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+EXPECT
+Useless use of a constant in void context at - line 3.
+Useless use of a constant in void context at - line 4.
+########
+# op.c
+#
+use warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+{
+no warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+}
+EXPECT
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
+Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
+BEGIN not safe after errors--compilation aborted at - line 18.
+########
+# op.c
+use warnings 'syntax' ;
+my $a, $b = (1,2);
+no warnings 'syntax' ;
+my $c, $d = (1,2);
+EXPECT
+Parentheses missing around "my" list at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+local $a, $b = (1,2);
+no warnings 'syntax' ;
+local $c, $d = (1,2);
+EXPECT
+Parentheses missing around "local" list at - line 3.
+########
+# op.c
+use warnings 'bareword' ;
+print (ABC || 1) ;
+no warnings 'bareword' ;
+print (ABC || 1) ;
+EXPECT
+Bareword found in conditional at - line 3.
+########
+--FILE-- abc
+
+--FILE--
+# op.c
+use warnings 'misc' ;
+open FH, "<abc" ;
+$x = 1 if $x = <FH> ;
+no warnings 'misc' ;
+$x = 1 if $x = <FH> ;
+EXPECT
+Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 if $x = readdir FH ;
+no warnings 'misc' ;
+$x = 1 if $x = readdir FH ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 if $x = <*> ;
+no warnings 'misc' ;
+$x = 1 if $x = <*> ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+%a = (1,2,3,4) ;
+$x = 1 if $x = each %a ;
+no warnings 'misc' ;
+$x = 1 if $x = each %a ;
+EXPECT
+Value of each() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 while $x = readdir FH and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = readdir FH and 0 ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred {}
+sub fred {}
+no warnings 'redefine' ;
+sub fred {}
+EXPECT
+Subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 1 }
+no warnings 'redefine' ;
+sub fred () { 1 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 2 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+no warnings 'redefine' ;
+sub fred () { 1 }
+*fred = sub () { 2 };
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+format FRED =
+.
+format FRED =
+.
+no warnings 'redefine' ;
+format FRED =
+.
+EXPECT
+Format FRED redefined at - line 5.
+########
+# op.c
+use warnings 'deprecated' ;
+push FRED;
+no warnings 'deprecated' ;
+push FRED;
+EXPECT
+Array @FRED missing the @ in argument 1 of push() at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+@a = keys FRED ;
+no warnings 'deprecated' ;
+@a = keys FRED ;
+EXPECT
+Hash %FRED missing the % in argument 1 of keys() at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+Statement unlikely to be reached at - line 4.
+	(Maybe you meant system() when you said exec()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my @a; defined(@a);
+EXPECT
+defined(@array) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+defined(@a = (1,2,3));
+EXPECT
+defined(@array) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my %h; defined(%h);
+EXPECT
+defined(%hash) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+no warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+
+########
+# op.c
+sub fred();
+sub fred($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 3.
+########
+# op.c
+$^W = 0 ;
+sub fred() ;
+sub fred($) {}
+{
+    no warnings 'prototype' ;
+    sub Fred() ;
+    sub Fred($) {}
+    use warnings 'prototype' ;
+    sub freD() ;
+    sub freD($) {}
+}
+sub FRED() ;
+sub FRED($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 4.
+Prototype mismatch: sub main::freD () vs ($) at - line 11.
+Prototype mismatch: sub main::FRED () vs ($) at - line 14.
+########
+# op.c
+use warnings 'syntax' ;
+join /---/, 'x', 'y', 'z';
+EXPECT
+/---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'prototype' ;
+fred() ; 
+sub fred ($$) {}
+no warnings 'prototype' ;
+joe() ; 
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+use warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+use abc;
+delete $INC{"abc.pm"};
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in check
+in init
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in end
+in end
+in end
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+no warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in begin
+in mainline
+in end
+in end
+########
+# op.c
+my @x;
+use warnings 'syntax' ;
+push(@x);
+unshift(@x);
+no warnings 'syntax' ;
+push(@x);
+unshift(@x);
+EXPECT
+Useless use of push with no values at - line 4.
+Useless use of unshift with no values at - line 5.
diff --git a/lib/warnings/perl b/lib/warnings/perl
new file mode 100644
index 0000000000..512ee7fb65
--- /dev/null
+++ b/lib/warnings/perl
@@ -0,0 +1,72 @@
+  perl.c	AOK
+
+  gv_check(defstash)
+	Name \"%s::%s\" used only once: possible typo 
+
+  Mandatory Warnings All TODO
+  ------------------
+  Recompile perl with -DDEBUGGING to use -D switch	[moreswitches]
+  Unbalanced scopes: %ld more ENTERs than LEAVEs	[perl_destruct]
+  Unbalanced saves: %ld more saves than restores	[perl_destruct]
+  Unbalanced tmps: %ld more allocs than frees		[perl_destruct]
+  Unbalanced context: %ld more PUSHes than POPs		[perl_destruct]
+  Unbalanced string table refcount: (%d) for \"%s\"	[perl_destruct]
+  Scalars leaked: %ld					[perl_destruct]
+
+
+__END__
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 5.
+########
+-w
+# perl.c
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+# perl.c
+BEGIN { $^W =1 ; }
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+-W
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 6.
+Name "main::x" used only once: possible typo at - line 4.
+########
+-X
+# perl.c
+use warnings 'once' ;
+$x = 3 ;
+EXPECT
+########
+
+# perl.c
+{ use warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+
+# perl.c
+$z = 3 ;
+BEGIN { $^W = 1 }
+{ no warnings 'once' ; $x = 3 ; }
+$y = 3 ;
+EXPECT
+Name "main::y" used only once: possible typo at - line 6.
diff --git a/lib/warnings/perlio b/lib/warnings/perlio
new file mode 100644
index 0000000000..18c0dfa89f
--- /dev/null
+++ b/lib/warnings/perlio
@@ -0,0 +1,10 @@
+  perlio.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Setting cnt to %d
+    Setting ptr %p > end+1 %p
+    Setting cnt to %d, ptr implies %d
+
+__END__
diff --git a/lib/warnings/perly b/lib/warnings/perly
new file mode 100644
index 0000000000..afc5dccc72
--- /dev/null
+++ b/lib/warnings/perly
@@ -0,0 +1,31 @@
+  perly.y	AOK
+
+  dep() => deprecate("\"do\" to call subroutines") 
+  Use of "do" to call subroutines is deprecated
+
+	sub fred {} do fred()
+	sub fred {} do fred(1)
+	sub fred {} $a = "fred" ; do $a()
+	sub fred {} $a = "fred" ; do $a(1)
+
+
+__END__
+# perly.y
+use warnings 'deprecated' ;
+sub fred {} 
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+no warnings 'deprecated' ;
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+EXPECT
+Use of "do" to call subroutines is deprecated at - line 4.
+Use of "do" to call subroutines is deprecated at - line 5.
+Use of "do" to call subroutines is deprecated at - line 7.
+Use of "do" to call subroutines is deprecated at - line 8.
diff --git a/lib/warnings/pp b/lib/warnings/pp
new file mode 100644
index 0000000000..62f054a6ee
--- /dev/null
+++ b/lib/warnings/pp
@@ -0,0 +1,150 @@
+  pp.c	TODO
+
+  substr outside of string
+    $a = "ab" ; $b = substr($a, 4,5) ;
+
+  Attempt to use reference as lvalue in substr 
+    $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
+
+  uninitialized	in pp_rv2gv()
+	my *b = *{ undef()}
+
+  uninitialized	in pp_rv2sv()
+	my $a = undef ; my $b = $$a
+
+  Odd number of elements in hash list
+	my $a = { 1,2,3 } ;
+
+  Invalid type in unpack: '%c
+	my $A = pack ("A,A", 1,2) ;
+	my @A = unpack ("A,A", "22") ;
+
+  Attempt to pack pointer to temporary value
+	pack("p", "abc") ;
+
+  Explicit blessing to '' (assuming package main)
+	bless \[], "";
+
+  Constant subroutine %s undefined			<<<TODO
+  Constant subroutine (anonymous) undefined		<<<TODO
+
+__END__
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5) ;
+no warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5)  ;
+EXPECT
+substr outside of string at - line 4.
+########
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = \$a ;  
+substr($b, 1,1) = "ab" ;
+no warnings 'substr' ;
+substr($b, 1,1) = "ab" ;
+EXPECT
+Attempt to use reference as lvalue in substr at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+# TODO
+EXPECT
+
+########
+# pp.c
+use warnings 'misc' ;
+my $a = { 1,2,3};
+no warnings 'misc' ;
+my $b = { 1,2,3};
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp.c
+use warnings 'pack' ;
+use warnings 'unpack' ;
+my @a = unpack ("A,A", "22") ;
+my $a = pack ("A,A", 1,2) ;
+no warnings 'pack' ;
+no warnings 'unpack' ;
+my @b = unpack ("A,A", "22") ;
+my $b = pack ("A,A", 1,2) ;
+EXPECT
+Invalid type in unpack: ',' at - line 4.
+Invalid type in pack: ',' at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+my $a = undef ; 
+my $b = $$a;
+no warnings 'uninitialized' ;
+my $c = $$a;
+EXPECT
+Use of uninitialized value in scalar dereference at - line 4.
+########
+# pp.c
+use warnings 'pack' ;
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+my $a = pack("p", &foo) ;
+no warnings 'pack' ;
+my $b = pack("p", &foo) ;
+EXPECT
+Attempt to pack pointer to temporary value at - line 4.
+########
+# pp.c
+use warnings 'misc' ;
+bless \[], "" ;
+no warnings 'misc' ;
+bless \[], "" ;
+EXPECT
+Explicit blessing to '' (assuming package main) at - line 3.
+########
+# pp.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+reverse ;
+EXPECT
+########
+# pp.c
+use warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+no warnings 'pack' ;
+print unpack("C", pack("C",   -1)), "\n";
+print unpack("C", pack("C",    0)), "\n";
+print unpack("C", pack("C",  255)), "\n";
+print unpack("C", pack("C",  256)), "\n";
+print unpack("c", pack("c", -129)), "\n";
+print unpack("c", pack("c", -128)), "\n";
+print unpack("c", pack("c",  127)), "\n";
+print unpack("c", pack("c",  128)), "\n";
+EXPECT
+Character in "C" format wrapped at - line 3.
+Character in "C" format wrapped at - line 6.
+Character in "c" format wrapped at - line 7.
+Character in "c" format wrapped at - line 10.
+255
+0
+255
+0
+127
+-128
+127
+-128
+255
+0
+255
+0
+127
+-128
+127
+-128
diff --git a/lib/warnings/pp_ctl b/lib/warnings/pp_ctl
new file mode 100644
index 0000000000..ac01f277b1
--- /dev/null
+++ b/lib/warnings/pp_ctl
@@ -0,0 +1,230 @@
+  pp_ctl.c	AOK
+ 
+     Not enough format arguments	
+ 	format STDOUT =
+ 	@<<< @<<<
+ 	$a
+ 	.
+ 	write;
+     
+
+    Exiting substitution via %s
+	$_ = "abc" ;
+	while ($i ++ == 0)
+	{
+    	    s/ab/last/e ;
+	}
+
+    Exiting subroutine via %s		
+	sub fred { last }
+	{ fred() }
+
+    Exiting eval via %s	
+	{ eval "last" }
+
+    Exiting pseudo-block via %s 
+	@a = (1,2) ; @b = sort { last } @a ;
+
+    Exiting substitution via %s
+	$_ = "abc" ;
+	last fred:
+	while ($i ++ == 0)
+	{
+    	    s/ab/last fred/e ;
+	}
+
+
+    Exiting subroutine via %s
+	sub fred { last joe }
+	joe: { fred() }
+
+    Exiting eval via %s
+	fred: { eval "last fred" }
+
+    Exiting pseudo-block via %s 
+	@a = (1,2) ; fred: @b = sort { last fred } @a ;
+
+
+    Deep recursion on subroutine \"%s\"
+	sub fred
+	{
+    	  fred() if $a++ < 200
+	}
+	 
+	fred()
+
+      (in cleanup) foo bar
+	package Foo;
+	DESTROY { die "foo bar" }
+	{ bless [], 'Foo' for 1..10 }
+
+__END__
+# pp_ctl.c
+use warnings 'syntax' ;
+format STDOUT =
+@<<< @<<<
+1
+.
+write;
+EXPECT
+Not enough format arguments at - line 5.
+1
+########
+# pp_ctl.c
+no warnings 'syntax' ;
+format =
+@<<< @<<<
+1
+.
+write ;
+EXPECT
+1
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+ 
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last }
+{ fred() }
+no warnings 'exiting' ;
+sub joe { last }
+{ joe() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+{
+  eval "use warnings 'exiting' ; last;" 
+}
+print STDERR $@ ;
+{
+  eval "no warnings 'exiting' ;last;" 
+} 
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+@b = sort { last } @a ;
+no warnings 'exiting' ;
+@b = sort { last } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Can't "last" outside a loop block at - line 4.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+fred: 
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last joe }
+joe: { fred() }
+no warnings 'exiting' ;
+sub Fred { last Joe }
+Joe: { Fred() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+joe:
+{ eval "use warnings 'exiting' ; last joe;" }
+print STDERR $@ ;
+Joe:
+{ eval "no warnings 'exiting' ; last Joe;" }
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+fred: @b = sort { last fred } @a ;
+no warnings 'exiting' ;
+Fred: @b = sort { last Fred } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Label not found for "last fred" at - line 4.
+########
+# pp_ctl.c
+use warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+Deep recursion on subroutine "main::fred" at - line 6.
+########
+# pp_ctl.c
+no warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+########
+# pp_ctl.c
+use warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+	(in cleanup) A foo bar at - line 4.
+	(in cleanup) B foo bar at - line 4.
+########
+# pp_ctl.c
+no warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+########
+# pp_ctl.c
+use warnings;
+eval 'print $foo';
+EXPECT
+Use of uninitialized value in print at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings;
+{
+    no warnings;
+    eval 'print $foo';
+}
+EXPECT
diff --git a/lib/warnings/pp_hot b/lib/warnings/pp_hot
new file mode 100644
index 0000000000..c5a3790587
--- /dev/null
+++ b/lib/warnings/pp_hot
@@ -0,0 +1,284 @@
+  pp_hot.c	
+
+  print() on unopened filehandle abc		[pp_print]
+    $f = $a = "abc" ; print $f $a
+
+  Filehandle %s opened only for input		[pp_print]
+    print STDIN "abc" ;
+
+  Filehandle %s opened only for output		[pp_print]
+    print <STDOUT> ;
+
+  print() on closed filehandle %s		[pp_print]
+    close STDIN ; print STDIN "abc" ;
+
+  uninitialized					[pp_rv2av]
+	my $a = undef ; my @b = @$a
+
+  uninitialized					[pp_rv2hv]
+	my $a = undef ; my %b = %$a
+
+  Odd number of elements in hash list		[pp_aassign]
+	%X = (1,2,3) ;
+
+  Reference found where even-sized list expected [pp_aassign]
+	$X = [ 1 ..3 ];
+
+  Filehandle %s opened only for output		[Perl_do_readline] 
+  	open (FH, ">./xcv") ;
+	my $a = <FH> ;
+
+  glob failed (can't start child: %s)		[Perl_do_readline] <<TODO
+
+  readline() on closed filehandle %s		[Perl_do_readline]
+    close STDIN ; $a = <STDIN>;
+
+  readline() on closed filehandle %s		[Perl_do_readline]
+    readline(NONESUCH);
+
+  glob failed (child exited with status %d%s)	[Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"		[Perl_sub_crush_depth]
+    sub fred { fred() if $a++ < 200} fred()
+
+  Deep recursion on anonymous subroutine 	[Perl_sub_crush_depth]
+    $a = sub { &$a if $a++ < 200} &$a
+
+  Possible Y2K bug: about to append an integer to '19' [pp_concat]
+    $x     = "19$yy\n";
+
+  Use of reference "%s" as array index [pp_aelem]
+    $x[\1]
+
+__END__
+# pp_hot.c [pp_print]
+use warnings 'unopened' ;
+$f = $a = "abc" ; 
+print $f $a;
+no warnings 'unopened' ;
+print $f $a;
+EXPECT
+print() on unopened filehandle abc at - line 4.
+########
+# pp_hot.c [pp_print]
+use warnings 'io' ;
+print STDIN "anc";
+print <STDOUT>;
+print <STDERR>;
+open(FOO, ">&STDOUT") and print <FOO>;
+print getc(STDERR);
+print getc(FOO);
+####################################################################
+# The next test is known to fail on some systems (Linux+old glibc, #
+# some *BSDs (including Mac OS X and NeXT), among others.          #
+# We skip it for now (on the grounds that it is "just" a warning). #
+####################################################################
+#read(FOO,$_,1);
+no warnings 'io' ;
+print STDIN "anc";
+EXPECT
+Filehandle STDIN opened only for input at - line 3.
+Filehandle STDOUT opened only for output at - line 4.
+Filehandle STDERR opened only for output at - line 5.
+Filehandle FOO opened only for output at - line 6.
+Filehandle STDERR opened only for output at - line 7.
+Filehandle FOO opened only for output at - line 8.
+########
+# pp_hot.c [pp_print]
+use warnings 'closed' ;
+close STDIN ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+closedir STDIN;
+no warnings 'closed' ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+EXPECT
+print() on closed filehandle STDIN at - line 4.
+print() on closed filehandle STDIN at - line 6.
+	(Are you trying to call print() on dirhandle STDIN?)
+########
+# pp_hot.c [pp_rv2av]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my @b = @$a;
+no warnings 'uninitialized' ;
+my @c = @$a;
+EXPECT
+Use of uninitialized value in array dereference at - line 4.
+########
+# pp_hot.c [pp_rv2hv]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my %b = %$a;
+no warnings 'uninitialized' ;
+my %c = %$a;
+EXPECT
+Use of uninitialized value in hash dereference at - line 4.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = (1,2,3) ;
+no warnings 'misc' ;
+my %Y ; %Y = (1,2,3) ;
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = [1 .. 3] ;
+no warnings 'misc' ;
+my %Y ; %Y = [1 .. 3] ;
+EXPECT
+Reference found where even-sized list expected at - line 3.
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'closed' ;
+close STDIN        ; $a = <STDIN> ;
+opendir STDIN, "." ; $a = <STDIN> ;
+closedir STDIN;
+no warnings 'closed' ;
+opendir STDIN, "." ; $a = <STDIN> ;
+$a = <STDIN> ;
+EXPECT
+readline() on closed filehandle STDIN at - line 3.
+readline() on closed filehandle STDIN at - line 4.
+	(Are you trying to call readline() on dirhandle STDIN?)
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+close (FH) ;
+unlink $file ;
+EXPECT
+Filehandle FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+ok
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+Deep recursion on anonymous subroutine at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+########
+# pp_hot.c [pp_concat]
+use warnings 'uninitialized';
+my($x, $y);
+sub a { shift }
+a($x . "x");	# should warn once
+a($x . $y);	# should warn twice
+$x .= $y;	# should warn once
+$y .= $y;	# should warn once
+EXPECT
+Use of uninitialized value in concatenation (.) or string at - line 5.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 7.
+Use of uninitialized value in concatenation (.) or string at - line 8.
+########
+# pp_hot.c [pp_concat]
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+	exit 0;
+    }
+}
+my $x;
+my $yy = 78;
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+$x     = "319$yy\n";
+$x     = "319" . $yy . "\n";
+$yy = 19;
+$x     = "ok $yy\n";
+$yy = 9;
+$x     = 1 . $yy;
+no warnings 'y2k';
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+EXPECT
+Possible Y2K bug: about to append an integer to '19' at - line 12.
+Possible Y2K bug: about to append an integer to '19' at - line 13.
+########
+# pp_hot.c [pp_aelem]
+{
+use warnings 'misc';
+print $x[\1];
+}
+{
+no warnings 'misc';
+print $x[\1];
+}
+
+EXPECT
+OPTION regex
+Use of reference ".*" as array index at - line 4.
+########
+# pp_hot.c [pp_aelem]
+package Foo;use overload q("") => sub {};package main;$a = bless {}, "Foo";
+$b = {};
+{
+use warnings 'misc';
+print $x[$a];
+print $x[$b];
+}
+{
+no warnings 'misc';
+print $x[$a];
+print $x[$b];
+}
+
+EXPECT
+OPTION regex
+Use of reference ".*" as array index at - line 7.
diff --git a/lib/warnings/pp_sys b/lib/warnings/pp_sys
new file mode 100644
index 0000000000..e30637b0d4
--- /dev/null
+++ b/lib/warnings/pp_sys
@@ -0,0 +1,419 @@
+  pp_sys.c 	AOK
+
+  untie attempted while %d inner references still exist	[pp_untie]
+    sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+
+  fileno() on unopened filehandle abc		[pp_fileno]
+    $a = "abc"; fileno($a)
+
+  binmode() on unopened filehandle abc		[pp_binmode]
+    $a = "abc"; fileno($a)
+
+  printf() on unopened filehandle abc		[pp_prtf]
+    $a = "abc"; printf $a "fred"
+
+  Filehandle %s opened only for input		[pp_leavewrite]
+    format STDIN =
+    .
+    write STDIN;
+
+  write() on closed filehandle %s		[pp_leavewrite]
+    format STDIN =
+    .
+    close STDIN;
+    write STDIN ;
+
+  page overflow	 				[pp_leavewrite]
+
+  printf() on unopened filehandle abc		[pp_prtf]
+    $a = "abc"; printf $a "fred"
+
+  Filehandle %s opened only for input		[pp_prtf]
+    $a = "abc"; 
+    printf $a "fred"
+
+  printf() on closed filehandle %s		[pp_prtf]
+    close STDIN ;
+    printf STDIN "fred"
+
+  syswrite() on closed filehandle %s		[pp_send]
+    close STDIN; 
+    syswrite STDIN, "fred", 1;
+
+  send() on closed socket %s			[pp_send]
+    close STDIN; 
+    send STDIN, "fred", 1
+
+  bind() on closed socket %s			[pp_bind]
+    close STDIN; 
+    bind STDIN, "fred" ;
+
+
+  connect() on closed socket %s			[pp_connect]
+    close STDIN; 
+    connect STDIN, "fred" ;
+
+  listen() on closed socket %s			[pp_listen]
+    close STDIN; 
+    listen STDIN, 2;
+
+  accept() on closed socket %s			[pp_accept]
+    close STDIN; 
+    accept "fred", STDIN ;
+
+  shutdown() on closed socket %s		[pp_shutdown]
+    close STDIN; 
+    shutdown STDIN, 0;
+
+  setsockopt() on closed socket %s		[pp_ssockopt]
+  getsockopt() on closed socket	%s		[pp_ssockopt]
+    close STDIN; 
+    setsockopt STDIN, 1,2,3;
+    getsockopt STDIN, 1,2;
+
+  getsockname() on closed socket %s		[pp_getpeername]
+  getpeername() on closed socket %s		[pp_getpeername]
+    close STDIN; 
+    getsockname STDIN;
+    getpeername STDIN;
+
+  flock() on closed socket %s			[pp_flock]
+  flock() on closed socket			[pp_flock]
+    close STDIN;
+    flock STDIN, 8;
+    flock $a, 8;
+
+  The stat preceding lstat() wasn't an lstat %s	[pp_stat]
+    lstat(STDIN);
+
+  warn(warn_nl, "stat");			[pp_stat]
+
+  -T on closed filehandle %s
+  stat() on closed filehandle %s
+	close STDIN ; -T STDIN ; stat(STDIN) ;
+
+  warn(warn_nl, "open");			[pp_fttext]
+    -T "abc\ndef" ;
+
+  Filehandle %s opened only for output		[pp_sysread]
+	my $file = "./xcv" ;
+	open(F, ">$file") ; 
+	my $a = sysread(F, $a,10) ;
+  
+  
+
+__END__
+# pp_sys.c [pp_untie]
+use warnings 'untie' ;
+sub TIESCALAR { bless [] } ; 
+$b = tie $a, 'main'; 
+untie $a ;
+no warnings 'untie' ;
+$c = tie $d, 'main'; 
+untie $d ;
+EXPECT
+untie attempted while 1 inner references still exist at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDIN =
+.
+write STDIN;
+no warnings 'io' ;
+write STDIN;
+EXPECT
+Filehandle STDIN opened only for input at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'closed' ;
+format STDIN =
+.
+close STDIN;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+closedir STDIN;
+no warnings 'closed' ;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+EXPECT
+write() on closed filehandle STDIN at - line 6.
+write() on closed filehandle STDIN at - line 8.
+	(Are you trying to call write() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDOUT_TOP =
+abc
+.
+format STDOUT =
+def
+ghi
+.
+$= = 1 ;
+$- =1 ;
+open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+write ;
+no warnings 'io' ;
+write ;
+EXPECT
+page overflow at - line 13.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'unopened' ;
+$a = "abc"; 
+printf $a "fred";
+no warnings 'unopened' ;
+printf $a "fred";
+EXPECT
+printf() on unopened filehandle abc at - line 4.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'closed' ;
+close STDIN ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+closedir STDIN;
+no warnings 'closed' ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+EXPECT
+printf() on closed filehandle STDIN at - line 4.
+printf() on closed filehandle STDIN at - line 6.
+	(Are you trying to call printf() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_prtf]
+use warnings 'io' ;
+printf STDIN "fred";
+no warnings 'io' ;
+printf STDIN "fred";
+EXPECT
+Filehandle STDIN opened only for input at - line 3.
+########
+# pp_sys.c [pp_send]
+use warnings 'closed' ;
+close STDIN; 
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+closedir STDIN;
+no warnings 'closed' ;
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+EXPECT
+syswrite() on closed filehandle STDIN at - line 4.
+syswrite() on closed filehandle STDIN at - line 6.
+	(Are you trying to call syswrite() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_flock]
+use Config; 
+BEGIN { 
+  if ( !$Config{d_flock} &&
+       !$Config{d_fcntl_can_lock} &&
+       !$Config{d_lockf} ) {
+    print <<EOM ;
+SKIPPED
+# flock not present
+EOM
+    exit ;
+  } 
+}
+use warnings qw(unopened closed);
+close STDIN;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+flock FOO, 8;
+flock $a, 8;
+no warnings qw(unopened closed);
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+flock FOO, 8;
+flock $a, 8;
+EXPECT
+flock() on closed filehandle STDIN at - line 16.
+flock() on closed filehandle STDIN at - line 18.
+	(Are you trying to call flock() on dirhandle STDIN?)
+flock() on unopened filehandle FOO at - line 19.
+flock() on unopened filehandle at - line 20.
+########
+# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
+use warnings 'io' ;
+use Config; 
+BEGIN { 
+  if ( $^O ne 'VMS' and ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# send not present
+# bind not present
+# connect not present
+# accept not present
+# shutdown not present
+# setsockopt not present
+# getsockopt not present
+# getsockname not present
+# getpeername not present
+EOM
+    exit ;
+  } 
+}
+close STDIN; 
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+closedir STDIN;
+no warnings 'io' ;
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept STDIN, "fred" ;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+EXPECT
+send() on closed socket STDIN at - line 22.
+bind() on closed socket STDIN at - line 23.
+connect() on closed socket STDIN at - line 24.
+listen() on closed socket STDIN at - line 25.
+accept() on closed socket STDIN at - line 26.
+shutdown() on closed socket STDIN at - line 27.
+setsockopt() on closed socket STDIN at - line 28.
+getsockopt() on closed socket STDIN at - line 29.
+getsockname() on closed socket STDIN at - line 30.
+getpeername() on closed socket STDIN at - line 31.
+send() on closed socket STDIN at - line 33.
+	(Are you trying to call send() on dirhandle STDIN?)
+bind() on closed socket STDIN at - line 34.
+	(Are you trying to call bind() on dirhandle STDIN?)
+connect() on closed socket STDIN at - line 35.
+	(Are you trying to call connect() on dirhandle STDIN?)
+listen() on closed socket STDIN at - line 36.
+	(Are you trying to call listen() on dirhandle STDIN?)
+accept() on closed socket STDIN at - line 37.
+	(Are you trying to call accept() on dirhandle STDIN?)
+shutdown() on closed socket STDIN at - line 38.
+	(Are you trying to call shutdown() on dirhandle STDIN?)
+setsockopt() on closed socket STDIN at - line 39.
+	(Are you trying to call setsockopt() on dirhandle STDIN?)
+getsockopt() on closed socket STDIN at - line 40.
+	(Are you trying to call getsockopt() on dirhandle STDIN?)
+getsockname() on closed socket STDIN at - line 41.
+	(Are you trying to call getsockname() on dirhandle STDIN?)
+getpeername() on closed socket STDIN at - line 42.
+	(Are you trying to call getpeername() on dirhandle STDIN?)
+########
+# pp_sys.c [pp_stat]
+use warnings 'newline' ;
+stat "abc\ndef";
+no warnings 'newline' ;
+stat "abc\ndef";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_stat]
+use Config; 
+BEGIN { 
+  if ($^O eq 'd_lstat') {
+    print <<EOM ;
+SKIPPED
+# lstat not present
+EOM
+    exit ;
+  } 
+}
+use warnings 'io' ;
+lstat(STDIN) ;
+no warnings 'io' ;
+lstat(STDIN) ;
+EXPECT
+The stat preceding lstat() wasn't an lstat at - line 13.
+########
+# pp_sys.c [pp_fttext]
+use warnings qw(unopened closed) ;
+close STDIN ; 
+-T STDIN ;
+stat(STDIN) ;
+-T HOCUS;
+stat(POCUS);
+no warnings qw(unopened closed) ;
+-T STDIN ;
+stat(STDIN);
+-T HOCUS;
+stat(POCUS);
+EXPECT
+-T on closed filehandle STDIN at - line 4.
+stat() on closed filehandle STDIN at - line 5.
+-T on unopened filehandle HOCUS at - line 6.
+stat() on unopened filehandle POCUS at - line 7.
+########
+# pp_sys.c [pp_fttext]
+use warnings 'newline' ;
+-T "abc\ndef" ;
+no warnings 'newline' ;
+-T "abc\ndef" ;
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_sysread]
+use warnings 'io' ;
+if ($^O eq 'dos') {
+    print <<EOM ;
+SKIPPED
+# skipped on dos
+EOM
+    exit ;
+}
+my $file = "./xcv" ;
+open(F, ">$file") ; 
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle F opened only for output at - line 12.
+########
+# pp_sys.c [pp_binmode]
+use warnings 'unopened' ;
+binmode(BLARG);
+$a = "BLERG";binmode($a);
+EXPECT
+binmode() on unopened filehandle BLARG at - line 3.
+binmode() on unopened filehandle at - line 4.
diff --git a/lib/warnings/regcomp b/lib/warnings/regcomp
new file mode 100644
index 0000000000..ceca4410d6
--- /dev/null
+++ b/lib/warnings/regcomp
@@ -0,0 +1,239 @@
+  regcomp.c	AOK
+
+  Quantifier unexpected on zero-length expression [S_study_chunk] 
+
+  (?p{}) is deprecated - use (??{})  [S_reg]
+    $a =~ /(?p{'x'})/ ;
+    
+
+  Useless (%s%c) - %suse /%c modifier [S_reg] 
+  Useless (%sc) - %suse /gc modifier [S_reg] 
+
+
+
+  Strange *+?{} on zero-length expression	[S_study_chunk]
+	/(?=a)?/
+
+  %.*s matches null string many times   	[S_regpiece]
+	$a = "ABC123" ; $a =~ /(?=a)*/'
+
+  /%.127s/: Unrecognized escape \\%c passed through	[S_regatom] 
+  	$x = '\m' ; /$x/
+
+  POSIX syntax [%c %c] is reserved for future extensions [S_checkposixcc] 
+
+
+  Character class [:%.*s:] unknown	[S_regpposixcc]
+
+  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
+  
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass]
+
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8]
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"	[S_regclass] 
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"	[S_regclassutf8] 
+
+  False [] range \"%*.*s\" [S_regclass]
+
+__END__
+# regcomp.c [S_regpiece]
+use warnings 'regexp' ;
+my $a = "ABC123" ; 
+$a =~ /(?=a)*/ ;
+no warnings 'regexp' ;
+$a =~ /(?=a)*/ ;
+EXPECT
+(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4.
+########
+# regcomp.c [S_study_chunk]
+use warnings 'regexp' ;
+$_ = "" ;
+/(?=a)?/;
+no warnings 'regexp' ;
+/(?=a)?/;
+EXPECT
+Quantifier unexpected on zero-length expression in regex; marked by <-- HERE in m/(?=a)? <-- HERE / at - line 4.
+########
+# regcomp.c [S_regatom]
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
+EXPECT
+Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[:alpha:]/;
+/[:zog:]/;
+/[[:zog:]]/;
+no warnings 'regexp' ;
+/[:alpha:]/;
+/[:zog:]/;
+/[[:zog:]]/;
+EXPECT
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5.
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6.
+POSIX class [:zog:] unknown in regex; marked by <-- HERE in m/[[:zog:] <-- HERE ]/
+########
+# regcomp.c [S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[.zog.]/;
+no warnings 'regexp' ;
+/[.zog.]/;
+EXPECT
+POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
+POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE /
+########
+# regcomp.c [S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[[.zog.]]/;
+no warnings 'regexp' ;
+/[[.zog.]]/;
+EXPECT
+POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[[.zog.] <-- HERE ]/
+########
+# regcomp.c [S_regclass]
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 12.
+########
+# regcomp.c [S_regclassutf8]
+BEGIN {
+    if (ord("\t") == 5) {
+        print "SKIPPED\n# ebcdic regular expression ranges differ.";
+        exit 0;
+    }
+}
+use utf8;
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19.
+########
+# regcomp.c [S_regclass S_regclassutf8]
+use warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+no warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+EXPECT
+Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
+
+########
+# regcomp.c [S_study_chunk]
+use warnings 'deprecated' ;
+$a = "xx" ;
+$a =~ /(?p{'x'})/ ;
+no warnings ;
+use warnings 'regexp' ;
+$a =~ /(?p{'x'})/ ;
+use warnings;
+no warnings 'deprecated' ;
+no warnings 'regexp' ;
+$a =~ /(?p{'x'})/ ;
+EXPECT
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
+########
+# regcomp.c [S_reg]
+use warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+no warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+#EXPECT
+EXPECT
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5.
+Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12.
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12.
diff --git a/lib/warnings/regexec b/lib/warnings/regexec
new file mode 100644
index 0000000000..73696dfb1d
--- /dev/null
+++ b/lib/warnings/regexec
@@ -0,0 +1,119 @@
+  regexec.c	
+
+  This test generates "bad free" warnings when run under
+  PERL_DESTRUCT_LEVEL.  This file merely serves as a placeholder
+  for investigation.
+
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
+
+  (The actual value substituted for %d is masked in the tests so that
+  REG_INFTY configuration variable value does not affect outcome.)
+__END__
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+
diff --git a/lib/warnings/run b/lib/warnings/run
new file mode 100644
index 0000000000..7a4be20e70
--- /dev/null
+++ b/lib/warnings/run
@@ -0,0 +1,8 @@
+  run.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+        NULL OP IN RUN
+
+__END__
diff --git a/lib/warnings/sv b/lib/warnings/sv
new file mode 100644
index 0000000000..b3929e2210
--- /dev/null
+++ b/lib/warnings/sv
@@ -0,0 +1,320 @@
+  sv.c	
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  Subroutine %s redefined	
+
+  Invalid conversion in %s:
+
+  Undefined value assigned to typeglob
+
+  Possible Y2K bug: %d format string following '19'
+
+  Reference is already weak			[Perl_sv_rvweaken] <<TODO
+
+  Mandatory Warnings
+  ------------------
+  Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
+                                          with perl now)
+
+  Mandatory Warnings TODO
+  ------------------
+    Attempt to free non-arena SV: 0x%lx		[del_sv]
+    Reference miscount in sv_replace()		[sv_replace]
+    Attempt to free unreferenced scalar		[sv_free]
+    Attempt to free temp prematurely: SV 0x%lx	[sv_free]
+    semi-panic: attempt to dup freed string	[newSVsv]
+    
+
+__END__
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # a
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # a
+EXPECT
+Use of uninitialized value in integer addition (+) at - line 4.
+########
+# sv.c (sv_2iv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use integer ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 10.
+########
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+my $x *= 2 ; #b 
+no warnings 'uninitialized' ;
+my $y *= 2 ; #b 
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 4.
+########
+# sv.c (sv_2uv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+no warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 10.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $Y = 1 ; 
+my $x = 1 | $a[$Y] ;
+no warnings 'uninitialized' ;
+my $Y = 1 ; 
+$x = 1 | $b[$Y] ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 4.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $x *= 1 ; # d
+no warnings 'uninitialized' ;
+my $y *= 1 ; # d
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # e
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # e
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c (sv_2nv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 9.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = $y + 1 ; # f
+no warnings 'uninitialized' ;
+$x = $z + 1 ; # f
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop undef ; # g
+no warnings 'uninitialized' ;
+$x = chop undef ; # g
+EXPECT
+Modification of a read-only value attempted at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop $y ; # h
+no warnings 'uninitialized' ;
+$x = chop $z ; # h
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+# sv.c (sv_2pv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = "" ;
+$B .= $A ;
+no warnings 'uninitialized' ;
+$C = "" ;
+$C .= $A ;
+EXPECT
+Use of uninitialized value in concatenation (.) or string at - line 10.
+########
+# sv.c 
+use warnings 'numeric' ;
+sub TIESCALAR{bless[]} ; 
+sub FETCH {"def"} ; 
+tie $a,"main" ; 
+my $b = 1 + $a;
+no warnings 'numeric' ;
+my $c = 1 + $a;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 6.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 + "def" ;
+no warnings 'numeric' ;
+my $z = 1 + "def" ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'numeric' ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $y = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ; use integer ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $z = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in integer addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 & "def" ;
+no warnings 'numeric' ;
+my $z = 1 & "def" ;
+EXPECT
+Argument "def" isn't numeric in bitwise and (&) at - line 3.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = pack i => "def" ;
+no warnings 'numeric' ;
+my $z = pack i => "def" ;
+EXPECT
+Argument "def" isn't numeric in pack at - line 3.
+########
+# sv.c
+use warnings 'numeric' ; 
+my $a = "d\0f" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $z = 1 + $a ;
+EXPECT
+Argument "d\0f" isn't numeric in addition (+) at - line 4.
+########
+# sv.c
+use warnings 'redefine' ;
+sub fred {}  
+sub joe {} 
+*fred = \&joe ;
+no warnings 'redefine' ;
+sub jim {} 
+*jim = \&joe ;
+EXPECT
+Subroutine fred redefined at - line 5.
+########
+# sv.c
+use warnings 'printf' ;
+open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+printf F "%z\n" ;
+my $a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+no warnings 'printf' ;
+printf F "%z\n" ;
+$a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+EXPECT
+Invalid conversion in sprintf: "%z" at - line 5.
+Invalid conversion in sprintf: end of string at - line 7.
+Invalid conversion in sprintf: "%\002" at - line 9.
+Invalid conversion in printf: "%z" at - line 4.
+Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in printf: "%\002" at - line 8.
+########
+# sv.c
+use warnings 'misc' ;
+*a = undef ;
+no warnings 'misc' ;
+*b = undef ;
+EXPECT
+Undefined value assigned to typeglob at - line 3.
+########
+# sv.c
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+	exit 0;
+    }
+    $|=1;
+}
+my $x;
+my $yy = 78;
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "#19%02d\n", $yy;
+$x     = printf  " 19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+$x     = printf  "319%02d\n", $yy;
+$x     = sprintf "319%02d\n", $yy;
+no warnings 'y2k';
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "19%02d\n", $yy;
+$x     = printf  "19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+EXPECT
+Possible Y2K bug: %d format string following '19' at - line 16.
+Possible Y2K bug: %d format string following '19' at - line 13.
+1978
+Possible Y2K bug: %d format string following '19' at - line 14.
+Possible Y2K bug: %d format string following '19' at - line 15.
+ 1978
+31978
+1978
+1978
diff --git a/lib/warnings/taint b/lib/warnings/taint
new file mode 100644
index 0000000000..fd6deed60f
--- /dev/null
+++ b/lib/warnings/taint
@@ -0,0 +1,49 @@
+  taint.c AOK
+
+  Insecure %s%s while running with -T switch
+
+__END__
+-T
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 5.
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+xxx
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+use warnings 'taint' ;
+chdir $a ;
+print "xxx\n" ;
+no warnings 'taint' ;
+chdir $a ;
+print "yyy\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 6.
+xxx
+yyy
diff --git a/lib/warnings/toke b/lib/warnings/toke
new file mode 100644
index 0000000000..242b0059fb
--- /dev/null
+++ b/lib/warnings/toke
@@ -0,0 +1,732 @@
+toke.c	AOK
+
+    we seem to have lost a few ambiguous warnings!!
+
+ 
+ 		$a = <<;
+ 		Use of comma-less variable list is deprecated 
+		(called 3 times via depcom)
+
+     \1 better written as $1 
+ 	use warnings 'syntax' ;
+ 	s/(abc)/\1/;
+ 
+     warn(warn_nosemi) 
+     Semicolon seems to be missing
+	$a = 1
+	&time ;
+
+
+     Reversed %c= operator 
+	my $a =+ 2 ;
+	$a =- 2 ;
+	$a =* 2 ;
+	$a =% 2 ;
+	$a =& 2 ;
+	$a =. 2 ;
+	$a =^ 2 ;
+	$a =| 2 ;
+	$a =< 2 ;
+	$a =/ 2 ;
+
+     Multidimensional syntax %.*s not supported 
+	my $a = $a[1,2] ;
+
+     You need to quote \"%s\"" 
+	sub fred {} ; $SIG{TERM} = fred;
+
+     Scalar value %.*s better written as $%.*s" 
+	@a[3] = 2;
+	@a{3} = 2;
+
+     Can't use \\%c to mean $%c in expression 
+	$_ = "ab" ; s/(ab)/\1/e;
+
+     Unquoted string "abc" may clash with future reserved word at - line 3.
+     warn(warn_reserved	
+	$a = abc;
+
+     chmod() mode argument is missing initial 0 
+	chmod 3;
+
+     Possible attempt to separate words with commas 
+	@a = qw(a, b, c) ;
+
+     Possible attempt to put comments in qw() list 
+	@a = qw(a b # c) ;
+
+     umask: argument is missing initial 0 
+	umask 3;
+
+     %s (...) interpreted as function 
+	print ("")
+	printf ("")
+	sort ("")
+
+     Ambiguous use of %c{%s%s} resolved to %c%s%s 
+	$a = ${time[2]}
+	$a = ${time{2}}
+
+
+     Ambiguous use of %c{%s} resolved to %c%s
+	$a = ${time}
+	sub fred {} $a = ${fred}
+
+     Misplaced _ in number 
+	$a = 1_2;
+	$a = 1_2345_6;
+
+    Bareword \"%s\" refers to nonexistent package
+	$a = FRED:: ;
+
+    Ambiguous call resolved as CORE::%s(), qualify as such or use &
+	sub time {} 
+	my $a = time()
+
+    Unrecognized escape \\%c passed through
+        $a = "\m" ;
+
+    %s number > %s non-portable
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+
+    Integer overflow in binary number
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+     
+    Mandatory Warnings
+    ------------------
+    Use of "%s" without parentheses is ambiguous	[check_uni]
+        rand + 4 
+
+    Ambiguous use of -%s resolved as -&%s() 		[yylex]
+        sub fred {} ; - fred ;
+
+    Precedence problem: open %.*s should be open(%.*s)	[yylex]
+    	open FOO || die;
+
+    Operator or semicolon missing before %c%s		[yylex]
+    Ambiguous use of %c resolved as operator %c
+        *foo *foo
+
+__END__
+# toke.c 
+use warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+no warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+EXPECT
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+########
+# toke.c
+use warnings 'deprecated' ;
+$a = <<;
+
+no warnings 'deprecated' ;
+$a = <<;
+
+EXPECT
+Use of bare << to mean <<"" is deprecated at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+s/(abc)/\1/;
+no warnings 'syntax' ;
+s/(abc)/\1/;
+EXPECT
+\1 better written as $1 at - line 3.
+########
+# toke.c
+use warnings 'semicolon' ;
+$a = 1
+&time ;
+no warnings 'semicolon' ;
+$a = 1
+&time ;
+EXPECT
+Semicolon seems to be missing at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+Reversed += operator at - line 3.
+Reversed -= operator at - line 4.
+Reversed *= operator at - line 5.
+Reversed %= operator at - line 6.
+Reversed &= operator at - line 7.
+Reversed .= operator at - line 8.
+Reversed ^= operator at - line 9.
+Reversed |= operator at - line 10.
+Reversed <= operator at - line 11.
+syntax error at - line 8, near "=."
+syntax error at - line 9, near "=^"
+syntax error at - line 10, near "=|"
+Unterminated <> operator at - line 11.
+########
+# toke.c
+no warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+syntax error at - line 8, near "=."
+syntax error at - line 9, near "=^"
+syntax error at - line 10, near "=|"
+Unterminated <> operator at - line 11.
+########
+# toke.c
+use warnings 'syntax' ;
+my $a = $a[1,2] ;
+no warnings 'syntax' ;
+my $a = $a[1,2] ;
+EXPECT
+Multidimensional syntax $a[1,2] not supported at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+sub fred {} ; $SIG{TERM} = fred;
+no warnings 'syntax' ;
+$SIG{TERM} = fred;
+EXPECT
+You need to quote "fred" at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+no warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+EXPECT
+Scalar value @a[3] better written as $a[3] at - line 3.
+Scalar value @a{3} better written as $a{3} at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+no warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+EXPECT
+Can't use \1 to mean $1 in expression at - line 4.
+########
+# toke.c
+use warnings 'reserved' ;
+$a = abc;
+$a = { def
+
+=> 1 };
+no warnings 'reserved' ;
+$a = abc;
+EXPECT
+Unquoted string "abc" may clash with future reserved word at - line 3.
+########
+# toke.c
+use warnings 'chmod' ;
+chmod 3;
+no warnings 'chmod' ;
+chmod 3;
+EXPECT
+chmod() mode argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a, b, c) ;
+no warnings 'qw' ;
+@a = qw(a, b, c) ;
+EXPECT
+Possible attempt to separate words with commas at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a b #) ;
+no warnings 'qw' ;
+@a = qw(a b #) ;
+EXPECT
+Possible attempt to put comments in qw() list at - line 3.
+########
+# toke.c
+use warnings 'umask' ;
+umask 3;
+no warnings 'umask' ;
+umask 3;
+EXPECT
+umask: argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+print ("")
+EXPECT
+print (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+print ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+printf ("")
+EXPECT
+printf (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+printf ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+sort ("")
+EXPECT
+sort (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+sort ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time[2]};
+no warnings 'ambiguous' ;
+$a = ${time[2]};
+EXPECT
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
+########
+# toke.c
+no warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time} ;
+no warnings 'ambiguous' ;
+$a = ${time} ;
+EXPECT
+Ambiguous use of ${time} resolved to $time at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub fred {}
+$a = ${fred} ;
+no warnings 'ambiguous' ;
+$a = ${fred} ;
+EXPECT
+Ambiguous use of ${fred} resolved to $fred at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$a = _123; print "$a\n";		#( 3	string)
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";		#  6
+$a = _+123; print "$a\n";		#  7	string)
+$a = +_123; print "$a\n";		#( 8	string)
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";		# 11
+$a = _-123; print "$a\n";		#(12	string)
+$a = -_123; print "$a\n";		#(13	string)
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";		# 16
+$a = 123._456; print "$a\n";		# 17
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";		# 20
+$a = +123._456; print "$a\n";		# 21
+$a = +123.4_56; print "$a\n";	
+$a = +123.45_6; print "$a\n";	
+$a = +123.456_; print "$a\n";		# 24
+$a = -123._456; print "$a\n";		# 25
+$a = -123.4_56; print "$a\n";	
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";		# 28
+$a = 123.456E_12; print "$a\n";		# 29
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";		# 31
+$a = 123.456E_+12; print "$a\n";	# 32
+$a = 123.456E+_12; print "$a\n";	# 33
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";	# 35
+$a = 123.456E_-12; print "$a\n";	# 36
+$a = 123.456E-_12; print "$a\n";	# 37
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";	# 39
+$a = 1__23; print "$a\n";		# 40
+$a = 12.3__4; print "$a\n";		# 41
+$a = 12.34e1__2; print "$a\n";		# 42
+no warnings 'syntax' ;
+$a = _123; print "$a\n";
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";
+$a = _+123; print "$a\n";
+$a = +_123; print "$a\n";
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";
+$a = _-123; print "$a\n";
+$a = -_123; print "$a\n";
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";
+$a = 123._456; print "$a\n";
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";
+$a = +123._456; print "$a\n";
+$a = +123.4_56; print "$a\n";
+$a = +123.45_6; print "$a\n";
+$a = +123.456_; print "$a\n";
+$a = -123._456; print "$a\n";
+$a = -123.4_56; print "$a\n";
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";
+$a = 123.456E_12; print "$a\n";
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";
+$a = 123.456E_+12; print "$a\n";
+$a = 123.456E+_12; print "$a\n";
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";
+$a = 123.456E_-12; print "$a\n";
+$a = 123.456E-_12; print "$a\n";
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";
+$a = 1__23; print "$a\n";
+$a = 12.3__4; print "$a\n";
+$a = 12.34e1__2; print "$a\n";
+EXPECT
+OPTIONS regex
+Misplaced _ in number at - line 6.
+Misplaced _ in number at - line 11.
+Misplaced _ in number at - line 16.
+Misplaced _ in number at - line 17.
+Misplaced _ in number at - line 20.
+Misplaced _ in number at - line 21.
+Misplaced _ in number at - line 24.
+Misplaced _ in number at - line 25.
+Misplaced _ in number at - line 28.
+Misplaced _ in number at - line 29.
+Misplaced _ in number at - line 31.
+Misplaced _ in number at - line 32.
+Misplaced _ in number at - line 33.
+Misplaced _ in number at - line 35.
+Misplaced _ in number at - line 36.
+Misplaced _ in number at - line 37.
+Misplaced _ in number at - line 39.
+Misplaced _ in number at - line 40.
+Misplaced _ in number at - line 41.
+Misplaced _ in number at - line 42.
+_123
+123
+123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+123
+12.34
+12340000000000
+_123
+123
+123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+1.23456e-0?10
+123
+12.34
+12340000000000
+########
+# toke.c
+use warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+no warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+EXPECT
+Bareword "FRED::" refers to nonexistent package at bar line 25.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub time {}
+my $a = time() ;
+no warnings 'ambiguous' ;
+my $b = time() ;
+EXPECT
+Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
+########
+# toke.c
+use warnings ;
+eval <<'EOE';
+#  line 30 "foo"
+warn "yelp";
+{
+  $_ = " \x{123} " ;
+}
+EOE
+EXPECT
+yelp at foo line 30.
+########
+# toke.c
+my $a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 2.
+########
+# toke.c
+$^W = 0 ;
+my $a = rand + 4 ;
+{
+    no warnings 'ambiguous' ;
+    $a = rand + 4 ;
+    use warnings 'ambiguous' ;
+    $a = rand + 4 ;
+}
+$a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 3.
+Warning: Use of "rand" without parens is ambiguous at - line 8.
+Warning: Use of "rand" without parens is ambiguous at - line 10.
+########
+# toke.c
+sub fred {};
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 3.
+########
+# toke.c
+$^W = 0 ;
+sub fred {} ;
+-fred ;
+{
+    no warnings 'ambiguous' ;
+    -fred ;
+    use warnings 'ambiguous' ;
+    -fred ;
+}
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 4.
+Ambiguous use of -fred resolved as -&fred() at - line 9.
+Ambiguous use of -fred resolved as -&fred() at - line 11.
+########
+# toke.c
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 2.
+########
+# toke.c
+$^W = 0 ;
+open FOO || time;
+{
+    no warnings 'precedence' ;
+    open FOO || time;
+    use warnings 'precedence' ;
+    open FOO || time;
+}
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 3.
+Precedence problem: open FOO should be open(FOO) at - line 8.
+Precedence problem: open FOO should be open(FOO) at - line 10.
+########
+# toke.c
+$^W = 0 ;
+*foo *foo ;
+{
+    no warnings 'ambiguous' ;
+    *foo *foo ;
+    use warnings 'ambiguous' ;
+    *foo *foo ;
+}
+*foo *foo ;
+EXPECT
+Operator or semicolon missing before *foo at - line 3.
+Ambiguous use of * resolved as operator * at - line 3.
+Operator or semicolon missing before *foo at - line 8.
+Ambiguous use of * resolved as operator * at - line 8.
+Operator or semicolon missing before *foo at - line 10.
+Ambiguous use of * resolved as operator * at - line 10.
+########
+# toke.c
+use warnings 'misc' ;
+my $a = "\m" ;
+no warnings 'misc' ;
+$a = "\m" ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# toke.c
+use warnings 'portable' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'portable' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+Hexadecimal number > 0xffffffff non-portable at - line 8.
+Octal number > 037777777777 non-portable at - line 11.
+########
+# toke.c
+use warnings 'overflow' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+no warnings 'overflow' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in hexadecimal number at - line 8.
+Integer overflow in octal number at - line 11.
+########
+# toke.c
+use warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+no warnings 'ambiguous';
+"@mjd_previously_unused_array";        
+EXPECT
+Possible unintended interpolation of @mjd_previously_unused_array in string at - line 3.
diff --git a/lib/warnings/universal b/lib/warnings/universal
new file mode 100644
index 0000000000..d9b1883532
--- /dev/null
+++ b/lib/warnings/universal
@@ -0,0 +1,14 @@
+  universal.c AOK
+
+  Can't locate package %s for @%s::ISA	[S_isa_lookup]
+      
+
+
+__END__
+# universal.c [S_isa_lookup]
+use warnings 'misc' ;
+@ISA = qw(Joe) ;
+my $a = bless [] ;
+UNIVERSAL::isa $a, Jim ;
+EXPECT
+Can't locate package Joe for @main::ISA at - line 5.
diff --git a/lib/warnings/utf8 b/lib/warnings/utf8
new file mode 100644
index 0000000000..9a7dbafdee
--- /dev/null
+++ b/lib/warnings/utf8
@@ -0,0 +1,35 @@
+
+  utf8.c AOK
+
+     [utf8_to_uv]
+     Malformed UTF-8 character
+	my $a = ord "\x80" ;
+
+     Malformed UTF-8 character
+	my $a = ord "\xf080" ;
+     <<<<<< this warning can't be easily triggered from perl anymore
+
+     [utf16_to_utf8]
+     Malformed UTF-16 surrogate		
+     <<<<<< Add a test when somethig actually calls utf16_to_utf8
+
+__END__
+# utf8.c [utf8_to_uv] -W
+BEGIN {
+    if (ord('A') == 193) {
+        print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
+        exit 0;
+    }
+}
+use utf8 ;
+my $a = "sn�storm" ;
+{
+    no warnings 'utf8' ;
+    my $a = "sn�storm";
+    use warnings 'utf8' ;
+    my $a = "sn�storm";
+}
+EXPECT
+Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 9.
+Malformed UTF-8 character (unexpected non-continuation byte 0x73 after start byte 0xf8) at - line 14.
+########
diff --git a/lib/warnings/util b/lib/warnings/util
new file mode 100644
index 0000000000..e82d6a6617
--- /dev/null
+++ b/lib/warnings/util
@@ -0,0 +1,108 @@
+  util.c AOK
+ 
+     Illegal octal digit ignored 
+	my $a = oct "029" ;
+
+     Illegal hex digit ignored 
+	my $a = hex "0xv9" ;
+
+     Illegal binary digit ignored
+      my $a = oct "0b9" ;
+     
+     Integer overflow in binary number
+	my $a =  oct "0b111111111111111111111111111111111111111111" ;
+     Binary number > 0b11111111111111111111111111111111 non-portable
+   	$a =  oct "0b111111111111111111111111111111111" ;
+     Integer overflow in octal number
+	my $a =  oct "077777777777777777777777777777" ;
+     Octal number > 037777777777 non-portable
+   	$a =  oct "0047777777777" ;
+     Integer overflow in hexadecimal number
+	my $a =  hex "0xffffffffffffffffffff" ;
+     Hexadecimal number > 0xffffffff non-portable
+   	$a =  hex "0x1ffffffff" ;
+
+__END__
+# util.c
+use warnings 'digit' ;
+my $a = oct "029" ;
+no warnings 'digit' ;
+$a = oct "029" ;
+EXPECT
+Illegal octal digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  hex "0xv9" ;
+no warnings 'digit' ;
+$a =  hex "0xv9" ;
+EXPECT
+Illegal hexadecimal digit 'v' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  oct "0b9" ;
+no warnings 'digit' ;
+$a =  oct "0b9" ;
+EXPECT
+Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+no warnings 'overflow' ;
+$a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+EXPECT
+Integer overflow in binary number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  hex "0xffffffffffffffffffff" ;
+no warnings 'overflow' ;
+$a =  hex "0xffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "077777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a =  oct "077777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+no warnings 'portable' ;
+   $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+no warnings 'portable' ;
+   $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+EXPECT
+Hexadecimal number > 0xffffffff non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+no warnings 'portable' ;
+   $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+EXPECT
+Octal number > 037777777777 non-portable at - line 5.