Import of Perl 5.003 into the tree. Makefile.bsd-wrapper and

config.sh.OpenBSD are the only local changes.

17 files changed, 2466 insertions, 0 deletions

diff --git a/gnu/usr.bin/perl/t/lib/anydbm.t b/gnu/usr.bin/perl/t/lib/anydbm.t
new file mode 100644
index 00000000000..7dbf3760b81
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/anydbm.t
@@ -0,0 +1,114 @@
+#!./perl
+
+# $RCSfile: anydbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:13 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+require AnyDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+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*>;
+}
+($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\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 gt $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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/bigint.t b/gnu/usr.bin/perl/t/lib/bigint.t
new file mode 100644
index 00000000000..034c5c64571
--- /dev/null
+++ b/gnu/usr.bin/perl/t/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/gnu/usr.bin/perl/t/lib/bigintpm.t b/gnu/usr.bin/perl/t/lib/bigintpm.t
new file mode 100644
index 00000000000..b229d7c67ba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/bigintpm.t
@@ -0,0 +1,310 @@
+#!./perl
+
+BEGIN { unshift @INC, './lib', '../lib';
+    require Config; import Config;
+}
+use Math::BigInt;
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+       chop;
+       if (s/^&//) {
+               $f = $_;
+       } else {
+               ++$test;
+               @args = split(/:/,$_,99);
+               $ans = pop(@args);
+               $try = "\$x = new Math::BigInt \"$args[0]\";";
+               if ($f eq "bnorm"){
+                   $try .= "\$x+0;";
+               } elsif ($f eq "bneg") {
+                   $try .= "-\$x;";
+               } elsif ($f eq "babs") {
+                   $try .= "abs \$x;";
+               } else {
+                   $try .= "\$y = new Math::BigInt \"$args[1]\";";
+                   if ($f eq bcmp){
+                       $try .= "\$x <=> \$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){
+                       $try .= "Math::BigInt::bgcd(\$x, \$y);";
+                   } else { warn "Unknown op"; }
+               }
+               #print ">>>",$try,"<<<\n";
+               $ans1 = eval $try;
+               if ("$ans1" eq $ans) { #bug!
+                       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:NaN
+abc:+0:NaN
++0:abc:NaN
++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/gnu/usr.bin/perl/t/lib/db-btree.t b/gnu/usr.bin/perl/t/lib/db-btree.t
new file mode 100644
index 00000000000..d90de6cd590
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-btree.t
@@ -0,0 +1,404 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..76\n";
+
+$Dfile = "Op.db-btree";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to BTREEINFO
+
+$dbh = TIEHASH DB_File::BTREEINFO ;
+print (($dbh->{flags} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{lorder} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{minkeypage} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{maxkeypage} == undef) ? "ok 6\n" : "not ok 6\n") ;
+print (($dbh->{compare} == undef) ? "ok 7\n" : "not ok 7\n") ;
+print (($dbh->{prefix} == undef) ? "ok 8\n" : "not ok 8\n") ;
+
+$dbh->{flags} = 3000 ;
+print ($dbh->{flags} == 3000 ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{cachesize} = 9000 ;
+print ($dbh->{cachesize} == 9000 ? "ok 10\n" : "not ok 10\n") ;
+#
+$dbh->{psize} = 400 ;
+print (($dbh->{psize} == 400) ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 65 ;
+print (($dbh->{lorder} == 65) ? "ok 12\n" : "not ok 12\n") ;
+
+$dbh->{minkeypage} = 123 ;
+print (($dbh->{minkeypage} == 123) ? "ok 13\n" : "not ok 13\n") ;
+
+$dbh->{maxkeypage} = 1234 ;
+print ($dbh->{maxkeypage} == 1234 ? "ok 14\n" : "not ok 14\n") ;
+
+$dbh->{compare} = 1234 ;
+print ($dbh->{compare} == 1234 ? "ok 15\n" : "not ok 15\n") ;
+
+$dbh->{prefix} = 1234 ;
+print ($dbh->{prefix} == 1234 ? "ok 16\n" : "not ok 16\n") ;
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 17\n" : "not ok 17\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 18\n" : "not ok 18\n") ;
+
+# Now check the interface to BTREE
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 19\n" : "not ok 19");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 20\n" : "not ok 20\n");
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 21\n" : "not ok 21\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+print ($h{'abc'} == 'ABC' ? "ok 22\n" : "not ok 22\n") ;
+print (defined $h{'jimmy'} ? "not ok 23\n" : "ok 23\n");
+
+$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';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+
+# tie to the same file again
+print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE)) ? "ok 24\n" : "not ok 24\n");
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$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'};
+$X->DELETE('goner3');
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 25\n";} else {print "not ok 25\n";}
+
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 26\n";} else {print "not ok 26\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 27\n";} else {print "not ok 27\n";}
+
+#Check that the keys can be retrieved in order
+$ok = 1 ;
+foreach (keys %h)
+{
+    ($ok = 0), last if defined $previous && $previous gt $_ ;
+    $previous = $_ ;
+}
+print ($ok ? "ok 28\n" : "not ok 28\n") ;
+
+$h{'foo'} = '';
+print ($h{'foo'} eq '' ? "ok 29\n" : "not ok 29\n") ;
+
+$h{''} = 'bar';
+print ($h{''} eq 'bar' ? "ok 30\n" : "not ok 30\n") ;
+
+# 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 31\n" : "not ok 31\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 32\n" : "not ok 32\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 33\n" : "not ok 33\n";
+
+# Now check all the non-tie specific stuff
+
+
+# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite
+# an existing record.
+ 
+$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+print ($status == 1 ? "ok 34\n" : "not ok 34\n") ;
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+print ($h{'x'} eq 'X' ? "ok 35\n" : "not ok 35\n") ;
+
+# standard put
+$status = $X->put('key', 'value') ;
+print ($status == 0 ? "ok 36\n" : "not ok 36\n") ;
+
+#check that previous put can be retrieved
+$status = $X->get('key', $value) ;
+print ($status == 0 ? "ok 37\n" : "not ok 37\n") ;
+print ($value eq 'value' ? "ok 38\n" : "not ok 38\n") ;
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+print ($status == 0 ? "ok 39\n" : "not ok 39\n") ;
+$status = $X->del('') ;
+print ($status == 0 ? "ok 40\n" : "not ok 40\n") ;
+
+# Make sure that the key deleted, cannot be retrieved
+print (($h{'q'} eq undef) ? "ok 41\n" : "not ok 41\n") ;
+print (($h{''} eq undef) ? "ok 42\n" : "not ok 42\n") ;
+
+undef $X ;
+untie %h ;
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE )) ? "ok 43\n" : "not ok 43");
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+print ($status == 1 ? "ok 44\n" : "not ok 44\n") ;
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+print ($status == 1 ? "ok 45\n" : "not ok 45\n") ;
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+print ($status == 0 ? "ok 46\n" : "not ok 46\n") ;
+print ($value eq 'A' ? "ok 47\n" : "not ok 47\n") ;
+
+# seq
+# ###
+
+# use seq to find an approximate match
+$key = 'ke' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 48\n" : "not ok 48\n") ;
+print ($key eq 'key' ? "ok 49\n" : "not ok 49\n") ;
+print ($value eq 'value' ? "ok 50\n" : "not ok 50\n") ;
+
+# seq when the key does not match
+$key = 'zzz' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 1 ? "ok 51\n" : "not ok 51\n") ;
+
+
+# use seq to set the cursor, then delete the record @ the cursor.
+
+$key = 'x' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 52\n" : "not ok 52\n") ;
+print ($key eq 'x' ? "ok 53\n" : "not ok 53\n") ;
+print ($value eq 'X' ? "ok 54\n" : "not ok 54\n") ;
+$status = $X->del(0, R_CURSOR) ;
+print ($status == 0 ? "ok 55\n" : "not ok 55\n") ;
+$status = $X->get('x', $value) ;
+print ($status == 1 ? "ok 56\n" : "not ok 56\n") ;
+
+# ditto, but use put to replace the key/value pair.
+$key = 'y' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 57\n" : "not ok 57\n") ;
+print ($key eq 'y' ? "ok 58\n" : "not ok 58\n") ;
+print ($value eq 'Y' ? "ok 59\n" : "not ok 59\n") ;
+
+$key = "replace key" ;
+$value = "replace value" ;
+$status = $X->put($key, $value, R_CURSOR) ;
+print ($status == 0 ? "ok 60\n" : "not ok 60\n") ;
+print ($key eq 'replace key' ? "ok 61\n" : "not ok 61\n") ;
+print ($value eq 'replace value' ? "ok 62\n" : "not ok 62\n") ;
+$status = $X->get('y', $value) ;
+print ($status == 1 ? "ok 63\n" : "not ok 63\n") ;
+
+# use seq to walk forwards through a file 
+
+$status = $X->seq($key, $value, R_FIRST) ;
+print ($status == 0 ? "ok 64\n" : "not ok 64\n") ;
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_NEXT)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == 1 ;
+}
+
+print ($status == 1 ? "ok 65\n" : "not ok 65\n") ;
+print ($ok == 1 ? "ok 66\n" : "not ok 66\n") ;
+
+# use seq to walk backwards through a file 
+$status = $X->seq($key, $value, R_LAST) ;
+print ($status == 0 ? "ok 67\n" : "not ok 67\n") ;
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_PREV)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == -1 ;
+    #print "key = [$key] value = [$value]\n" ;
+}
+
+print ($status == 1 ? "ok 68\n" : "not ok 68\n") ;
+print ($ok == 1 ? "ok 69\n" : "not ok 69\n") ;
+
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+print ($status == 0 ? "ok 70\n" : "not ok 70\n") ;
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+print ($status != 0 ? "ok 71\n" : "not ok 71\n") ;
+
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+print (($Y = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 72\n" : "not ok 72");
+
+# fd with an in memory file should return failure
+$status = $Y->fd ;
+print ($status == -1 ? "ok 73\n" : "not ok 73\n") ;
+
+undef $Y ;
+untie %h ;
+
+# test multiple callbacks
+$Dfile1 = "btree1" ;
+$Dfile2 = "btree2" ;
+$Dfile3 = "btree3" ;
+ 
+$dbh1 = TIEHASH DB_File::BTREEINFO ;
+$dbh1->{compare} = sub { $_[0] <=> $_[1] } ;
+ 
+$dbh2 = TIEHASH DB_File::BTREEINFO ;
+$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
+ 
+$dbh3 = TIEHASH DB_File::BTREEINFO ;
+$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ;
+ 
+ 
+tie(%h, DB_File,$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) ;
+tie(%g, DB_File,$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) ;
+tie(%k, DB_File,$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) ;
+ 
+@Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
+@srt_1 = sort { $a <=> $b } @Keys ;
+@srt_2 = sort { $a cmp $b } @Keys ;
+@srt_3 = sort { length $a <=> length $b } @Keys ;
+ 
+foreach (@Keys) {
+    $h{$_} = 1 ;
+    $g{$_} = 1 ;
+    $k{$_} = 1 ;
+}
+ 
+sub ArrayCompare
+{
+    my($a, $b) = @_ ;
+ 
+    return 0 if @$a != @$b ;
+ 
+    foreach (1 .. length @$a)
+    {
+        return 0 unless $$a[$_] eq $$b[$_] ;
+    }
+ 
+    1 ;
+}
+ 
+print ( ArrayCompare (\@srt_1, [keys %h]) ? "ok 74\n" : "not ok 74\n") ;
+print ( ArrayCompare (\@srt_2, [keys %g]) ? "ok 75\n" : "not ok 75\n") ;
+print ( ArrayCompare (\@srt_3, [keys %k]) ? "ok 76\n" : "not ok 76\n") ;
+
+untie %h ;
+untie %g ;
+untie %k ;
+unlink $Dfile1, $Dfile2, $Dfile3 ;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/db-hash.t b/gnu/usr.bin/perl/t/lib/db-hash.t
new file mode 100644
index 00000000000..6c3ef552001
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-hash.t
@@ -0,0 +1,253 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..43\n";
+
+$Dfile = "Op.db-hash";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to HASHINFO
+
+$dbh = TIEHASH DB_File::HASHINFO ;
+print (($dbh->{bsize} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{ffactor} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{nelem} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{hash} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{lorder} == undef) ? "ok 6\n" : "not ok 6\n") ;
+
+$dbh->{bsize} = 3000 ;
+print ($dbh->{bsize} == 3000 ? "ok 7\n" : "not ok 7\n") ;
+
+$dbh->{ffactor} = 9000 ;
+print ($dbh->{ffactor} == 9000 ? "ok 8\n" : "not ok 8\n") ;
+#
+$dbh->{nelem} = 400 ;
+print (($dbh->{nelem} == 400) ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{cachesize} = 65 ;
+print (($dbh->{cachesize} == 65) ? "ok 10\n" : "not ok 10\n") ;
+
+$dbh->{hash} = "abc" ;
+print (($dbh->{hash} eq "abc") ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 1234 ;
+print ($dbh->{lorder} == 1234 ? "ok 12\n" : "not ok 12\n") ;
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 13\n" : "not ok 13\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 14\n" : "not ok 14\n") ;
+
+# Now check the interface to HASH
+
+print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 15\n" : "not ok 15");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 16\n" : "not ok 16\n");
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+print (!$i ? "ok 17\n" : "not ok 17\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+print ($h{'abc'} == 'ABC' ? "ok 18\n" : "not ok 18\n") ;
+print (defined $h{'jimmy'} ? "not ok 19\n" : "ok 19\n");
+
+$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';
+$X->STORE('b', 'B') ;
+
+$h{'c'} = 'C';
+
+#$h{'d'} = 'D';
+$X->put('d', 'D') ;
+
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'X';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(%h);
+
+
+# tie to the same file again, do not supply a type - should default to HASH
+print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640)) ? "ok 20\n" : "not ok 20: $!\n");
+
+# Modify an entry from the previous tie
+$h{'g'} = 'G';
+
+$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'};
+$X->DELETE('goner3');
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 21\n";} else {print "not ok 21\n";}
+
+while (($key,$value) = each(h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 22\n";} else {print "not ok 22\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$h{'foo'} = '';
+print ($h{'foo'} eq '' ? "ok 24\n" : "not ok 24\n") ;
+
+$h{''} = 'bar';
+print ($h{''} eq 'bar' ? "ok 25\n" : "not ok 25\n") ;
+
+# 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 26\n" : "not ok 26\n");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print ($size > 0 ? "ok 27\n" : "not ok 27\n");
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+print join(':',200..400) eq join(':',@foo) ? "ok 28\n" : "not ok 28\n";
+
+
+# Now check all the non-tie specific stuff
+
+# Check NOOVERWRITE will make put fail when attempting to overwrite
+# an existing record.
+ 
+$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
+print ($status == 1 ? "ok 29\n" : "not ok 29\n") ;
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+print ($h{'x'} eq 'X' ? "ok 30\n" : "not ok 30\n") ;
+
+# standard put
+$status = $X->put('key', 'value') ;
+print ($status == 0 ? "ok 31\n" : "not ok 31\n") ;
+
+#check that previous put can be retrieved
+$status = $X->get('key', $value) ;
+print ($status == 0 ? "ok 32\n" : "not ok 32\n") ;
+print ($value eq 'value' ? "ok 33\n" : "not ok 33\n") ;
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+print ($status == 0 ? "ok 34\n" : "not ok 34\n") ;
+
+# Make sure that the key deleted, cannot be retrieved
+print (($h{'q'} eq undef) ? "ok 35\n" : "not ok 35\n") ;
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+print ($status == 1 ? "ok 36\n" : "not ok 36\n") ;
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+print ($status == 1 ? "ok 37\n" : "not ok 37\n") ;
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+print ($status == 0 ? "ok 38\n" : "not ok 38\n") ;
+print ($value eq 'A' ? "ok 39\n" : "not ok 39\n") ;
+
+# seq
+# ###
+
+# ditto, but use put to replace the key/value pair.
+
+# use seq to walk backwards through a file - check that this reversed is
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+print ($status == 0 ? "ok 40\n" : "not ok 40\n") ;
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+print ($status != 0 ? "ok 41\n" : "not ok 41\n") ;
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+print (($X = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 42\n" : "not ok 42");
+
+# fd with an in memory file should return fail
+$status = $X->fd ;
+print ($status == -1 ? "ok 43\n" : "not ok 43\n") ;
+
+untie %h ;
+undef $X ;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/db-recno.t b/gnu/usr.bin/perl/t/lib/db-recno.t
new file mode 100644
index 00000000000..64ad7b8a9ef
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/db-recno.t
@@ -0,0 +1,142 @@
+#!./perl
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..30\n";
+
+$Dfile = "Op.db-recno";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to RECNOINFO
+
+$dbh = TIEHASH DB_File::RECNOINFO ;
+print (($dbh->{bval} == undef) ? "ok 1\n" : "not ok 1\n") ;
+print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ;
+print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ;
+print (($dbh->{flags} == undef) ? "ok 4\n" : "not ok 4\n") ;
+print (($dbh->{lorder} == undef) ? "ok 5\n" : "not ok 5\n") ;
+print (($dbh->{reclen} == undef) ? "ok 6\n" : "not ok 6\n") ;
+print (($dbh->{bfname} == undef) ? "ok 7\n" : "not ok 7\n") ;
+
+$dbh->{bval} = 3000 ;
+print ($dbh->{bval} == 3000 ? "ok 8\n" : "not ok 8\n") ;
+
+$dbh->{cachesize} = 9000 ;
+print ($dbh->{cachesize} == 9000 ? "ok 9\n" : "not ok 9\n") ;
+
+$dbh->{psize} = 400 ;
+print (($dbh->{psize} == 400) ? "ok 10\n" : "not ok 10\n") ;
+
+$dbh->{flags} = 65 ;
+print (($dbh->{flags} == 65) ? "ok 11\n" : "not ok 11\n") ;
+
+$dbh->{lorder} = 123 ;
+print (($dbh->{lorder} == 123) ? "ok 12\n" : "not ok 12\n") ;
+
+$dbh->{reclen} = 1234 ;
+print ($dbh->{reclen} == 1234 ? "ok 13\n" : "not ok 13\n") ;
+
+$dbh->{bfname} = 1234 ;
+print ($dbh->{bfname} == 1234 ? "ok 14\n" : "not ok 14\n") ;
+
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+print ($@ eq '' ? "ok 15\n" : "not ok 15\n") ;
+eval '$q = $dbh->{fred}' ;
+print ($@ eq '' ? "ok 16\n" : "not ok 16\n") ;
+
+# Now check the interface to RECNOINFO
+
+print (($X = tie(@h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO )) ? "ok 17\n" : "not ok 17");
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+print (($mode & 0777) == 0640 ? "ok 18\n" : "not ok 18\n");
+
+#$l = @h ;
+$l = $X->length ;
+print (!$l ? "ok 19\n" : "not ok 19\n");
+
+@data = qw( a b c d ever f g h  i j k longername m n o p) ;
+
+$h[0] = shift @data ;
+print ($h[0] eq 'a' ? "ok 20\n" : "not ok 20\n") ;
+
+foreach (@data)
+  { $h[++$i] = $_ }
+
+unshift (@data, 'a') ;
+
+print (defined $h[1] ? "ok 21\n" : "not ok 21\n");
+print (! defined $h[16] ? "ok 22\n" : "not ok 22\n");
+print ($X->length == @data ? "ok 23\n" : "not ok 23\n") ;
+
+
+# Overwrite an entry & check fetch it
+$h[3] = 'replaced' ;
+$data[3] = 'replaced' ;
+print ($h[3] eq 'replaced' ? "ok 24\n" : "not ok 24\n");
+
+#PUSH
+@push_data = qw(added to the end) ;
+#push (@h, @push_data) ;
+$X->push(@push_data) ;
+push (@data, @push_data) ;
+print ($h[++$i] eq 'added' ? "ok 25\n" : "not ok 25\n");
+
+# POP
+pop (@data) ;
+#$value = pop(@h) ;
+$value = $X->pop ;
+print ($value eq 'end' ? "not ok 26\n" : "ok 26\n");
+
+# SHIFT
+#$value = shift @h
+$value = $X->shift ;
+print ($value eq shift @data ? "not ok 27\n" : "ok 27\n");
+
+# UNSHIFT
+
+# empty list
+$X->unshift ;
+print ($X->length == @data ? "ok 28\n" : "not ok 28\n") ;
+
+@new_data = qw(add this to the start of the array) ;
+#unshift @h, @new_data ;
+$X->unshift (@new_data) ;
+unshift (@data, @new_data) ;
+print ($X->length == @data ? "ok 29\n" : "not ok 29\n") ;
+
+# SPLICE
+
+# Now both arrays should be identical
+
+$ok = 1 ;
+$j = 0 ;
+foreach (@data)
+{
+   $ok = 0, last if $_ ne $h[$j ++] ; 
+}
+print ($ok ? "ok 30\n" : "not ok 30\n") ;
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(@h);
+
+unlink $Dfile;
+
+exit ;
diff --git a/gnu/usr.bin/perl/t/lib/dirhand.t b/gnu/usr.bin/perl/t/lib/dirhand.t
new file mode 100644
index 00000000000..8403609578e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dirhand.t
@@ -0,0 +1,33 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bPOSIX\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DirHandle;
+
+print "1..5\n";
+
+$dot = new DirHandle ".";
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = <*>;
+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/gnu/usr.bin/perl/t/lib/english.t b/gnu/usr.bin/perl/t/lib/english.t
new file mode 100644
index 00000000000..d7a30f9305c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/english.t
@@ -0,0 +1,41 @@
+#!./perl
+
+print "1..16\n";
+
+BEGIN { @INC = '../lib' }
+use English;
+
+print $PID == $$ ? "ok 1\n" : "not ok 1\n";
+
+$_ = 1;
+print $ARG == $_ ? "ok 2\n" : "not ok 2\n";
+
+sub foo {
+    print $ARG[0] == $_[0] ? "ok 3\n" : "not ok 3\n";
+}
+&foo(1);
+
+$ARG = "ok 4\nok 5\nok 6\n";
+/ok 5\n/;
+print $PREMATCH, $MATCH, $POSTMATCH;
+
+$OFS = " ";
+$ORS = "\n";
+print 'ok',7;
+undef $OUTPUT_FIELD_SEPARATOR;
+
+$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/;
+
+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 == $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
diff --git a/gnu/usr.bin/perl/t/lib/filehand.t b/gnu/usr.bin/perl/t/lib/filehand.t
new file mode 100644
index 00000000000..fc433502126
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/filehand.t
@@ -0,0 +1,35 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFileHandle\b/ && $^O ne 'VMS') {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use FileHandle;
+use strict subs;
+
+$mystdout = new_from_fd FileHandle 1,"w";
+autoflush STDOUT;
+autoflush $mystdout;
+print "1..4\n";
+
+print $mystdout "ok ",fileno($mystdout),"\n";
+
+$fh = new FileHandle "TEST", O_RDONLY and print "ok 2\n";
+$buffer = <$fh>;
+print $buffer eq "#!./perl\n" ? "ok 3\n" : "not ok 3\n";
+
+if ($^O eq 'VMS') {
+    ungetc $fh 65;
+    CORE::read($fh, $buf,1);
+}
+else {
+    ungetc STDIN 65;
+    CORE::read(STDIN, $buf,1);
+}
+print $buf eq 'A' ? "ok 4\n" : "not ok 4\n";
diff --git a/gnu/usr.bin/perl/t/lib/gdbm.t b/gnu/usr.bin/perl/t/lib/gdbm.t
new file mode 100644
index 00000000000..92e4eb219de
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gdbm.t
@@ -0,0 +1,117 @@
+#!./perl
+
+# $RCSfile: gdbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use GDBM_File;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+	($Dfile) = <Op.dbmx*>;
+}
+($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\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,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 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 gt $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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/ndbm.t b/gnu/usr.bin/perl/t/lib/ndbm.t
new file mode 100644
index 00000000000..4a3d0f0a7d3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ndbm.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $RCSfile: ndbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bNDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+require NDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,NDBM_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*>;
+}
+($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\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,NDBM_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 gt $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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/odbm.t b/gnu/usr.bin/perl/t/lib/odbm.t
new file mode 100644
index 00000000000..7988a43ac2d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/odbm.t
@@ -0,0 +1,120 @@
+#!./perl
+
+# $RCSfile: odbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bODBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+require ODBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,ODBM_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*>;
+}
+($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\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,ODBM_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 gt $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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/posix.t b/gnu/usr.bin/perl/t/lib/posix.t
new file mode 100644
index 00000000000..23007ff0595
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/posix.t
@@ -0,0 +1,66 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write);
+use strict subs;
+
+$| = 1;
+print "1..14\n";
+
+$testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
+read($testfd, $buffer, 9) if $testfd > 2;
+print $buffer eq "#!./perl\n" ? "ok 2\n" : "not ok 2\n";
+
+write(1,"ok 3\nnot ok 3\n", 5);
+
+@fds = POSIX::pipe();
+print $fds[0] > $testfd ? "ok 4\n" : "not ok 4\n";
+CORE::open($reader = \*READER, "<&=".$fds[0]);
+CORE::open($writer = \*WRITER, ">&=".$fds[1]);
+print $writer "ok 5\n";
+close $writer;
+print <$reader>;
+close $reader;
+
+$sigset = new POSIX::SigSet 1,3;
+delset $sigset 1;
+if (!ismember $sigset 1) { print "ok 6\n" }
+if (ismember $sigset 3) { print "ok 7\n" }
+$mask = new POSIX::SigSet &SIGINT;
+$action = new POSIX::SigAction 'main::SigHUP', $mask, 0;
+sigaction(&SIGHUP, $action);
+$SIG{'INT'} = 'SigINT';
+kill 'HUP', $$;
+sleep 1;
+print "ok 11\n";
+
+sub SigHUP {
+    print "ok 8\n";
+    kill 'INT', $$;
+    sleep 2;
+    print "ok 9\n";
+}
+
+sub SigINT {
+    print "ok 10\n";
+}
+
+print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
+
+print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n";
+
+# Pick up whether we're really able to dynamically load everything.
+print &POSIX::acos(1.0) == 0.0 ? "ok 14\n" : "not ok 14\n";
+
+$| = 0;
+print '@#!*$@(!@#$';
+_exit(0);
diff --git a/gnu/usr.bin/perl/t/lib/safe.t b/gnu/usr.bin/perl/t/lib/safe.t
new file mode 100644
index 00000000000..e59c81406b1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/safe.t
@@ -0,0 +1,96 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSafe\b/ && $^O ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+use Safe qw(opname opcode ops_to_mask mask_to_ops);
+
+print "1..23\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+$bar .= "";
+
+$bar = "invisible";
+$cpt = new Safe "Root";
+$cpt->reval(q{
+    system("echo not ok 1");
+});
+if ($@ =~ /^system trapped by operation mask/) {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}
+
+$cpt->reval(q{
+    print $foo eq 'visible' ? "ok 2\n" : "not ok 2\n";
+    print $main::foo  eq 'visible' ? "ok 3\n" : "not ok 3\n";
+    print defined($bar) ? "not ok 4\n" : "ok 4\n";
+    print defined($::bar) ? "not ok 5\n" : "ok 5\n";
+    print defined($main::bar) ? "not ok 6\n" : "ok 6\n";
+});
+print $@ ? "not ok 7\n" : "ok 7\n";
+
+$foo = "ok 8\n";
+%bar = (key => "ok 9\n");
+@baz = "o";
+push(@baz, "10"); # Two steps to prevent "Identifier used only once..."
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+$" = 'k ';
+
+sub sayok12 { print "ok 12\n" }
+
+$cpt->share(qw($foo %bar @baz *glob &sayok12 $"));
+
+$cpt->reval(q{
+    print $foo ? $foo : "not ok 8\n";
+    print $bar{key} ? $bar{key} : "not ok 9\n";
+    if (@baz) {
+	print "@baz\n";
+    } else {
+	print "not ok 10\n";
+    }
+    print $glob;
+    sayok12();
+    $foo =~ s/8/14/;
+    $bar{new} = "ok 15\n";
+    @glob = qw(ok 16);
+});
+print $@ ? "not ok 13\n#$@" : "ok 13\n";
+$" = ' ';
+print $foo, $bar{new}, "@glob\n";
+
+$Root::foo = "not ok 17";
+@{$cpt->varglob('bar')} = qw(not ok 18);
+${$cpt->varglob('foo')} = "ok 17";
+@Root::bar = "ok";
+push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+print "$Root::foo\n";
+print "@{$cpt->varglob('bar')}\n";
+
+print opname(23) eq "bless" ? "ok 19\n" : "not ok 19\n";
+print opcode("bless") == 23 ? "ok 20\n" : "not ok 20\n";
+
+$m1 = $cpt->mask();
+$cpt->trap("negate");
+$m2 = $cpt->mask();
+@masked = mask_to_ops($m1);
+print $m2 eq ops_to_mask("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+$cpt->untrap(187);
+substr($m2, 187, 1) = "\0";
+print $m2 eq $cpt->mask() ? "ok 22\n" : "not ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
diff --git a/gnu/usr.bin/perl/t/lib/sdbm.t b/gnu/usr.bin/perl/t/lib/sdbm.t
new file mode 100644
index 00000000000..26ef5425e65
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/sdbm.t
@@ -0,0 +1,119 @@
+#!./perl
+
+# $RCSfile: sdbm.t,v $$Revision: 1.1 $$Date: 1996/08/19 10:13:15 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+require SDBM_File;
+#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
+use Fcntl;
+
+print "1..12\n";
+
+unlink <Op.dbmx*>;
+
+umask(0);
+print (tie(%h,SDBM_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*>;
+}
+($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\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,SDBM_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 gt $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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/gnu/usr.bin/perl/t/lib/socket.t b/gnu/usr.bin/perl/t/lib/socket.t
new file mode 100644
index 00000000000..afc2a5bb751
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/socket.t
@@ -0,0 +1,68 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bSocket\b/ && 
+        !(($^O eq 'VMS') && $Config{d_has_socket})) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+	
+use Socket;
+
+print "1..6\n";
+
+if (socket(T,PF_INET,SOCK_STREAM,6)) {
+  print "ok 1\n";
+
+  if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){
+	print "ok 2\n";
+
+	print "# Connected to ",
+		inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1]),"\n";
+
+	syswrite(T,"hello",5);
+	$read = sysread(T,$buff,10);	# Connection may be granted, then closed!
+	print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n");
+  }
+  else {
+	print "# You're allowed to fail tests 2 and 3 if.\n";
+	print "# The echo service has been disabled.\n";
+	print "# $!\n";
+	print "ok 2\n";
+	print "ok 3\n";
+  }
+}
+else {
+	print "# $!\n";
+	print "not ok 1\n";
+}
+
+if( socket(S,PF_INET,SOCK_STREAM,6) ){
+  print "ok 4\n";
+
+  if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){
+	print "ok 5\n";
+
+	print "# Connected to ",
+		inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1]),"\n";
+
+	syswrite(S,"olleh",5);
+	$read = sysread(S,$buff,10);	# Connection may be granted, then closed!
+	print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n");
+  }
+  else {
+	print "# You're allowed to fail tests 5 and 6 if.\n";
+	print "# The echo service has been disabled.\n";
+	print "# $!\n";
+	print "ok 5\n";
+	print "ok 6\n";
+  }
+}
+else {
+	print "# $!\n";
+	print "not ok 4\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/soundex.t b/gnu/usr.bin/perl/t/lib/soundex.t
new file mode 100644
index 00000000000..60d952ca365
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/soundex.t
@@ -0,0 +1,146 @@
+#!./perl
+#
+# $Id: soundex.t,v 1.1 1996/08/19 10:13:15 downsj Exp $
+#
+# test module for soundex.pl
+#
+# $Log: soundex.t,v $
+# Revision 1.1  1996/08/19 10:13:15  downsj
+# Initial revision
+#
+# 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