Initial import of Perl5. The king is dead; long live the king!

197 files changed, 23110 insertions, 0 deletions

diff --git a/contrib/perl5/t/README b/contrib/perl5/t/README
new file mode 100644
index 0000000..8384349
--- /dev/null
+++ b/contrib/perl5/t/README
@@ -0,0 +1,16 @@
+This is the perl test library.  To run all the tests, just type 'TEST'.
+
+To add new tests, just look at the current tests and do likewise.
+
+If a test fails, run it by itself to see if it prints any informative
+diagnostics.  If not, modify the test to print informative diagnostics.
+If you put out extra lines with a '#' character on the front, you don't
+have to worry about removing the extra print statements later since TEST
+ignores lines beginning with '#'.
+
+If you know that Perl is basically working but expect that some tests
+will fail, you may want to use Test::Harness thusly:
+	./perl -I../lib harness
+This method pinpoints failed tests automatically.
+
+If you come up with new tests, please send them to larry@wall.org.
diff --git a/contrib/perl5/t/TEST b/contrib/perl5/t/TEST
new file mode 100755
index 0000000..3685c2a
--- /dev/null
+++ b/contrib/perl5/t/TEST
@@ -0,0 +1,181 @@
+#!./perl
+
+# Last change: Fri Jan 10 09:57:03 WET 1997
+
+# This is written in a peculiar style, since we're trying to avoid
+# most of the constructs we'll be testing for.
+
+$| = 1;
+
+if ($#ARGV >= 0 && $ARGV[0] eq '-v') {
+    $verbose = 1;
+    shift;
+}
+
+chdir 't' if -f 't/TEST';
+
+die "You need to run \"make test\" first to set things up.\n"
+  unless -e 'perl' or -e 'perl.exe';
+
+# check leakage for embedders
+$ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
+
+$ENV{EMXSHELL} = 'sh';        # For OS/2
+
+if ($#ARGV == -1) {
+    @ARGV = split(/[ \n]/,
+      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
+}
+
+%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); 
+
+_testprogs('perl', @ARGV);
+_testprogs('compile', @ARGV) if (-e "../testcompile"); 
+
+sub _testprogs {
+    $type = shift @_;
+    @tests = @_;
+
+
+    print <<'EOT' if ($type eq 'compile');
+--------------------------------------------------------------------------------
+TESTING COMPILER
+--------------------------------------------------------------------------------
+EOT
+
+    $bad = 0;
+    $good = 0;
+    $total = @tests;
+    $files  = 0;
+    $totmax = 0;
+    $maxlen = 0;
+    foreach (@tests) {
+	$len = length;
+	$maxlen = $len if $len > $maxlen;
+    }
+    # +3 : we want three dots between the test name and the "ok"
+    # -2 : the .t suffix
+    $dotdotdot = $maxlen + 3 - 2;
+    while ($test = shift @tests) {
+
+	if ( $infinite{$test} && $type eq 'compile' ) {
+	    print STDERR "$test creates infinite loop! Skipping.\n"; 
+            next;
+	}
+	if ($test =~ /^$/) {
+	    next;
+	}
+	$te = $test;
+	chop($te);
+	print "$te" . '.' x ($dotdotdot - length($te));
+
+	open(SCRIPT,"<$test") or die "Can't run $test.\n";
+	$_ = <SCRIPT>;
+	close(SCRIPT);
+	if (/#!.*perl(.*)$/) {
+	    $switch = $1;
+	    if ($^O eq 'VMS') {
+		# Must protect uppercase switches with "" on command line
+		$switch =~ s/-([A-Z]\S*)/"-$1"/g;
+	    }
+	}
+	else {
+	    $switch = '';
+	}
+
+	if ($type eq 'perl') {
+	    open(RESULTS,"./perl$switch $test |") or print "can't run.\n";
+	}
+	else {
+	    open(RESULTS, "./perl -I../lib ../utils/perlcc ./$test "
+	    		 ."-run -verbose dcf -log ../compilelog |")
+		or print "can't compile.\n";
+	}
+
+	$ok = 0;
+	$next = 0;
+	while (<RESULTS>) {
+	    if ($verbose) {
+		print $_;
+	    }
+	    unless (/^#/) {
+		if (/^1\.\.([0-9]+)/) {
+		    $max = $1;
+		    $totmax += $max;
+		    $files += 1;
+		    $next = 1;
+		    $ok = 1;
+		}
+		else {
+		    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+		    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
+			$next = $next + 1;
+		    }
+		    else {
+			$ok = 0;
+		    }
+		}
+	    }
+	}
+	close RESULTS;
+	$next = $next - 1;
+	if ($ok && $next == $max) {
+	    if ($max) {
+		print "ok\n";
+		$good = $good + 1;
+	    }
+	    else {
+		print "skipping test on this platform\n";
+		$files -= 1;
+	    }
+	}
+	else {
+	    $next += 1;
+	    print "FAILED at test $next\n";
+	    $bad = $bad + 1;
+	    $_ = $test;
+	    if (/^base/) {
+		die "Failed a basic test--cannot continue.\n";
+	    }
+	}
+    }
+
+    if ($bad == 0) {
+	if ($ok) {
+	    print "All tests successful.\n";
+	    # XXX add mention of 'perlbug -ok' ?
+	}
+	else {
+	    die "FAILED--no tests were run for some reason.\n";
+	}
+    }
+    else {
+	$pct = sprintf("%.2f", $good / $total * 100);
+	if ($bad == 1) {
+	    warn "Failed 1 test script out of $total, $pct% okay.\n";
+	}
+	else {
+	    warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+	}
+	warn <<'SHRDLU';
+   ### Since not all tests were successful, you may want to run some
+   ### of them individually and examine any diagnostic messages they
+   ### produce.  See the INSTALL document's section on "make test".
+   ### If you are testing the compiler, then ignore this message 
+   ### and run 
+   ###      ./perl harness
+   ### in the directory ./t.
+SHRDLU
+	warn <<'SHRDLU' if $good / $total > 0.8;
+   ###
+   ### Since most tests were successful, you have a good chance to
+   ### get information with better granularity by running
+   ###     ./perl harness 
+   ### in directory ./t.
+SHRDLU
+    }
+    ($user,$sys,$cuser,$csys) = times;
+    print sprintf("u=%g  s=%g  cu=%g  cs=%g  scripts=%d  tests=%d\n",
+	$user,$sys,$cuser,$csys,$files,$totmax);
+}
+exit ($bad != 0);
diff --git a/contrib/perl5/t/base/cond.t b/contrib/perl5/t/base/cond.t
new file mode 100755
index 0000000..9a57348
--- /dev/null
+++ b/contrib/perl5/t/base/cond.t
@@ -0,0 +1,19 @@
+#!./perl
+
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:02 $
+
+# make sure conditional operators work
+
+print "1..4\n";
+
+$x = '0';
+
+$x eq $x && (print "ok 1\n");
+$x ne $x && (print "not ok 1\n");
+$x eq $x || (print "not ok 2\n");
+$x ne $x || (print "ok 2\n");
+
+$x == $x && (print "ok 3\n");
+$x != $x && (print "not ok 3\n");
+$x == $x || (print "not ok 4\n");
+$x != $x || (print "ok 4\n");
diff --git a/contrib/perl5/t/base/if.t b/contrib/perl5/t/base/if.t
new file mode 100755
index 0000000..12db765
--- /dev/null
+++ b/contrib/perl5/t/base/if.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $RCSfile: if.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:03 $
+
+print "1..2\n";
+
+# first test to see if we can run the tests.
+
+$x = 'test';
+if ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";}
+if ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";}
diff --git a/contrib/perl5/t/base/lex.t b/contrib/perl5/t/base/lex.t
new file mode 100755
index 0000000..045cb22
--- /dev/null
+++ b/contrib/perl5/t/base/lex.t
@@ -0,0 +1,119 @@
+#!./perl
+
+# $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
+
+print "1..30\n";
+
+$x = 'x';
+
+print "#1	:$x: eq :x:\n";
+if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = $#;	# this is the register $#
+
+if ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = $#x;
+
+if ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
+
+$x = '\\'; # ';
+
+if (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
+
+eval 'while (0) {
+    print "foo\n";
+}
+/^/ && (print "ok 5\n");
+';
+
+eval '$foo{1} / 1;';
+if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
+
+eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
+
+$foo = int($foo * 100 + .5);
+if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7 :$foo:\n";}
+
+print <<'EOF';
+ok 8
+EOF
+
+$foo = 'ok 9';
+print <<EOF;
+$foo
+EOF
+
+eval <<\EOE, print $@;
+print <<'EOF';
+ok 10
+EOF
+
+$foo = 'ok 11';
+print <<EOF;
+$foo
+EOF
+EOE
+
+print <<`EOS` . <<\EOF;
+echo ok 12
+EOS
+ok 13
+EOF
+
+print qq/ok 14\n/;
+print qq(ok 15\n);
+
+print qq
+[ok 16\n]
+;
+
+print q<ok 17
+>;
+
+print <<;   # Yow!
+ok 18
+
+# previous line intentionally left blank.
+
+print <<E1 eq "foo\n\n" ? "ok 19\n" : "not ok 19\n";
+@{[ <<E2 ]}
+foo
+E2
+E1
+
+print <<E1 eq "foo\n\n" ? "ok 20\n" : "not ok 20\n";
+@{[
+  <<E2
+foo
+E2
+]}
+E1
+
+$foo = FOO;
+$bar = BAR;
+$foo{$bar} = BAZ;
+$ary[0] = ABC;
+
+print "$foo{$bar}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
+
+print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 22\n" : "not ok 22\n";
+print "${foo{$bar}}" eq "BAZ" ? "ok 23\n" : "not ok 23\n";
+
+print "FOO:" =~ /$foo[:]/ ? "ok 24\n" : "not ok 24\n";
+print "ABC" =~ /^$ary[$A]$/ ? "ok 25\n" : "not ok 25\n";
+print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 26\n" : "not ok 26\n";
+
+# MJD 19980425
+($X, @X) = qw(a b c d); 
+print "d" =~ /^$X[-1]$/ ? "ok 27\n" : "not ok 27\n";
+print "a1" !~ /^$X[-1]$/ ? "ok 28\n" : "not ok 28\n";
+
+print (((q{{\{\(}} . q{{\)\}}}) eq '{{\(}{\)}}') ? "ok 29\n" : "not ok 29\n");
+
+
+$foo = "not ok 30\n";
+$foo =~ s/^not /substr(<<EOF, 0, 0)/e;
+  Ignored
+EOF
+print $foo;
diff --git a/contrib/perl5/t/base/pat.t b/contrib/perl5/t/base/pat.t
new file mode 100755
index 0000000..c689f45
--- /dev/null
+++ b/contrib/perl5/t/base/pat.t
@@ -0,0 +1,11 @@
+#!./perl
+
+# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:05 $
+
+print "1..2\n";
+
+# first test to see if we can run the tests.
+
+$_ = 'test';
+if (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";}
+if (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";}
diff --git a/contrib/perl5/t/base/rs.t b/contrib/perl5/t/base/rs.t
new file mode 100755
index 0000000..52a9572
--- /dev/null
+++ b/contrib/perl5/t/base/rs.t
@@ -0,0 +1,131 @@
+#!./perl
+# Test $!
+
+print "1..14\n";
+
+$teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
+
+# Create our test datafile
+open TESTFILE, ">./foo" or die "error $! $^E opening";
+binmode TESTFILE;
+print TESTFILE $teststring;
+close TESTFILE;
+
+open TESTFILE, "<./foo";
+binmode TESTFILE;
+
+# Check the default $/
+$bar = <TESTFILE>;
+if ($bar eq "1\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+# explicitly set to \n
+$/ = "\n";
+$bar = <TESTFILE>;
+if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+# Try a non line terminator
+$/ = "3";
+$bar = <TESTFILE>;
+if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";}
+
+# Eat the line terminator
+$/ = "\n";
+$bar = <TESTFILE>;
+
+# How about a larger terminator
+$/ = "34";
+$bar = <TESTFILE>;
+if ($bar eq "1234") {print "ok 4\n";} else {print "not ok 4\n";}
+
+# Eat the line terminator
+$/ = "\n";
+$bar = <TESTFILE>;
+
+# Does paragraph mode work?
+$/ = '';
+$bar = <TESTFILE>;
+if ($bar eq "1234\n12345\n\n") {print "ok 5\n";} else {print "not ok 5\n";}
+
+# Try slurping the rest of the file
+$/ = undef;
+$bar = <TESTFILE>;
+if ($bar eq "123456\n1234567\n") {print "ok 6\n";} else {print "not ok 6\n";}
+
+# try the record reading tests. New file so we don't have to worry about
+# the size of \n.
+close TESTFILE;
+unlink "./foo";
+open TESTFILE, ">./foo";
+print TESTFILE "1234567890123456789012345678901234567890";
+binmode TESTFILE;
+close TESTFILE;
+open TESTFILE, "<./foo";
+binmode TESTFILE;
+
+# Test straight number
+$/ = \2;
+$bar = <TESTFILE>;
+if ($bar eq "12") {print "ok 7\n";} else {print "not ok 7\n";}
+
+# Test stringified number
+$/ = \"2";
+$bar = <TESTFILE>;
+if ($bar eq "34") {print "ok 8\n";} else {print "not ok 8\n";}
+
+# Integer variable
+$foo = 2;
+$/ = \$foo;
+$bar = <TESTFILE>;
+if ($bar eq "56") {print "ok 9\n";} else {print "not ok 9\n";}
+
+# String variable
+$foo = "2";
+$/ = \$foo;
+$bar = <TESTFILE>;
+if ($bar eq "78") {print "ok 10\n";} else {print "not ok 10\n";}
+
+# Get rid of the temp file
+close TESTFILE;
+unlink "./foo";
+
+# Now for the tricky bit--full record reading
+if ($^O eq 'VMS') {
+  # Create a temp file. We jump through these hoops 'cause CREATE really
+  # doesn't like our methods for some reason.
+  open FDLFILE, "> ./foo.fdl";
+  print FDLFILE "RECORD\n FORMAT VARIABLE\n";
+  close FDLFILE;
+  open CREATEFILE, "> ./foo.com";
+  print CREATEFILE '$ DEFINE/USER SYS$INPUT NL:', "\n";
+  print CREATEFILE '$ DEFINE/USER SYS$OUTPUT NL:', "\n";
+  print CREATEFILE '$ OPEN YOW []FOO.BAR/WRITE', "\n";
+  print CREATEFILE '$ CLOSE YOW', "\n";
+  print CREATEFILE "\$EXIT\n";
+  close CREATEFILE;
+  $throwaway = `\@\[\]foo`, "\n";
+  open(TEMPFILE, ">./foo.bar") or print "# open failed $! $^E\n";
+  print TEMPFILE "foo\nfoobar\nbaz\n";
+  close TEMPFILE;
+
+  open TESTFILE, "<./foo.bar";
+  $/ = \10;
+  $bar = <TESTFILE>;
+  if ($bar eq "foo\n") {print "ok 11\n";} else {print "not ok 11\n";}
+  $bar = <TESTFILE>;
+  if ($bar eq "foobar\n") {print "ok 12\n";} else {print "not ok 12\n";}
+  # can we do a short read?
+  $/ = \2;
+  $bar = <TESTFILE>;
+  if ($bar eq "ba") {print "ok 13\n";} else {print "not ok 13\n";}
+  # do we get the rest of the record?
+  $bar = <TESTFILE>;
+  if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";}
+
+  close TESTFILE;
+  unlink "./foo.bar";
+  unlink "./foo.com";  
+} else {
+  # Nobody else does this at the moment (well, maybe OS/390, but they can
+  # put their own tests in) so we just punt
+  foreach $test (11..14) {print "ok $test # skipped on non-VMS system\n"};
+}
diff --git a/contrib/perl5/t/base/term.t b/contrib/perl5/t/base/term.t
new file mode 100755
index 0000000..e96313d
--- /dev/null
+++ b/contrib/perl5/t/base/term.t
@@ -0,0 +1,55 @@
+#!./perl
+
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
+print "1..7\n";
+
+# check "" interpretation
+
+$x = "\n";
+# 10 is ASCII/Iso Latin, 21 is EBCDIC.
+if ($x eq chr(10) ||
+    ($Config{ebcdic} eq 'define' && $x eq chr(21))) {print "ok 1\n";}
+else {print "not ok 1\n";}
+
+# check `` processing
+
+$x = `echo hi there`;
+if ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+# check $#array
+
+$x[0] = 'foo';
+$x[1] = 'foo';
+$tmp = $#x;
+print "#3\t:$tmp: == :1:\n";
+if ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";}
+
+# check numeric literal
+
+$x = 1;
+if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$x = '1E2';
+if (($x | 1) == 101) {print "ok 5\n";} else {print "not ok 5\n";}
+
+# check <> pseudoliteral
+
+open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null.");
+if (<try> eq '') {
+    print "ok 6\n";
+}
+else {
+    print "not ok 6\n";
+    die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null';
+}
+
+open(try, "../Configure") || (die "Can't open ../Configure.");
+if (<try> ne '') {print "ok 7\n";} else {print "not ok 7\n";}
diff --git a/contrib/perl5/t/cmd/elsif.t b/contrib/perl5/t/cmd/elsif.t
new file mode 100755
index 0000000..7eace16
--- /dev/null
+++ b/contrib/perl5/t/cmd/elsif.t
@@ -0,0 +1,25 @@
+#!./perl
+
+# $RCSfile: elsif.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:08 $
+
+sub foo {
+    if ($_[0] == 1) {
+	1;
+    }
+    elsif ($_[0] == 2) {
+	2;
+    }
+    elsif ($_[0] == 3) {
+	3;
+    }
+    else {
+	4;
+    }
+}
+
+print "1..4\n";
+
+if (($x = &foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if (($x = &foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";}
+if (($x = &foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";}
+if (($x = &foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";}
diff --git a/contrib/perl5/t/cmd/for.t b/contrib/perl5/t/cmd/for.t
new file mode 100755
index 0000000..e45f050
--- /dev/null
+++ b/contrib/perl5/t/cmd/for.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $
+
+print "1..7\n";
+
+for ($i = 0; $i <= 10; $i++) {
+    $x[$i] = $i;
+}
+$y = $x[10];
+print "#1	:$y: eq :10:\n";
+$y = join(' ', @x);
+print "#1	:$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
+if (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+	print "ok 1\n";
+} else {
+	print "not ok 1\n";
+}
+
+$i = $c = 0;
+for (;;) {
+	$c++;
+	last if $i++ > 10;
+}
+if ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$foo = 3210;
+@ary = (1,2,3,4,5);
+foreach $foo (@ary) {
+	$foo *= 2;
+}
+if (join('',@ary) eq '246810') {print "ok 3\n";} else {print "not ok 3\n";}
+
+for (@ary) {
+    s/(.*)/ok $1\n/;
+}
+
+print $ary[1];
+
+# test for internal scratch array generation
+# this also tests that $foo was restored to 3210 after test 3
+for (split(' ','a b c d e')) {
+	$foo .= $_;
+}
+if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
+
+foreach $foo (("ok 6\n","ok 7\n")) {
+	print $foo;
+}
diff --git a/contrib/perl5/t/cmd/mod.t b/contrib/perl5/t/cmd/mod.t
new file mode 100755
index 0000000..e2ab777
--- /dev/null
+++ b/contrib/perl5/t/cmd/mod.t
@@ -0,0 +1,54 @@
+#!./perl
+
+# $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
+
+print "1..12\n";
+
+print "ok 1\n" if 1;
+print "not ok 1\n" unless 1;
+
+print "ok 2\n" unless 0;
+print "not ok 2\n" if 0;
+
+1 && (print "not ok 3\n") if 0;
+1 && (print "ok 3\n") if 1;
+0 || (print "not ok 4\n") if 0;
+0 || (print "ok 4\n") if 1;
+
+$x = 0;
+do {$x[$x] = $x;} while ($x++) < 10;
+if (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
+	print "ok 5\n";
+} else {
+	print "not ok 5 @x\n";
+}
+
+$x = 15;
+$x = 10 while $x < 10;
+if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
+
+$y[$_] = $_ * 2 foreach @x;
+if (join(' ',@y) eq '0 2 4 6 8 10 12 14 16 18 20') {
+	print "ok 7\n";
+} else {
+	print "not ok 7 @y\n";
+}
+
+open(foo,'./TEST') || open(foo,'TEST') || open(foo,'t/TEST');
+$x = 0;
+$x++ while <foo>;
+print $x > 50 && $x < 1000 ? "ok 8\n" : "not ok 8\n";
+
+$x = -0.5;
+print "not " if scalar($x) < 0 and $x >= 0;
+print "ok 9\n";
+
+print "not " unless (-(-$x) < 0) == ($x < 0);
+print "ok 10\n";
+
+print "ok 11\n" if $x < 0;
+print "not ok 11\n" unless $x < 0;
+
+print "ok 12\n" unless $x > 0;
+print "not ok 12\n" if $x > 0;
+
diff --git a/contrib/perl5/t/cmd/subval.t b/contrib/perl5/t/cmd/subval.t
new file mode 100755
index 0000000..3c60690
--- /dev/null
+++ b/contrib/perl5/t/cmd/subval.t
@@ -0,0 +1,186 @@
+#!./perl
+
+# $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $
+
+sub foo1 {
+    'true1';
+    if ($_[0]) { 'true2'; }
+}
+
+sub foo2 {
+    'true1';
+    if ($_[0]) { return 'true2'; } else { return 'true3'; }
+    'true0';
+}
+
+sub foo3 {
+    'true1';
+    unless ($_[0]) { 'true2'; }
+}
+
+sub foo4 {
+    'true1';
+    unless ($_[0]) { 'true2'; } else { 'true3'; }
+}
+
+sub foo5 {
+    'true1';
+    'true2' if $_[0];
+}
+
+sub foo6 {
+    'true1';
+    'true2' unless $_[0];
+}
+
+print "1..36\n";
+
+if (&foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if (&foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
+if (&foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
+if (&foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
+
+if (&foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
+if (&foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
+if (&foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
+if (&foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if (&foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
+if (&foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
+if (&foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
+if (&foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
+
+# Now test to see that recursion works using a Fibonacci number generator
+
+sub fib {
+    my($arg) = @_;
+    my($foo);
+    $level++;
+    if ($arg <= 2) {
+	$foo = 1;
+    }
+    else {
+	$foo = &fib($arg-1) + &fib($arg-2);
+    }
+    $level--;
+    $foo;
+}
+
+@good = (0,1,1,2,3,5,8,13,21,34,55,89);
+
+for ($i = 1; $i <= 10; $i++) {
+    $foo = $i + 12;
+    if (&fib($i) == $good[$i]) {
+	print "ok $foo\n";
+    }
+    else {
+	print "not ok $foo\n";
+    }
+}
+
+sub ary1 {
+    (1,2,3);
+}
+
+print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
+
+print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
+
+sub ary2 {
+    do {
+	return (1,2,3);
+	(3,2,1);
+    };
+    0;
+}
+
+print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
+
+$x = join(':',&ary2);
+print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
+
+sub somesub {
+    local($num,$P,$F,$L) = @_;
+    ($p,$f,$l) = caller;
+    print "$p:$f:$l" eq "$P:$F:$L" ? "ok $num\n" : "not ok $num $p:$f:$l ne $P:$F:$L\n";
+}
+
+&somesub(27, 'main', __FILE__, __LINE__);
+
+package foo;
+&main'somesub(28, 'foo', __FILE__, __LINE__);
+
+package main;
+$i = 28;
+open(FOO,">Cmd_subval.tmp");
+print FOO "blah blah\n";
+close FOO;
+
+&file_main(*F);
+close F;
+&info_main;
+
+&file_package(*F);
+close F;
+&info_package;
+
+unlink 'Cmd_subval.tmp';
+
+sub file_main {
+        local(*F) = @_;
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$i++;
+        eof F ? print "not ok $i\n" : print "ok $i\n";
+}
+
+sub info_main {
+        local(*F);
+
+        open(F, 'Cmd_subval.tmp') || die "test: can't open\n";
+	$i++;
+        eof F ? print "not ok $i\n" : print "ok $i\n";
+        &iseof(*F);
+	close F;
+}
+
+sub iseof {
+        local(*UNIQ) = @_;
+
+	$i++;
+        eof UNIQ ? print "(not ok $i)\n" : print "ok $i\n";
+}
+
+{package foo;
+
+ sub main'file_package {
+        local(*F) = @_;
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$main'i++;
+        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+
+ sub main'info_package {
+        local(*F);
+
+        open(F, 'Cmd_subval.tmp') || die "can't open\n";
+	$main'i++;
+        eof F ? print "not ok $main'i\n" : print "ok $main'i\n";
+        &iseof(*F);
+ }
+
+ sub iseof {
+        local(*UNIQ) = @_;
+
+	$main'i++;
+        eof UNIQ ? print "not ok $main'i\n" : print "ok $main'i\n";
+ }
+}
+
+sub autov { $_[0] = 23 };
+
+my $href = {};
+print keys %$href ? 'not ' : '', "ok 35\n";
+autov($href->{b});
+print join(':', %$href) eq 'b:23' ? '' : 'not ', "ok 36\n";
diff --git a/contrib/perl5/t/cmd/switch.t b/contrib/perl5/t/cmd/switch.t
new file mode 100755
index 0000000..faa5de4
--- /dev/null
+++ b/contrib/perl5/t/cmd/switch.t
@@ -0,0 +1,75 @@
+#!./perl
+
+# $RCSfile: switch.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:14 $
+
+print "1..18\n";
+
+sub foo1 {
+    $_ = shift(@_);
+    $a = 0;
+    until ($a++) {
+	next if $_ eq 1;
+	next if $_ eq 2;
+	next if $_ eq 3;
+	next if $_ eq 4;
+	return 20;
+    }
+    continue {
+	return $_;
+    }
+}
+
+print do foo1(0) == 20 ? "ok 1\n" : "not ok 1\n";
+print do foo1(1) == 1 ? "ok 2\n" : "not ok 2\n";
+print do foo1(2) == 2 ? "ok 3\n" : "not ok 3\n";
+print do foo1(3) == 3 ? "ok 4\n" : "not ok 4\n";
+print do foo1(4) == 4 ? "ok 5\n" : "not ok 5\n";
+print do foo1(5) == 20 ? "ok 6\n" : "not ok 6\n";
+
+sub foo2 {
+    $_ = shift(@_);
+    {
+	last if $_ == 1;
+	last if $_ == 2;
+	last if $_ == 3;
+	last if $_ == 4;
+    }
+    continue {
+	return 20;
+    }
+    return $_;
+}
+
+print do foo2(0) == 20 ? "ok 7\n" : "not ok 7\n";
+print do foo2(1) == 1 ? "ok 8\n" : "not ok 8\n";
+print do foo2(2) == 2 ? "ok 9\n" : "not ok 9\n";
+print do foo2(3) == 3 ? "ok 10\n" : "not ok 10\n";
+print do foo2(4) == 4 ? "ok 11\n" : "not ok 11\n";
+print do foo2(5) == 20 ? "ok 12\n" : "not ok 12\n";
+
+sub foo3 {
+    $_ = shift(@_);
+    if (/^1/) {
+	return 1;
+    }
+    elsif (/^2/) {
+	return 2;
+    }
+    elsif (/^3/) {
+	return 3;
+    }
+    elsif (/^4/) {
+	return 4;
+    }
+    else {
+	return 20;
+    }
+    return 40;
+}
+
+print do foo3(0) == 20 ? "ok 13\n" : "not ok 13\n";
+print do foo3(1) == 1 ? "ok 14\n" : "not ok 14\n";
+print do foo3(2) == 2 ? "ok 15\n" : "not ok 15\n";
+print do foo3(3) == 3 ? "ok 16\n" : "not ok 16\n";
+print do foo3(4) == 4 ? "ok 17\n" : "not ok 17\n";
+print do foo3(5) == 20 ? "ok 18\n" : "not ok 18\n";
diff --git a/contrib/perl5/t/cmd/while.t b/contrib/perl5/t/cmd/while.t
new file mode 100755
index 0000000..c6e464d
--- /dev/null
+++ b/contrib/perl5/t/cmd/while.t
@@ -0,0 +1,111 @@
+#!./perl
+
+# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
+
+print "1..10\n";
+
+open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
+print tmp "tvi925\n";
+print tmp "tvi920\n";
+print tmp "vt100\n";
+print tmp "Amiga\n";
+print tmp "paper\n";
+close tmp;
+
+# test "last" command
+
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    last if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
+
+# test "next" command
+
+$bad = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    next if /vt100/;
+    $bad = 1 if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
+
+# test "redo" command
+
+$bad = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+}
+if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
+
+# now do the same with a label and a continue block
+
+# test "last" command
+
+$badcont = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+line: while (<fh>) {
+    if (/vt100/) {last line;}
+} continue {
+    $badcont = 1 if /vt100/;
+}
+if (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
+if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
+
+# test "next" command
+
+$bad = '';
+$badcont = 1;
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+entry: while (<fh>) {
+    next entry if /vt100/;
+    $bad = 1 if /vt100/;
+} continue {
+    $badcont = '' if /vt100/;
+}
+if (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
+if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
+
+# test "redo" command
+
+$bad = '';
+$badcont = '';
+open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp.";
+loop: while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo loop;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+} continue {
+    $badcont = 1 if /vt100/;
+}
+if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
+if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
+
+close(fh) || die "Can't close Cmd_while.tmp.";
+unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`;
+
+#$x = 0;
+#while (1) {
+#    if ($x > 1) {last;}
+#    next;
+#} continue {
+#    if ($x++ > 10) {last;}
+#    next;
+#}
+#
+#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
+
+$i = 9;
+{
+    $i++;
+}
+print "ok $i\n";
diff --git a/contrib/perl5/t/comp/cmdopt.t b/contrib/perl5/t/comp/cmdopt.t
new file mode 100755
index 0000000..3f701a4
--- /dev/null
+++ b/contrib/perl5/t/comp/cmdopt.t
@@ -0,0 +1,90 @@
+#!./perl
+
+# $RCSfile: cmdopt.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:17 $
+
+print "1..44\n";
+
+# test the optimization of constants
+
+if (1) { print "ok 1\n";} else { print "not ok 1\n";}
+unless (0) { print "ok 2\n";} else { print "not ok 2\n";}
+
+if (0) { print "not ok 3\n";} else { print "ok 3\n";}
+unless (1) { print "not ok 4\n";} else { print "ok 4\n";}
+
+unless (!1) { print "ok 5\n";} else { print "not ok 5\n";}
+if (!0) { print "ok 6\n";} else { print "not ok 6\n";}
+
+unless (!0) { print "not ok 7\n";} else { print "ok 7\n";}
+if (!1) { print "not ok 8\n";} else { print "ok 8\n";}
+
+$x = 1;
+if (1 && $x) { print "ok 9\n";} else { print "not ok 9\n";}
+if (0 && $x) { print "not ok 10\n";} else { print "ok 10\n";}
+$x = '';
+if (1 && $x) { print "not ok 11\n";} else { print "ok 11\n";}
+if (0 && $x) { print "not ok 12\n";} else { print "ok 12\n";}
+
+$x = 1;
+if (1 || $x) { print "ok 13\n";} else { print "not ok 13\n";}
+if (0 || $x) { print "ok 14\n";} else { print "not ok 14\n";}
+$x = '';
+if (1 || $x) { print "ok 15\n";} else { print "not ok 15\n";}
+if (0 || $x) { print "not ok 16\n";} else { print "ok 16\n";}
+
+
+# test the optimization of variables
+
+$x = 1;
+if ($x) { print "ok 17\n";} else { print "not ok 17\n";}
+unless ($x) { print "not ok 18\n";} else { print "ok 18\n";}
+
+$x = '';
+if ($x) { print "not ok 19\n";} else { print "ok 19\n";}
+unless ($x) { print "ok 20\n";} else { print "not ok 20\n";}
+
+# test optimization of string operations
+
+$a = 'a';
+if ($a eq 'a') { print "ok 21\n";} else { print "not ok 21\n";}
+if ($a ne 'a') { print "not ok 22\n";} else { print "ok 22\n";}
+
+if ($a =~ /a/) { print "ok 23\n";} else { print "not ok 23\n";}
+if ($a !~ /a/) { print "not ok 24\n";} else { print "ok 24\n";}
+# test interaction of logicals and other operations
+
+$a = 'a';
+$x = 1;
+if ($a eq 'a' and $x) { print "ok 25\n";} else { print "not ok 25\n";}
+if ($a ne 'a' and $x) { print "not ok 26\n";} else { print "ok 26\n";}
+$x = '';
+if ($a eq 'a' and $x) { print "not ok 27\n";} else { print "ok 27\n";}
+if ($a ne 'a' and $x) { print "not ok 28\n";} else { print "ok 28\n";}
+
+$x = 1;
+if ($a eq 'a' or $x) { print "ok 29\n";} else { print "not ok 29\n";}
+if ($a ne 'a' or $x) { print "ok 30\n";} else { print "not ok 30\n";}
+$x = '';
+if ($a eq 'a' or $x) { print "ok 31\n";} else { print "not ok 31\n";}
+if ($a ne 'a' or $x) { print "not ok 32\n";} else { print "ok 32\n";}
+
+$x = 1;
+if ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
+if ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
+$x = '';
+if ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
+if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
+
+$x = 1;
+if ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
+if ($a !~ /a/ || $x) { print "ok 38\n";} else { print "not ok 38\n";}
+$x = '';
+if ($a =~ /a/ || $x) { print "ok 39\n";} else { print "not ok 39\n";}
+if ($a !~ /a/ || $x) { print "not ok 40\n";} else { print "ok 40\n";}
+
+$x = 1;
+if ($a eq 'a' xor $x) { print "not ok 41\n";} else { print "ok 41\n";}
+if ($a ne 'a' xor $x) { print "ok 42\n";} else { print "not ok 42\n";}
+$x = '';
+if ($a eq 'a' xor $x) { print "ok 43\n";} else { print "not ok 43\n";}
+if ($a ne 'a' xor $x) { print "not ok 44\n";} else { print "ok 44\n";}
diff --git a/contrib/perl5/t/comp/colon.t b/contrib/perl5/t/comp/colon.t
new file mode 100755
index 0000000..d2c64fe
--- /dev/null
+++ b/contrib/perl5/t/comp/colon.t
@@ -0,0 +1,138 @@
+#!./perl
+
+#
+# Ensure that syntax using colons (:) is parsed correctly.
+# The tests are done on the following tokens (by default):
+# ABC LABEL XYZZY m q qq qw qx s tr y AUTOLOAD and alarm 
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+$_ = '';	# to avoid undef warning on m// etc.
+
+sub ok {
+    my($test,$ok) = @_;
+    print "not " unless $ok;
+    print "ok $test\n";
+}
+
+$SIG{__WARN__} = sub { 1; }; # avoid some spurious warnings
+
+print "1..25\n";
+
+ok 1, (eval "package ABC; sub zyx {1}; 1;" and
+	eval "ABC::zyx" and
+	not eval "ABC:: eq ABC||" and
+	not eval "ABC::: >= 0");
+
+ok 2, (eval "package LABEL; sub zyx {1}; 1;" and
+	eval "LABEL::zyx" and
+	not eval "LABEL:: eq LABEL||" and
+	not eval "LABEL::: >= 0");
+
+ok 3, (eval "package XYZZY; sub zyx {1}; 1;" and
+	eval "XYZZY::zyx" and
+	not eval "XYZZY:: eq XYZZY||" and
+	not eval "XYZZY::: >= 0");
+
+ok 4, (eval "package m; sub zyx {1}; 1;" and
+	not eval "m::zyx" and
+	eval "m:: eq m||" and
+	not eval "m::: >= 0");
+
+ok 5, (eval "package q; sub zyx {1}; 1;" and
+	not eval "q::zyx" and
+	eval "q:: eq q||" and
+	not eval "q::: >= 0");
+
+ok 6, (eval "package qq; sub zyx {1}; 1;" and
+	not eval "qq::zyx" and
+	eval "qq:: eq qq||" and
+	not eval "qq::: >= 0");
+
+ok 7, (eval "package qw; sub zyx {1}; 1;" and
+	not eval "qw::zyx" and
+	eval "qw:: eq qw||" and
+	not eval "qw::: >= 0");
+
+ok 8, (eval "package qx; sub zyx {1}; 1;" and
+	not eval "qx::zyx" and
+	eval "qx:: eq qx||" and
+	not eval "qx::: >= 0");
+
+ok 9, (eval "package s; sub zyx {1}; 1;" and
+	not eval "s::zyx" and
+	not eval "s:: eq s||" and
+	eval "s::: >= 0");
+
+ok 10, (eval "package tr; sub zyx {1}; 1;" and
+	not eval "tr::zyx" and
+	not eval "tr:: eq tr||" and
+	eval "tr::: >= 0");
+
+ok 11, (eval "package y; sub zyx {1}; 1;" and
+	not eval "y::zyx" and
+	not eval "y:: eq y||" and
+	eval "y::: >= 0");
+
+ok 12, (eval "ABC:1" and
+	not eval "ABC:echo: eq ABC|echo|" and
+	not eval "ABC:echo:ohce: >= 0");
+
+ok 13, (eval "LABEL:1" and
+	not eval "LABEL:echo: eq LABEL|echo|" and
+	not eval "LABEL:echo:ohce: >= 0");
+
+ok 14, (eval "XYZZY:1" and
+	not eval "XYZZY:echo: eq XYZZY|echo|" and
+	not eval "XYZZY:echo:ohce: >= 0");
+
+ok 15, (not eval "m:1" and
+	eval "m:echo: eq m|echo|" and
+	not eval "m:echo:ohce: >= 0");
+
+ok 16, (not eval "q:1" and
+	eval "q:echo: eq q|echo|" and
+	not eval "q:echo:ohce: >= 0");
+
+ok 17, (not eval "qq:1" and
+	eval "qq:echo: eq qq|echo|" and
+	not eval "qq:echo:ohce: >= 0");
+
+ok 18, (not eval "qw:1" and
+	eval "qw:echo: eq qw|echo|" and
+	not eval "qw:echo:ohce: >= 0");
+
+ok 19, (not eval "qx:1" and
+	eval "qx:echo 1: eq qx|echo 1|" and	# echo without args may warn
+	not eval "qx:echo:ohce: >= 0");
+
+ok 20, (not eval "s:1" and
+	not eval "s:echo: eq s|echo|" and
+	eval "s:echo:ohce: >= 0");
+
+ok 21, (not eval "tr:1" and
+	not eval "tr:echo: eq tr|echo|" and
+	eval "tr:echo:ohce: >= 0");
+
+ok 22, (not eval "y:1" and
+	not eval "y:echo: eq y|echo|" and
+	eval "y:echo:ohce: >= 0");
+
+ok 23, (eval "AUTOLOAD:1" and
+	not eval "AUTOLOAD:echo: eq AUTOLOAD|echo|" and
+	not eval "AUTOLOAD:echo:ohce: >= 0");
+
+ok 24, (eval "and:1" and
+	not eval "and:echo: eq and|echo|" and
+	not eval "and:echo:ohce: >= 0");
+
+ok 25, (eval "alarm:1" and
+	not eval "alarm:echo: eq alarm|echo|" and
+	not eval "alarm:echo:ohce: >= 0");
diff --git a/contrib/perl5/t/comp/cpp.aux b/contrib/perl5/t/comp/cpp.aux
new file mode 100755
index 0000000..bb93d21
--- /dev/null
+++ b/contrib/perl5/t/comp/cpp.aux
@@ -0,0 +1,39 @@
+#!./perl -P
+
+# $RCSfile: cpp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:18 $
+
+print "1..3\n";
+
+#this is a comment
+#define MESS "ok 1\n"
+print MESS;
+
+#If you capitalize, it's a comment.
+#ifdef MESS
+	print "ok 2\n";
+#else
+	print "not ok 2\n";
+#endif
+
+open(TRY,">Comp.cpp.tmp") || die "Can't open temp perl file.";
+
+($prog = <<'END') =~ s/X//g;
+X$ok = "not ok 3\n";
+X#include "Comp.cpp.inc"
+X#ifdef OK
+X$ok = OK;
+X#endif
+Xprint $ok;
+END
+print TRY $prog;
+close TRY;
+
+open(TRY,">Comp.cpp.inc") || (die "Can't open temp include file.");
+print TRY '#define OK "ok 3\n"' . "\n";
+close TRY;
+
+$pwd=`pwd`;
+$pwd =~ s/\n//;
+$x = `./perl -P Comp.cpp.tmp`;
+print $x;
+unlink "Comp.cpp.tmp", "Comp.cpp.inc";
diff --git a/contrib/perl5/t/comp/cpp.t b/contrib/perl5/t/comp/cpp.t
new file mode 100755
index 0000000..86e7359
--- /dev/null
+++ b/contrib/perl5/t/comp/cpp.t
@@ -0,0 +1,18 @@
+#!./perl
+
+# $RCSfile: cpp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:18 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+if ( $^O eq 'MSWin32' or
+     ($Config{'cppstdin'} =~ /\bcppstdin\b/) and
+     ( ! -x $Config{'binexp'} . "/cppstdin") ) {
+    print "1..0\n";
+    exit; 		# Cannot test till after install, alas.
+}
+
+system "./perl -P comp/cpp.aux"
diff --git a/contrib/perl5/t/comp/decl.t b/contrib/perl5/t/comp/decl.t
new file mode 100755
index 0000000..32b8509
--- /dev/null
+++ b/contrib/perl5/t/comp/decl.t
@@ -0,0 +1,49 @@
+#!./perl
+
+# $RCSfile: decl.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:19 $
+
+# check to see if subroutine declarations work everwhere
+
+sub one {
+    print "ok 1\n";
+}
+format one =
+ok 5
+.
+
+print "1..7\n";
+
+do one();
+do two();
+
+sub two {
+    print "ok 2\n";
+}
+format two =
+@<<<
+$foo
+.
+
+if ($x eq $x) {
+    sub three {
+	print "ok 3\n";
+    }
+    do three();
+}
+
+do four();
+$~ = 'one';
+write;
+$~ = 'two';
+$foo = "ok 6";
+write;
+$~ = 'three';
+write;
+
+format three =
+ok 7
+.
+
+sub four {
+    print "ok 4\n";
+}
diff --git a/contrib/perl5/t/comp/multiline.t b/contrib/perl5/t/comp/multiline.t
new file mode 100755
index 0000000..ed418b8
--- /dev/null
+++ b/contrib/perl5/t/comp/multiline.t
@@ -0,0 +1,46 @@
+#!./perl
+
+# $RCSfile: multiline.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:20 $
+
+print "1..5\n";
+
+open(try,'>Comp.try') || (die "Can't open temp file.");
+
+$x = 'now is the time
+for all good men
+to come to.
+
+
+!
+
+';
+
+$y = 'now is the time' . "\n" .
+'for all good men' . "\n" .
+'to come to.' . "\n\n\n!\n\n";
+
+if ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
+
+print try $x;
+close try;
+
+open(try,'Comp.try') || (die "Can't reopen temp file.");
+$count = 0;
+$z = '';
+while (<try>) {
+    $z .= $_;
+    $count = $count + 1;
+}
+
+if ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if ($count == 7) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$_ = ($^O eq 'MSWin32') ? `type Comp.try` : `cat Comp.try`;
+
+if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+close(try) || (die "Can't close temp file.");
+unlink 'Comp.try' || `/bin/rm -f Comp.try`;
+
+if ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
diff --git a/contrib/perl5/t/comp/package.t b/contrib/perl5/t/comp/package.t
new file mode 100755
index 0000000..d7d19ae
--- /dev/null
+++ b/contrib/perl5/t/comp/package.t
@@ -0,0 +1,39 @@
+#!./perl
+
+print "1..7\n";
+
+$blurfl = 123;
+$foo = 3;
+
+package xyz;
+
+$bar = 4;
+
+{
+    package ABC;
+    $blurfl = 5;
+    $main'a = $'b;
+}
+
+$ABC'dyick = 6;
+
+$xyz = 2;
+
+$main = join(':', sort(keys %main::));
+$xyz = join(':', sort(keys %xyz::));
+$ABC = join(':', sort(keys %ABC::));
+
+if ('a' lt 'A') {
+    print $xyz eq 'bar:main:xyz:ABC' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+} else {
+    print $xyz eq 'ABC:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$xyz'\n";
+}    
+print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2 '$ABC'\n";
+print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+
+package ABC;
+
+print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
+eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
+eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
+print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
diff --git a/contrib/perl5/t/comp/proto.t b/contrib/perl5/t/comp/proto.t
new file mode 100755
index 0000000..6a59107
--- /dev/null
+++ b/contrib/perl5/t/comp/proto.t
@@ -0,0 +1,415 @@
+#!./perl
+#
+# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+#
+# So far there are tests for the following prototypes.
+# none, () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@)
+#
+# It is impossible to test every prototype that can be specified, but
+# we should test as many as we can.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+print "1..82\n";
+
+my $i = 1;
+
+sub testing (&$) {
+    my $p = prototype(shift);
+    my $c = shift;
+    my $what = defined $c ? '(' . $p . ')' : 'no prototype';   
+    print '#' x 25,"\n";
+    print '# Testing ',$what,"\n";
+    print '#' x 25,"\n";
+    print "not "
+	if((defined($p) && defined($c) && $p ne $c)
+	   || (defined($p) != defined($c)));
+    printf "ok %d\n",$i++;
+}
+
+@_ = qw(a b c d);
+my @array;
+my %hash;
+
+##
+##
+##
+
+testing \&no_proto, undef;
+
+sub no_proto {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 0 == no_proto();
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == no_proto(5);
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &no_proto;
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == no_proto +6;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == no_proto(@_);
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+
+testing \&no_args, '';
+
+sub no_args () {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 0 == no_args();
+printf "ok %d\n",$i++;
+
+print "not " unless 0 == no_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == no_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &no_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &no_args(1,2);
+printf "ok %d\n",$i++;
+
+eval "no_args(1)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&one_args, '$';
+
+sub one_args ($) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == one_args(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == one_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &one_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &one_args(1,2);
+printf "ok %d\n",$i++;
+
+eval "one_args(1,2)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+eval "one_args()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub one_a_args ($) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ == 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+one_a_args(@_);
+
+##
+##
+##
+
+testing \&over_one_args, '$@';
+
+sub over_one_args ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == over_one_args(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == over_one_args(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == over_one_args +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &over_one_args;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &over_one_args(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &over_one_args(1,@_);
+printf "ok %d\n",$i++;
+
+eval "over_one_args()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub over_one_a_args ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+over_one_a_args(@_);
+over_one_a_args(@_,1);
+over_one_a_args(@_,1,2);
+over_one_a_args(@_,@_);
+
+##
+##
+##
+
+testing \&scalar_and_hash, '$%';
+
+sub scalar_and_hash ($%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == scalar_and_hash(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 3 == scalar_and_hash(1,2,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == scalar_and_hash +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &scalar_and_hash;
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == &scalar_and_hash(1,2);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &scalar_and_hash(1,@_);
+printf "ok %d\n",$i++;
+
+eval "scalar_and_hash()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub scalar_and_hash_a ($@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+scalar_and_hash_a(@_);
+scalar_and_hash_a(@_,1);
+scalar_and_hash_a(@_,1,2);
+scalar_and_hash_a(@_,@_);
+
+##
+##
+##
+
+testing \&one_or_two, '$;$';
+
+sub one_or_two ($;$) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_)
+}
+
+print "not " unless 1 == one_or_two(1);
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == one_or_two(1,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 1 == one_or_two +5;
+printf "ok %d\n",$i++;
+
+print "not " unless 4 == &one_or_two;
+printf "ok %d\n",$i++;
+
+print "not " unless 3 == &one_or_two(1,2,3);
+printf "ok %d\n",$i++;
+
+print "not " unless 5 == &one_or_two(1,@_);
+printf "ok %d\n",$i++;
+
+eval "one_or_two()";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+eval "one_or_two(1,2,3)";
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+sub one_or_two_a ($;$) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ >= 1 && $_[0] == 4;
+    printf "ok %d\n",$i++;
+}
+
+one_or_two_a(@_);
+one_or_two_a(@_,1);
+one_or_two_a(@_,@_);
+
+##
+##
+##
+
+testing \&a_sub, '&';
+
+sub a_sub (&) {
+    print "# \@_ = (",join(",",@_),")\n";
+    &{$_[0]};
+}
+
+sub tmp_sub_1 { printf "ok %d\n",$i++ }
+
+a_sub { printf "ok %d\n",$i++ };
+a_sub \&tmp_sub_1;
+
+@array = ( \&tmp_sub_1 );
+eval 'a_sub @array';
+print "not " unless $@;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&sub_aref, '&\@';
+
+sub sub_aref (&\@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    my($sub,$array) = @_;
+    print "not " unless @_ == 2 && @{$array} == 4;
+    print map { &{$sub}($_) } @{$array}
+}
+
+@array = (qw(O K)," ", $i++);
+sub_aref { lc shift } @array;
+print "\n";
+
+##
+##
+##
+
+testing \&sub_array, '&@';
+
+sub sub_array (&@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ == 5;
+    my $sub = shift;
+    print map { &{$sub}($_) } @_
+}
+
+@array = (qw(O K)," ", $i++);
+sub_array { lc shift } @array;
+print "\n";
+
+##
+##
+##
+
+testing \&a_hash, '%';
+
+sub a_hash (%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    scalar(@_);
+}
+
+print "not " unless 1 == a_hash 'a';
+printf "ok %d\n",$i++;
+
+print "not " unless 2 == a_hash 'a','b';
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&a_hash_ref, '\%';
+
+sub a_hash_ref (\%) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless ref($_[0]) && $_[0]->{'a'};
+    printf "ok %d\n",$i++;
+    $_[0]->{'b'} = 2;
+}
+
+%hash = ( a => 1);
+a_hash_ref %hash;
+print "not " unless $hash{'b'} == 2;
+printf "ok %d\n",$i++;
+
+##
+##
+##
+
+testing \&array_ref_plus, '\@@';
+
+sub array_ref_plus (\@@) {
+    print "# \@_ = (",join(",",@_),")\n";
+    print "not " unless @_ == 2 && ref($_[0]) && 1 == @{$_[0]} && $_[1] eq 'x';
+    printf "ok %d\n",$i++;
+    @{$_[0]} = (qw(ok)," ",$i++,"\n");
+}
+
+@array = ('a');
+{ my @more = ('x');
+  array_ref_plus @array, @more; }
+print "not " unless @array == 4;
+print @array;
+
+my $p;
+print "not " if defined prototype('CORE::print');
+print "ok ", $i++, "\n";
+
+print "not " if defined prototype('CORE::system');
+print "ok ", $i++, "\n";
+
+print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$';
+print "ok ", $i++, "\n";
+
+print "# CORE:Foo => ($p), \$@ => `$@'\nnot " 
+    if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Cannot find an opnumber/;
+print "ok ", $i++, "\n";
+
+# correctly note too-short parameter lists that don't end with '$',
+#  a possible regression.
+
+sub foo1 ($\@);
+eval q{ foo1 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";
+
+sub foo2 ($\%);
+eval q{ foo2 "s" };
+print "not " unless $@ =~ /^Not enough/;
+print "ok ", $i++, "\n";
+
+sub X::foo3;
+*X::foo3 = sub {'ok'};
+print "# $@not " unless eval {X->foo3} eq 'ok';
+print "ok ", $i++, "\n";
+
+sub X::foo4 ($);
+*X::foo4 = sub ($) {'ok'};
+print "not " unless X->foo4 eq 'ok';
+print "ok ", $i++, "\n";
diff --git a/contrib/perl5/t/comp/redef.t b/contrib/perl5/t/comp/redef.t
new file mode 100755
index 0000000..07e978b
--- /dev/null
+++ b/contrib/perl5/t/comp/redef.t
@@ -0,0 +1,80 @@
+#!./perl -w
+#
+# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+
+BEGIN {
+    $warn = "";
+    $SIG{__WARN__} = sub { $warn .= join("",@_) }
+}
+
+sub ok ($$) { 
+    print $_[1] ? "ok " : "not ok ", $_[0], "\n";
+}
+
+print "1..18\n";
+
+my $NEWPROTO = 'Prototype mismatch:';
+
+sub sub0 { 1 }
+sub sub0 { 2 }
+
+ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;
+
+sub sub1    { 1 }
+sub sub1 () { 2 }
+
+ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1 vs ()\E[^\n]+\n//s;
+ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;
+
+sub sub2     { 1 }
+sub sub2 ($) { 2 }
+
+ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2 vs ($)\E[^\n]+\n//s;
+ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;
+
+sub sub3 () { 1 }
+sub sub3    { 2 }
+
+ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s;
+ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;
+
+sub sub4 () { 1 }
+sub sub4 () { 2 }
+
+ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;
+
+sub sub5 ()  { 1 }
+sub sub5 ($) { 2 }
+
+ok  9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s;
+ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;
+
+sub sub6 ($) { 1 }
+sub sub6     { 2 }
+
+ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s;
+ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;
+
+sub sub7 ($) { 1 }
+sub sub7 ()  { 2 }
+
+ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s;
+ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;
+
+sub sub8 ($) { 1 }
+sub sub8 ($) { 2 }
+
+ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;
+
+sub sub9 ($@) { 1 }
+sub sub9 ($)  { 2 }
+
+ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s;
+ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;
+
+ok 18, $_ eq '';
+
+# If we got any errors that we were not expecting, then print them
+print $_ if length $_;
+
+
diff --git a/contrib/perl5/t/comp/require.t b/contrib/perl5/t/comp/require.t
new file mode 100755
index 0000000..203b996
--- /dev/null
+++ b/contrib/perl5/t/comp/require.t
@@ -0,0 +1,50 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('.');
+}
+
+# don't make this lexical
+$i = 1;
+print "1..4\n";
+
+sub do_require {
+    %INC = ();
+    write_file('bleah.pm',@_);
+    eval { require "bleah.pm" };
+    my @a; # magic guard for scope violations (must be first lexical in file)
+}
+
+sub write_file {
+    my $f = shift;
+    open(REQ,">$f") or die "Can't write '$f': $!";
+    print REQ @_;
+    close REQ;
+}
+
+# interaction with pod (see the eof)
+write_file('bleah.pm', "print 'ok $i\n'; 1;\n");
+require "bleah.pm";
+$i++;
+
+# run-time failure in require
+do_require "0;\n";
+print "# $@\nnot " unless $@ =~ /did not return a true/;
+print "ok ",$i++,"\n";
+
+# compile-time failure in require
+do_require "1)\n";
+print "# $@\nnot " unless $@ =~ /syntax error/i;
+print "ok ",$i++,"\n";
+
+# successful require
+do_require "1";
+print "# $@\nnot " if $@;
+print "ok ",$i++,"\n";
+
+END { unlink 'bleah.pm'; }
+
+# ***interaction with pod (don't put any thing after here)***
+
+=pod
diff --git a/contrib/perl5/t/comp/script.t b/contrib/perl5/t/comp/script.t
new file mode 100755
index 0000000..d0c12e9
--- /dev/null
+++ b/contrib/perl5/t/comp/script.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# $RCSfile: script.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:23 $
+
+print "1..3\n";
+
+$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$x = `$PERL -le "print 'ok';"`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; }
+
+if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+open(try,">Comp.script") || (die "Can't open temp file.");
+print try 'print "ok\n";'; print try "\n";
+close try;
+
+$x = `$PERL Comp.script`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; }
+
+if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+$x = `$PERL <Comp.script`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; }
+
+if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
+
+unlink 'Comp.script' || `/bin/rm -f Comp.script`;
diff --git a/contrib/perl5/t/comp/term.t b/contrib/perl5/t/comp/term.t
new file mode 100755
index 0000000..eb99680
--- /dev/null
+++ b/contrib/perl5/t/comp/term.t
@@ -0,0 +1,70 @@
+#!./perl
+
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $
+
+# tests that aren't important enough for base.term
+
+print "1..22\n";
+
+$x = "\\n";
+print "#1\t:$x: eq " . ':\n:' . "\n";
+if ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$x = "#2\t:$x: eq :\\n:\n";
+print $x;
+unless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$one = 'a';
+
+if (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";}
+if (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";}
+if (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";}
+if (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";}
+if (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
+if (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
+if (length("\\${one}") == 2) {print "ok 10\n";} else {print "not ok 10\n";}
+
+if ("${one}b" eq "ab") { print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = (1,2,3);
+if ("$foo[1]b" eq "2b") { print "ok 12\n";} else {print "not ok 12\n";}
+if ("@foo[0..1]b" eq "1 2b") { print "ok 13\n";} else {print "not ok 13\n";}
+$" = '::';
+if ("@foo[0..1]b" eq "1::2b") { print "ok 14\n";} else {print "not ok 14\n";}
+
+# test if C<eval "{...}"> distinguishes between blocks and hashrefs
+
+$a = "{ '\\'' , 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 15\n";} else {print "not ok 15\n";}
+
+$a = "{ '\\\\\\'abc' => 'foo' }";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 16\n";} else {print "not ok 16\n";}
+
+$a = "{'a\\\n\\'b','foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 17\n";} else {print "not ok 17\n";}
+
+$a = "{'\\\\\\'\\\\'=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 18\n";} else {print "not ok 18\n";}
+
+$a = "{q,a'b,,'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 19\n";} else {print "not ok 19\n";}
+
+$a = "{q[[']]=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 20\n";} else {print "not ok 20\n";}
+
+# needs disambiguation if first term is a variable
+$a = "+{ \$a , 'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 21\n";} else {print "not ok 21\n";}
+
+$a = "+{ \$a=>'foo'}";
+$a = eval $a;
+if (ref($a) eq 'HASH') {print "ok 22\n";} else {print "not ok 22\n";}
diff --git a/contrib/perl5/t/comp/use.t b/contrib/perl5/t/comp/use.t
new file mode 100755
index 0000000..a6ce2a4
--- /dev/null
+++ b/contrib/perl5/t/comp/use.t
@@ -0,0 +1,101 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..14\n";
+
+my $i = 1;
+
+eval "use 5.000;";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf "use %.5f;", $];
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+eval sprintf "use %.5f;", $] - 0.000001;
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf("use %.5f;", $] + 1);
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval sprintf "use %.5f;", $] + 0.00001;
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+
+use lib; # I know that this module will be there.
+
+
+local $lib::VERSION = 1.0;
+
+eval "use lib 0.9";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "use lib 1.0";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "use lib 1.01";
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+
+eval "use lib 0.9 qw(fred)";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " unless $INC[0] eq "fred";
+print "ok ",$i++,"\n";
+
+eval "use lib 1.0 qw(joe)";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " unless $INC[0] eq "joe";
+print "ok ",$i++,"\n";
+
+eval "use lib 1.01 qw(freda)";
+unless ($@) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+print "not " if $INC[0] eq "freda";
+print "ok ",$i++,"\n";
diff --git a/contrib/perl5/t/harness b/contrib/perl5/t/harness
new file mode 100644
index 0000000..f6d94de
--- /dev/null
+++ b/contrib/perl5/t/harness
@@ -0,0 +1,33 @@
+#!./perl
+
+# We suppose that perl _mostly_ works at this moment, so may use
+# sophisticated testing.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $ENV{PERL5LIB} = '../lib';	# so children will see it too
+}
+use lib '../lib';
+
+use Test::Harness;
+
+$Test::Harness::switches = "";	# Too much noise otherwise
+$Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
+
+@tests = @ARGV;
+@tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t> unless @tests;
+
+Test::Harness::runtests @tests;
+
+%infinite = ('comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
+
+@tests = grep (!$infinite{$_}, @tests);
+
+if (-e "../testcompile") 
+{ 
+	print "The tests ", join(' ', keys(%infinite)), 
+							" generate infinite loops! Skipping!\n";
+
+	$ENV{'COMPILE_TEST'} = 1; Test::Harness::runtests @tests; 
+}
diff --git a/contrib/perl5/t/io/argv.t b/contrib/perl5/t/io/argv.t
new file mode 100755
index 0000000..d99865e
--- /dev/null
+++ b/contrib/perl5/t/io/argv.t
@@ -0,0 +1,48 @@
+#!./perl
+
+# $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $
+
+print "1..5\n";
+
+open(try, '>Io.argv.tmp') || (die "Can't open temp file.");
+print try "a line\n";
+close try;
+
+if ($^O eq 'MSWin32') {
+  $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`;
+}
+else {
+  $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`;
+}
+if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
+
+if ($^O eq 'MSWin32') {
+  $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io.argv.tmp -`;
+}
+else {
+  $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`;
+}
+if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+if ($^O eq 'MSWin32') {
+  $x = `.\\perl -le "print 'foo'" |.\\perl -e "while (<>) {print \$_;}"`;
+}
+else {
+  $x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
+}
+if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
+
+@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
+while (<>) {
+    $y .= $. . $_;
+    if (eof()) {
+	if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";}
+    }
+}
+
+if ($y eq "1a line\n2a line\n3a line\n")
+    {print "ok 5\n";}
+else
+    {print "not ok 5\n";}
+
+unlink 'Io.argv.tmp';
diff --git a/contrib/perl5/t/io/dup.t b/contrib/perl5/t/io/dup.t
new file mode 100755
index 0000000..f312671
--- /dev/null
+++ b/contrib/perl5/t/io/dup.t
@@ -0,0 +1,39 @@
+#!./perl
+
+# $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $
+
+print "1..6\n";
+
+print "ok 1\n";
+
+open(dupout,">&STDOUT");
+open(duperr,">&STDERR");
+
+open(STDOUT,">Io.dup") || die "Can't open stdout";
+open(STDERR,">&STDOUT") || die "Can't open stderr";
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print STDOUT "ok 2\n";
+print STDERR "ok 3\n";
+if ($^O eq 'MSWin32') {
+    print `echo ok 4`;
+    print `echo ok 5 1>&2`; # does this work?
+}
+else {
+    system 'echo ok 4';
+    system 'echo ok 5 1>&2';
+}
+
+close(STDOUT);
+close(STDERR);
+
+open(STDOUT,">&dupout");
+open(STDERR,">&duperr");
+
+if ($^O eq 'MSWin32') { print `type Io.dup` }
+else                  { system 'cat Io.dup' }
+unlink 'Io.dup';
+
+print STDOUT "ok 6\n";
diff --git a/contrib/perl5/t/io/fs.t b/contrib/perl5/t/io/fs.t
new file mode 100755
index 0000000..164a667
--- /dev/null
+++ b/contrib/perl5/t/io/fs.t
@@ -0,0 +1,159 @@
+#!./perl
+
+# $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
+$Is_Dosish = ($^O eq 'dos' or $^O eq 'os2');
+
+# avoid win32 (for now)
+do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32';
+
+print "1..26\n";
+
+$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
+chop($wd);
+
+if ($^O eq 'MSWin32') { `del tmp`; `mkdir tmp`; }
+else {  `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; }
+chdir './tmp';
+`/bin/rm -rf a b c x` if -x '/bin/rm';
+
+umask(022);
+
+if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
+open(fh,'>x') || die "Can't create x";
+close(fh);
+open(fh,'>a') || die "Can't create a";
+close(fh);
+
+if ($Is_Dosish) {print "ok 2 # skipped: no link\n";} 
+elsif (eval {link('a','b')}) {print "ok 2\n";} 
+else {print "not ok 2\n";}
+
+if ($Is_Dosish) {print "ok 3 # skipped: no link\n";} 
+elsif (eval {link('b','c')}) {print "ok 3\n";} 
+else {print "not ok 3\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+
+if ($Config{dont_use_nlink} || $Is_Dosish)
+    {print "ok 4 # skipped: no link\n";} 
+elsif ($nlink == 3)
+    {print "ok 4\n";} 
+else {print "not ok 4\n";}
+
+if ($^O eq 'amigaos' || $Is_Dosish)
+    {print "ok 5 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0666)
+    {print "ok 5\n";} 
+else {print "not ok 5\n";}
+
+if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0777) {print "ok 7\n";} 
+else {print "not ok 7\n";}
+
+if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} 
+elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} 
+else {print "not ok 8\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('c');
+if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0700) {print "ok 9\n";} 
+else {print "not ok 9\n";}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} 
+elsif (($mode & 0777) == 0700) {print "ok 10\n";} 
+else {print "not ok 10\n";}
+
+if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } 
+elsif ((unlink 'b','x') == 2) {print "ok 11\n";} 
+else {print "not ok 11\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('x');
+if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
+
+if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('a');
+if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
+$delta = $Is_Dosish ? 2 : 1;	# Granularity of time on the filesystem
+$foo = (utime 500000000,500000000 + $delta,'b');
+if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
+if ($wd =~ m#/afs/# || $^O eq 'amigaos')
+    {print "ok 18 # skipped: granularity of the filetime\n";}
+elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
+    {print "ok 18\n";}
+else
+    {print "not ok 18 $atime $mtime\n";}
+
+if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('b');
+if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
+unlink 'c';
+
+chdir $wd || die "Can't cd back to $wd";
+rmdir 'tmp';
+
+unlink 'c';
+if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) {
+    # we have symbolic links
+    if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
+    $foo = `grep perl c`;
+    if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
+    unlink 'c';
+}
+else {
+    print "ok 21\nok 22\n";
+}
+
+# truncate (may not be implemented everywhere)
+unlink "Iofs.tmp";
+`echo helloworld > Iofs.tmp`;
+eval { truncate "Iofs.tmp", 5; };
+if ($@ =~ /not implemented/) {
+  print "# truncate not implemented -- skipping tests 23 through 26\n";
+  for (23 .. 26) {
+    print "ok $_\n";
+  }
+}
+else {
+  if (-s "Iofs.tmp" == 5) {print "ok 23\n"} else {print "not ok 23\n"}
+  truncate "Iofs.tmp", 0;
+  if (-z "Iofs.tmp") {print "ok 24\n"} else {print "not ok 24\n"}
+  open(FH, ">Iofs.tmp") or die "Can't create Iofs.tmp";
+  { select FH; $| = 1; select STDOUT }
+  print FH "helloworld\n";
+  truncate FH, 5;
+  if ($^O eq 'dos') {
+      close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+  }
+  if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"}
+  truncate FH, 0;
+  if ($^O eq 'dos') {
+      close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp";
+  }
+  if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
+  close FH;
+}
+unlink "Iofs.tmp";
diff --git a/contrib/perl5/t/io/inplace.t b/contrib/perl5/t/io/inplace.t
new file mode 100755
index 0000000..ff410a7
--- /dev/null
+++ b/contrib/perl5/t/io/inplace.t
@@ -0,0 +1,36 @@
+#!./perl
+
+$^I = $^O eq 'VMS' ? '_bak' : '.bak';
+
+# $RCSfile: inplace.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:29 $
+
+print "1..2\n";
+
+@ARGV = ('.a','.b','.c');
+if ($^O eq 'MSWin32') {
+  $CAT = '.\perl -e "print<>"';
+  `.\\perl -le "print 'foo'" > .a`;
+  `.\\perl -le "print 'foo'" > .b`;
+  `.\\perl -le "print 'foo'" > .c`;
+}
+elsif ($^O eq 'VMS') {
+  $CAT = 'MCR []perl. -e "print<>"';
+  `MCR []perl. -le "print 'foo'" > ./.a`;
+  `MCR []perl. -le "print 'foo'" > ./.b`;
+  `MCR []perl. -le "print 'foo'" > ./.c`;
+}
+else {
+  $CAT = 'cat';
+  `echo foo | tee .a .b .c`;
+}
+while (<>) {
+    s/foo/bar/;
+}
+continue {
+    print;
+}
+
+if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
+if (`$CAT .a$^I .b$^I .c$^I` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+unlink '.a', '.b', '.c', ".a$^I", ".b$^I", ".c$^I";
diff --git a/contrib/perl5/t/io/iprefix.t b/contrib/perl5/t/io/iprefix.t
new file mode 100755
index 0000000..10a5c5f
--- /dev/null
+++ b/contrib/perl5/t/io/iprefix.t
@@ -0,0 +1,36 @@
+#!./perl
+
+$^I = 'bak*';
+
+# Modified from the original inplace.t to test adding prefixes
+
+print "1..2\n";
+
+@ARGV = ('.a','.b','.c');
+if ($^O eq 'MSWin32') {
+  $CAT = '.\perl -e "print<>"';
+  `.\\perl -le "print 'foo'" > .a`;
+  `.\\perl -le "print 'foo'" > .b`;
+  `.\\perl -le "print 'foo'" > .c`;
+}
+elsif ($^O eq 'VMS') {
+  $CAT = 'MCR []perl. -e "print<>"';
+  `MCR []perl. -le "print 'foo'" > ./.a`;
+  `MCR []perl. -le "print 'foo'" > ./.b`;
+  `MCR []perl. -le "print 'foo'" > ./.c`;
+}
+else {
+  $CAT = 'cat';
+  `echo foo | tee .a .b .c`;
+}
+while (<>) {
+    s/foo/bar/;
+}
+continue {
+    print;
+}
+
+if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
+if (`$CAT bak.a bak.b bak.c` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
+
+unlink '.a', '.b', '.c', 'bak.a', 'bak.b', 'bak.c';
diff --git a/contrib/perl5/t/io/pipe.t b/contrib/perl5/t/io/pipe.t
new file mode 100755
index 0000000..ba7a9b0
--- /dev/null
+++ b/contrib/perl5/t/io/pipe.t
@@ -0,0 +1,135 @@
+#!./perl
+
+# $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'d_fork'}) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+$| = 1;
+print "1..12\n";
+
+open(PIPE, "|-") || (exec 'tr', 'YX', 'ko');
+print PIPE "Xk 1\n";
+print PIPE "oY 2\n";
+close PIPE;
+
+if (open(PIPE, "-|")) {
+    while(<PIPE>) {
+	s/^not //;
+	print;
+    }
+    close PIPE;        # avoid zombies which disrupt test 12
+}
+else {
+    print STDOUT "not ok 3\n";
+    exec 'echo', 'not ok 4';
+}
+
+pipe(READER,WRITER) || die "Can't open pipe";
+
+if ($pid = fork) {
+    close WRITER;
+    while(<READER>) {
+	s/^not //;
+	y/A-Z/a-z/;
+	print;
+    }
+    close READER;     # avoid zombies which disrupt test 12
+}
+else {
+    die "Couldn't fork" unless defined $pid;
+    close READER;
+    print WRITER "not ok 5\n";
+    open(STDOUT,">&WRITER") || die "Can't dup WRITER to STDOUT";
+    close WRITER;
+    exec 'echo', 'not ok 6';
+}
+
+
+pipe(READER,WRITER) || die "Can't open pipe";
+close READER;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+    $SIG{'PIPE'} = 'IGNORE';       # loop preventer
+    print "ok 7\n";
+}
+
+print WRITER "not ok 7\n";
+close WRITER;
+sleep 1;
+print "ok 8\n";
+
+# VMS doesn't like spawning subprocesses that are still connected to
+# STDOUT.  Someone should modify tests #9 to #12 to work with VMS.
+
+if ($^O eq 'VMS') {
+    print "ok 9\n";
+    print "ok 10\n";
+    print "ok 11\n";
+    print "ok 12\n";
+    exit;
+}
+
+if ($Config{d_sfio} || $^O eq machten || $^O eq beos) {
+    # Sfio doesn't report failure when closing a broken pipe
+    # that has pending output.  Go figure.  MachTen doesn't either,
+    # but won't write to broken pipes, so nothing's pending at close.
+    # BeOS will not write to broken pipes, either.
+    print "ok 9\n";
+}
+else {
+    local $SIG{PIPE} = 'IGNORE';
+    open NIL, '|true'	or die "open failed: $!";
+    sleep 2;
+    print NIL 'foo'	or die "print failed: $!";
+    if (close NIL) {
+	print "not ok 9\n";
+    }
+    else {
+	print "ok 9\n";
+    }
+}
+
+# check that errno gets forced to 0 if the piped program exited non-zero
+open NIL, '|exit 23;' or die "fork failed: $!";
+$! = 1;
+if (close NIL) {
+    print "not ok 10\n# successful close\n";
+}
+elsif ($! != 0) {
+    print "not ok 10\n# errno $!\n";
+}
+elsif ($? == 0) {
+    print "not ok 10\n# status 0\n";
+}
+else {
+    print "ok 10\n";
+}
+
+# check that status for the correct process is collected
+wait;				# Collect from $pid
+my $zombie = fork or exit 37;
+my $pipe = open *FH, "sleep 2;exit 13|" or die "Open: $!\n";
+$SIG{ALRM} = sub { return };
+alarm(1);
+my $close = close FH;
+if ($? == 13*256 && ! length $close && ! $!) {
+    print "ok 11\n";
+} else {
+    print "not ok 11\n# close $close\$?=$?   \$!=", $!+0, ":$!\n";
+};
+my $wait = wait;
+if ($? == 37*256 && $wait == $zombie && ! $!) {
+    print "ok 12\n";
+} else {
+    print "not ok 12\n# pid=$wait first=$pid pipe=$pipe zombie=$zombie me=$$ \$?=$?   \$!=", $!+0, ":$!\n";
+}
diff --git a/contrib/perl5/t/io/print.t b/contrib/perl5/t/io/print.t
new file mode 100755
index 0000000..180b1e8
--- /dev/null
+++ b/contrib/perl5/t/io/print.t
@@ -0,0 +1,32 @@
+#!./perl
+
+# $RCSfile: print.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:32 $
+
+print "1..16\n";
+
+$foo = 'STDOUT';
+print $foo "ok 1\n";
+
+print "ok 2\n","ok 3\n","ok 4\n";
+print STDOUT "ok 5\n";
+
+open(foo,">-");
+print foo "ok 6\n";
+
+printf "ok %d\n",7;
+printf("ok %d\n",8);
+
+@a = ("ok %d%c",9,ord("\n"));
+printf @a;
+
+$a[1] = 10;
+printf STDOUT @a;
+
+$, = ' ';
+$\ = "\n";
+
+print "ok","11";
+
+@x = ("ok","12\nok","13\nok");
+@y = ("15\nok","16");
+print @x,"14\nok",@y;
diff --git a/contrib/perl5/t/io/read.t b/contrib/perl5/t/io/read.t
new file mode 100755
index 0000000..b27fde1
--- /dev/null
+++ b/contrib/perl5/t/io/read.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $RCSfile$
+
+print "1..1\n";
+
+open(A,"+>a");
+print A "_";
+seek(A,0,0);
+
+$b = "abcd"; 
+$b = "";
+
+read(A,$b,1,4);
+
+close(A);
+
+unlink("a");
+
+if ($b eq "\000\000\000\000_") {
+	print "ok 1\n";
+} else { # Probably "\000bcd_"
+	print "not ok 1\n";
+}
+
+unlink 'a';
diff --git a/contrib/perl5/t/io/tell.t b/contrib/perl5/t/io/tell.t
new file mode 100755
index 0000000..83904e8
--- /dev/null
+++ b/contrib/perl5/t/io/tell.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $RCSfile: tell.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:33 $
+
+print "1..13\n";
+
+$TST = 'tst';
+
+open($TST, '../Configure') || (die "Can't open ../Configure");
+binmode $TST if $^O eq 'MSWin32';
+if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; }
+
+$firstline = <$TST>;
+$secondpos = tell;
+
+$x = 0;
+while (<tst>) {
+    if (eof) {$x++;}
+}
+if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+$lastpos = tell;
+
+unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
+
+if (seek($TST,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
+
+if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
+
+if ($firstline eq <tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
+
+if (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+if (eof($TST)) { print "not ok 9\n"; } else { print "ok 9\n"; }
+
+if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
+
+if (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
+
+if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
+
+unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
diff --git a/contrib/perl5/t/lib/abbrev.t b/contrib/perl5/t/lib/abbrev.t
new file mode 100755
index 0000000..fb5a984
--- /dev/null
+++ b/contrib/perl5/t/lib/abbrev.t
@@ -0,0 +1,51 @@
+#!./perl
+
+print "1..7\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::Abbrev;
+
+print "ok 1\n";
+
+# old style as reference
+local(%x);
+my @z = qw(list edit send abort gripe listen);
+abbrev(*x, @z);
+my $r = join ':', sort keys %x; 
+print "not " if exists $x{'l'}   ||
+                exists $x{'li'}  ||
+                exists $x{'lis'};
+print "ok 2\n";
+
+print "not " unless $x{'list'}   eq 'list' &&
+                    $x{'liste'}  eq 'listen' &&
+                    $x{'listen'} eq 'listen';
+print "ok 3\n";
+
+print "not " unless $x{'a'}     eq 'abort' &&
+                    $x{'ab'}    eq 'abort' &&
+                    $x{'abo'}   eq 'abort' &&
+                    $x{'abor'}  eq 'abort' &&
+                    $x{'abort'} eq 'abort';
+print "ok 4\n";
+
+my $test = 5;
+
+# wantarray
+my %y = abbrev @z;
+my $s = join ':', sort keys %y;
+print (($r eq $s)?"ok $test\n":"not ok $test\n"); $test++;
+
+my $y = abbrev @z;
+$s = join ':', sort keys %$y;
+print (($r eq $s)?"ok $test\n":"not ok $test\n"); $test++;
+
+%y = ();
+abbrev \%y, @z;
+
+$s = join ':', sort keys %y;
+print (($r eq $s)?"ok $test\n":"not ok $test\n"); $test++;
diff --git a/contrib/perl5/t/lib/anydbm.t b/contrib/perl5/t/lib/anydbm.t
new file mode 100755
index 0000000..0391b7b
--- /dev/null
+++ b/contrib/perl5/t/lib/anydbm.t
@@ -0,0 +1,125 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+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*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+    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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "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/contrib/perl5/t/lib/autoloader.t b/contrib/perl5/t/lib/autoloader.t
new file mode 100755
index 0000000..b1622a8
--- /dev/null
+++ b/contrib/perl5/t/lib/autoloader.t
@@ -0,0 +1,100 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    $dir = "auto-$$";
+    @INC = ("./$dir", "../lib");
+}
+
+print "1..9\n";
+
+# First we must set up some autoloader files
+mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+mkdir "$dir/auto", 0755     or die "Can't mkdir: $!";
+mkdir "$dir/auto/Foo", 0755 or die "Can't mkdir: $!";
+
+open(FOO, ">$dir/auto/Foo/foo.al") or die;
+print FOO <<'EOT';
+package Foo;
+sub foo { shift; shift || "foo" }
+1;
+EOT
+close(FOO);
+
+open(BAR, ">$dir/auto/Foo/bar.al") or die;
+print BAR <<'EOT';
+package Foo;
+sub bar { shift; shift || "bar" }
+1;
+EOT
+close(BAR);
+
+open(BAZ, ">$dir/auto/Foo/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";
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir/auto/Foo/foo.al";
+unlink "$dir/auto/Foo/bar.al";
+unlink "$dir/auto/Foo/bazmarkhian.al";
+rmdir "$dir/auto/Foo";
+rmdir "$dir/auto";
+rmdir "$dir";
+}
diff --git a/contrib/perl5/t/lib/basename.t b/contrib/perl5/t/lib/basename.t
new file mode 100755
index 0000000..a02aa32
--- /dev/null
+++ b/contrib/perl5/t/lib/basename.t
@@ -0,0 +1,139 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Basename qw(fileparse basename dirname);
+
+print "1..36\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:') eq 'arma:' ? '' : 'not '),"ok 27\n";
+print +(dirname(':') eq ':' ? '' : 'not '),"ok 28\n";
+
+
+# Check quoting of metacharacters in suffix arg by basename()
+print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
+        '' : 'not '),"ok 29\n";
+print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
+        '' : 'not '),"ok 30\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 31\n";
+# perl5.003_18 gives C:\perl\
+print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 32\n";
+
+File::Basename::fileparse_set_fstype 'UNIX';
+# perl5.003_18 gives '.'
+print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 33\n";
+# perl5.003_18 gives '/perl/lib'
+print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 34\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 35\n";
+print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
+		? '' : 'not '), "ok 36\n";
diff --git a/contrib/perl5/t/lib/bigint.t b/contrib/perl5/t/lib/bigint.t
new file mode 100755
index 0000000..034c5c6
--- /dev/null
+++ b/contrib/perl5/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/contrib/perl5/t/lib/bigintpm.t b/contrib/perl5/t/lib/bigintpm.t
new file mode 100755
index 0000000..e7cac26
--- /dev/null
+++ b/contrib/perl5/t/lib/bigintpm.t
@@ -0,0 +1,313 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::BigInt;
+
+$test = 0;
+$| = 1;
+print "1..247\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
++100:+5:+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/contrib/perl5/t/lib/cgi-form.t b/contrib/perl5/t/lib/cgi-form.t
new file mode 100755
index 0000000..86df161
--- /dev/null
+++ b/contrib/perl5/t/lib/cgi-form.t
@@ -0,0 +1,81 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+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");
+}
+
+# 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\n),
+     "checkbox()");
+test(10,checkbox(-name=>'weather',-value=>'nice',-label=>'forecast') eq 
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="nice">forecast\n),
+     "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\n),
+     "checkbox()");
+test(12,checkbox(-name=>'weather',-value=>'dull',-label=>'forecast') eq 
+     qq(<INPUT TYPE="checkbox" NAME="weather" VALUE="dull" CHECKED>forecast\n),
+     "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  VALUE="chess">chess
+<OPTION SELECTED VALUE="cribbage">cribbage
+</SELECT>
+END
+
diff --git a/contrib/perl5/t/lib/cgi-function.t b/contrib/perl5/t/lib/cgi-function.t
new file mode 100755
index 0000000..ad8b968
--- /dev/null
+++ b/contrib/perl5/t/lib/cgi-function.t
@@ -0,0 +1,85 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..24\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");
+}
+
+# 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');
+
+if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
+    for (23,24) { print "ok $_ # Skipped: fork n/a\n" }
+}
+else {
+    CGI::_reset_globals;
+    $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()");
+}
diff --git a/contrib/perl5/t/lib/cgi-html.t b/contrib/perl5/t/lib/cgi-html.t
new file mode 100755
index 0000000..16aa824
--- /dev/null
+++ b/contrib/perl5/t/lib/cgi-html.t
@@ -0,0 +1,66 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..17\n"; }
+BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";
+       $eol = "\r\n" if $^O eq 'os390'; }
+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");
+}
+
+# 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${eol}${eol}","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${eol}${eol}","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${eol}Content-Type: image/gif${eol}${eol}","header()");
+test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${eol}Content-Type: text/html${eol}${eol}","header()");
+test(13,start_html() ."\n" eq <<END,"start_html()");
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<HTML><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><HEAD><TITLE>Untitled Document</TITLE>
+</HEAD><BODY>
+END
+    ;
+test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
+<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<HTML><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()");
+test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${eol}Date:.*${eol}Content-Type: text/html${eol}${eol}!s,
+     "header(-cookie)");
diff --git a/contrib/perl5/t/lib/cgi-request.t b/contrib/perl5/t/lib/cgi-request.t
new file mode 100755
index 0000000..8c70c40
--- /dev/null
+++ b/contrib/perl5/t/lib/cgi-request.t
@@ -0,0 +1,93 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..31\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI ();
+$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{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");
+
+if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
+    for (29..31) { print "ok $_ # Skipped: fork n/a\n" }
+}
+else {
+    $q->_reset_globals;
+    $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(29,$q=new CGI,"CGI::new() from POST");
+    test(30,$q->param('weather') eq 'nice',"CGI::param() from POST");
+    test(31,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+}
diff --git a/contrib/perl5/t/lib/checktree.t b/contrib/perl5/t/lib/checktree.t
new file mode 100755
index 0000000..b5426ca
--- /dev/null
+++ b/contrib/perl5/t/lib/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
+    lib/checktree.t  -f || die
+};
+
+print "ok 1\n";
diff --git a/contrib/perl5/t/lib/complex.t b/contrib/perl5/t/lib/complex.t
new file mode 100755
index 0000000..2bb14f0
--- /dev/null
+++ b/contrib/perl5/t/lib/complex.t
@@ -0,0 +1,879 @@
+#!./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;
+
+$VERSION = sprintf("%s", q$Id: complex.t,v 1.8 1998/02/05 16:03:39 jhi Exp $ =~ /(\d+\.d+)/);
+
+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-11;	# 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 '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 '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 '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';
+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';
+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)',
+	 'atan($i)',
+#	 'atanh(-1)',	# Log of zero.
+	 'atanh(+1)',
+	 'cot(0)',
+	 'coth(0)',
+	 'csc(0)',
+	 'tan($pip2)',
+	 'csch(0)',
+	 'tan($pip2)',
+	);
+
+test_loz(
+	 'log($zero)',
+	 'acot(-$i)',
+	 'atanh(-1)',
+	 'acoth(-1)',
+	);
+
+# test the 0**0
+
+sub test_ztz {
+    $test++;
+
+    push(@script, <<'EOT');
+eval 'cplx(0)**cplx(0)';
+print 'not ' unless ($@ =~ /zero raised to the zeroth/);
+EOT
+    push(@script, qq(print "ok $test\\n";\n));
+}
+
+test_ztz;
+
+# test the bad roots
+
+sub test_broot {
+    for my $op (@_) {
+	$test++;
+
+	push(@script, <<EOT);
+eval 'root(2, $op)';
+print 'not ' unless (\$@ =~ /root must be/);
+EOT
+        push(@script, qq(print "ok $test\\n";\n));
+    }
+}
+
+test_broot(qw(-3 -2.1 0 0.99));
+
+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)
+
+&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/contrib/perl5/t/lib/db-btree.t b/contrib/perl5/t/lib/db-btree.t
new file mode 100755
index 0000000..bf739c8
--- /dev/null
+++ b/contrib/perl5/t/lib/db-btree.t
@@ -0,0 +1,612 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib' if -d '../lib' ;
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..102\n";
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+ 
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+sub lexical
+{
+    my(@a) = unpack ("C*", $a) ;
+    my(@b) = unpack ("C*", $b) ;
+
+    my $len = (@a > @b ? @b : @a) ;
+    my $i = 0 ;
+
+    foreach $i ( 0 .. $len -1) {
+        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
+    }
+
+    return @a - @b ;
+}
+
+$Dfile = "dbbtree.tmp";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to BTREEINFO
+
+my $dbh = new DB_File::BTREEINFO ;
+ok(1, ! defined $dbh->{flags}) ;
+ok(2, ! defined $dbh->{cachesize}) ;
+ok(3, ! defined $dbh->{psize}) ;
+ok(4, ! defined $dbh->{lorder}) ;
+ok(5, ! defined $dbh->{minkeypage}) ;
+ok(6, ! defined $dbh->{maxkeypage}) ;
+ok(7, ! defined $dbh->{compare}) ;
+ok(8, ! defined $dbh->{prefix}) ;
+
+$dbh->{flags} = 3000 ;
+ok(9, $dbh->{flags} == 3000) ;
+
+$dbh->{cachesize} = 9000 ;
+ok(10, $dbh->{cachesize} == 9000);
+
+$dbh->{psize} = 400 ;
+ok(11, $dbh->{psize} == 400) ;
+
+$dbh->{lorder} = 65 ;
+ok(12, $dbh->{lorder} == 65) ;
+
+$dbh->{minkeypage} = 123 ;
+ok(13, $dbh->{minkeypage} == 123) ;
+
+$dbh->{maxkeypage} = 1234 ;
+ok(14, $dbh->{maxkeypage} == 1234 );
+
+$dbh->{compare} = 1234 ;
+ok(15, $dbh->{compare} == 1234) ;
+
+$dbh->{prefix} = 1234 ;
+ok(16, $dbh->{prefix} == 1234 );
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(17, $@ =~ /^DB_File::BTREEINFO::STORE - Unknown element 'fred' at/ ) ;
+eval '$q = $dbh->{fred}' ;
+ok(18, $@ =~ /^DB_File::BTREEINFO::FETCH - Unknown element 'fred' at/ ) ;
+
+# Now check the interface to BTREE
+
+ok(19, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(20, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(21, !$i ) ;
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+ok(22, $h{'abc'} eq 'ABC' );
+ok(23, ! defined $h{'jimmy'} ) ;
+ok(24, ! exists $h{'jimmy'} ) ;
+ok(25,  defined $h{'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';
+$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
+ok(26, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE)) ;
+
+# 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);
+
+ok(27, $#keys == 29 && $#values == 29) ;
+
+$i = 0 ;
+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;
+    }
+}
+
+ok(28, $i == 30) ;
+
+@keys = ('blurfl', keys(%h), 'dyick');
+ok(29, $#keys == 31) ;
+
+#Check that the keys can be retrieved in order
+my @b = keys %h ;
+my @c = sort lexical @b ;
+ok(30, ArrayCompare(\@b, \@c)) ;
+
+$h{'foo'} = '';
+ok(31, $h{'foo'} eq '' ) ;
+
+#$h{''} = 'bar';
+#ok(32, $h{''} eq 'bar' );
+ok(32,1) ;
+
+# 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; }
+ok(33, $ok);
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(34, $size > 0 );
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+ok(35, join(':',200..400) eq join(':',@foo) );
+
+# 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) ;
+ok(36, $status == 1 );
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+ok(37, $h{'x'} eq 'X' );
+
+# standard put
+$status = $X->put('key', 'value') ;
+ok(38, $status == 0 );
+
+#check that previous put can be retrieved
+$value = 0 ;
+$status = $X->get('key', $value) ;
+ok(39, $status == 0 );
+ok(40, $value eq 'value' );
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+ok(41, $status == 0 );
+#$status = $X->del('') ;
+#ok(42, $status == 0 );
+ok(42,1) ;
+
+# Make sure that the key deleted, cannot be retrieved
+ok(43, ! defined $h{'q'}) ;
+ok(44, ! defined $h{''}) ;
+
+undef $X ;
+untie %h ;
+
+ok(45, $X = tie(%h, 'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE ));
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+ok(46, $status == 1 );
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+ok(47, $status == 1 );
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+ok(48, $status == 0 );
+ok(49, $value eq 'A' );
+
+# seq
+# ###
+
+# use seq to find an approximate match
+$key = 'ke' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(50, $status == 0 );
+ok(51, $key eq 'key' );
+ok(52, $value eq 'value' );
+
+# seq when the key does not match
+$key = 'zzz' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(53, $status == 1 );
+
+
+# use seq to set the cursor, then delete the record @ the cursor.
+
+$key = 'x' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(54, $status == 0 );
+ok(55, $key eq 'x' );
+ok(56, $value eq 'X' );
+$status = $X->del(0, R_CURSOR) ;
+ok(57, $status == 0 );
+$status = $X->get('x', $value) ;
+ok(58, $status == 1 );
+
+# ditto, but use put to replace the key/value pair.
+$key = 'y' ;
+$value = '' ;
+$status = $X->seq($key, $value, R_CURSOR) ;
+ok(59, $status == 0 );
+ok(60, $key eq 'y' );
+ok(61, $value eq 'Y' );
+
+$key = "replace key" ;
+$value = "replace value" ;
+$status = $X->put($key, $value, R_CURSOR) ;
+ok(62, $status == 0 );
+ok(63, $key eq 'replace key' );
+ok(64, $value eq 'replace value' );
+$status = $X->get('y', $value) ;
+ok(65, 1) ; # hard-wire to always pass. the previous test ($status == 1)
+	    # only worked because of a bug in 1.85/6
+
+# use seq to walk forwards through a file 
+
+$status = $X->seq($key, $value, R_FIRST) ;
+ok(66, $status == 0 );
+$previous = $key ;
+
+$ok = 1 ;
+while (($status = $X->seq($key, $value, R_NEXT)) == 0)
+{
+    ($ok = 0), last if ($previous cmp $key) == 1 ;
+}
+
+ok(67, $status == 1 );
+ok(68, $ok == 1 );
+
+# use seq to walk backwards through a file 
+$status = $X->seq($key, $value, R_LAST) ;
+ok(69, $status == 0 );
+$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" ;
+}
+
+ok(70, $status == 1 );
+ok(71, $ok == 1 );
+
+
+# check seq FIRST/LAST
+
+# sync
+# ####
+
+$status = $X->sync ;
+ok(72, $status == 0 );
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+ok(73, $status != 0 );
+
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# Now try an in memory file
+ok(74, $Y = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_BTREE ));
+
+# fd with an in memory file should return failure
+$status = $Y->fd ;
+ok(75, $status == -1 );
+
+
+undef $Y ;
+untie %h ;
+
+# Duplicate keys
+my $bt = new DB_File::BTREEINFO ;
+$bt->{flags} = R_DUP ;
+ok(76, $YY = tie(%hh, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $bt )) ;
+
+$hh{'Wall'} = 'Larry' ;
+$hh{'Wall'} = 'Stone' ; # Note the duplicate key
+$hh{'Wall'} = 'Brick' ; # Note the duplicate key
+$hh{'Wall'} = 'Brick' ; # Note the duplicate key and value
+$hh{'Smith'} = 'John' ;
+$hh{'mouse'} = 'mickey' ;
+
+# first work in scalar context
+ok(77, scalar $YY->get_dup('Unknown') == 0 );
+ok(78, scalar $YY->get_dup('Smith') == 1 );
+ok(79, scalar $YY->get_dup('Wall') == 4 );
+
+# now in list context
+my @unknown = $YY->get_dup('Unknown') ;
+ok(80, "@unknown" eq "" );
+
+my @smith = $YY->get_dup('Smith') ;
+ok(81, "@smith" eq "John" );
+
+{
+my @wall = $YY->get_dup('Wall') ;
+my %wall ;
+@wall{@wall} = @wall ;
+ok(82, (@wall == 4 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) );
+}
+
+# hash
+my %unknown = $YY->get_dup('Unknown', 1) ;
+ok(83, keys %unknown == 0 );
+
+my %smith = $YY->get_dup('Smith', 1) ;
+ok(84, keys %smith == 1 && $smith{'John'}) ;
+
+my %wall = $YY->get_dup('Wall', 1) ;
+ok(85, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 
+		&& $wall{'Brick'} == 2);
+
+undef $YY ;
+untie %hh ;
+unlink $Dfile;
+
+
+# test multiple callbacks
+$Dfile1 = "btree1" ;
+$Dfile2 = "btree2" ;
+$Dfile3 = "btree3" ;
+ 
+$dbh1 = new DB_File::BTREEINFO ;
+{ local $^W = 0 ;
+  $dbh1->{compare} = sub { $_[0] <=> $_[1] } ; }
+ 
+$dbh2 = new DB_File::BTREEINFO ;
+$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
+ 
+$dbh3 = new 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  ) ;
+{ local $^W = 0 ;
+  @srt_1 = sort { $a <=> $b } @Keys ; }
+@srt_2 = sort { $a cmp $b } @Keys ;
+@srt_3 = sort { length $a <=> length $b } @Keys ;
+ 
+foreach (@Keys) {
+    { local $^W = 0 ; 
+      $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 ;
+}
+ 
+ok(86, ArrayCompare (\@srt_1, [keys %h]) );
+ok(87, ArrayCompare (\@srt_2, [keys %g]) );
+ok(88, ArrayCompare (\@srt_3, [keys %k]) );
+
+untie %h ;
+untie %g ;
+untie %k ;
+unlink $Dfile1, $Dfile2, $Dfile3 ;
+
+# clear
+# #####
+
+ok(89, tie(%h, 'DB_File', $Dfile1, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
+foreach (1 .. 10)
+  { $h{$_} = $_ * 100 }
+
+# check that there are 10 elements in the hash
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(90, $i == 10);
+
+# now clear the hash
+%h = () ;
+
+# check it is empty
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(91, $i == 0);
+
+untie %h ;
+unlink $Dfile1 ;
+
+{
+    # check that attempting to tie an array to a DB_BTREE will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE ; } ;
+    ok(92, $@ =~ /^DB_File can only tie an associative array to a DB_BTREE database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }    
+    eval 'use SubDB ; ';
+    main::ok(93, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbbtree.tmp", O_RDWR|O_CREAT, 0640, $DB_BTREE );
+	' ;
+
+    main::ok(94, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(95, $@ eq "") ;
+    main::ok(96, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(97, $@ eq "") ;
+    main::ok(98, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(99, $@ eq "" ) ;
+    main::ok(100, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(101, $@ eq "") ;
+    main::ok(102, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", "dbbtree.tmp" ;
+
+}
+
+exit ;
diff --git a/contrib/perl5/t/lib/db-hash.t b/contrib/perl5/t/lib/db-hash.t
new file mode 100755
index 0000000..e748472
--- /dev/null
+++ b/contrib/perl5/t/lib/db-hash.t
@@ -0,0 +1,416 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib' if -d '../lib' ;
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+
+print "1..62\n";
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+ 
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+$Dfile = "dbhash.tmp";
+unlink $Dfile;
+
+umask(0);
+
+# Check the interface to HASHINFO
+
+my $dbh = new DB_File::HASHINFO ;
+
+ok(1, ! defined $dbh->{bsize}) ;
+ok(2, ! defined $dbh->{ffactor}) ;
+ok(3, ! defined $dbh->{nelem}) ;
+ok(4, ! defined $dbh->{cachesize}) ;
+ok(5, ! defined $dbh->{hash}) ;
+ok(6, ! defined $dbh->{lorder}) ;
+
+$dbh->{bsize} = 3000 ;
+ok(7, $dbh->{bsize} == 3000 );
+
+$dbh->{ffactor} = 9000 ;
+ok(8, $dbh->{ffactor} == 9000 );
+
+$dbh->{nelem} = 400 ;
+ok(9, $dbh->{nelem} == 400 );
+
+$dbh->{cachesize} = 65 ;
+ok(10, $dbh->{cachesize} == 65 );
+
+$dbh->{hash} = "abc" ;
+ok(11, $dbh->{hash} eq "abc" );
+
+$dbh->{lorder} = 1234 ;
+ok(12, $dbh->{lorder} == 1234 );
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
+eval 'my $q = $dbh->{fred}' ;
+ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
+
+
+# Now check the interface to HASH
+
+ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos' || $^O eq 'MSWin32');
+
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(17, !$i );
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+ok(18, $h{'abc'} eq 'ABC' );
+ok(19, !defined $h{'jimmy'} );
+ok(20, !exists $h{'jimmy'} );
+ok(21, exists $h{'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';
+$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
+ok(22, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640) );
+
+# 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);
+
+ok(23, $#keys == 29 && $#values == 29) ;
+
+$i = 0 ;
+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;
+    }
+}
+
+ok(24, $i == 30) ;
+
+@keys = ('blurfl', keys(%h), 'dyick');
+ok(25, $#keys == 31) ;
+
+$h{'foo'} = '';
+ok(26, $h{'foo'} eq '' );
+
+#$h{''} = 'bar';
+#ok(27, $h{''} eq 'bar' );
+ok(27,1) ;
+
+# 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; }
+ok(28, $ok );
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+   $blksize,$blocks) = stat($Dfile);
+ok(29, $size > 0 );
+
+@h{0..200} = 200..400;
+@foo = @h{0..200};
+ok(30, join(':',200..400) eq join(':',@foo) );
+
+
+# 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) ;
+ok(31, $status == 1 );
+ 
+# check that the value of the key 'x' has not been changed by the 
+# previous test
+ok(32, $h{'x'} eq 'X' );
+
+# standard put
+$status = $X->put('key', 'value') ;
+ok(33, $status == 0 );
+
+#check that previous put can be retrieved
+$value = 0 ;
+$status = $X->get('key', $value) ;
+ok(34, $status == 0 );
+ok(35, $value eq 'value' );
+
+# Attempting to delete an existing key should work
+
+$status = $X->del('q') ;
+ok(36, $status == 0 );
+
+# Make sure that the key deleted, cannot be retrieved
+$^W = 0 ;
+ok(37, $h{'q'} eq undef );
+$^W = 1 ;
+
+# Attempting to delete a non-existant key should fail
+
+$status = $X->del('joe') ;
+ok(38, $status == 1 );
+
+# Check the get interface
+
+# First a non-existing key
+$status = $X->get('aaaa', $value) ;
+ok(39, $status == 1 );
+
+# Next an existing key
+$status = $X->get('a', $value) ;
+ok(40, $status == 0 );
+ok(41, $value eq 'A' );
+
+# 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 ;
+ok(42, $status == 0 );
+
+
+# fd
+# ##
+
+$status = $X->fd ;
+ok(43, $status != 0 );
+
+undef $X ;
+untie %h ;
+
+unlink $Dfile;
+
+# clear
+# #####
+
+ok(44, tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+foreach (1 .. 10)
+  { $h{$_} = $_ * 100 }
+
+# check that there are 10 elements in the hash
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(45, $i == 10);
+
+# now clear the hash
+%h = () ;
+
+# check it is empty
+$i = 0 ;
+while (($key,$value) = each(%h)) {
+    $i++;
+}
+ok(46, $i == 0);
+
+untie %h ;
+unlink $Dfile ;
+
+
+# Now try an in memory file
+ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+# fd with an in memory file should return fail
+$status = $X->fd ;
+ok(48, $status == -1 );
+
+undef $X ;
+untie %h ;
+
+{
+    # check ability to override the default hashing
+    my %x ;
+    my $filename = "xyz" ;
+    my $hi = new DB_File::HASHINFO ;
+    $::count = 0 ;
+    $hi->{hash} = sub { ++$::count ; length $_[0] } ;
+    ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
+    $h{"abc"} = 123 ;
+    ok(50, $h{"abc"} == 123) ;
+    untie %x ;
+    unlink $filename ;
+    ok(51, $::count >0) ;
+}
+
+{
+    # check that attempting to tie an array to a DB_HASH will fail
+
+    my $filename = "xyz" ;
+    my @x ;
+    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_HASH ; } ;
+    ok(52, $@ =~ /^DB_File can only tie an associative array to a DB_HASH database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }             
+    eval 'use SubDB ; ';
+    main::ok(53, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640, $DB_HASH );
+	' ;
+
+    main::ok(54, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(55, $@ eq "") ;
+    main::ok(56, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
+    main::ok(57, $@ eq "") ;
+    main::ok(58, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(59, $@ eq "" ) ;
+    main::ok(60, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("joe") ' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", "dbhash.tmp" ;
+
+}
+exit ;
diff --git a/contrib/perl5/t/lib/db-recno.t b/contrib/perl5/t/lib/db-recno.t
new file mode 100755
index 0000000..c89c3ca
--- /dev/null
+++ b/contrib/perl5/t/lib/db-recno.t
@@ -0,0 +1,453 @@
+#!./perl -w
+
+BEGIN {
+    @INC = '../lib' if -d '../lib' ;
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bDB_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use DB_File; 
+use Fcntl;
+use strict ;
+use vars qw($dbh $Dfile $bad_ones $FA) ;
+
+# full tied array support started in Perl 5.004_57
+# Double check to see if it is available.
+
+{
+    sub try::TIEARRAY { bless [], "try" }
+    sub try::FETCHSIZE { $FA = 1 }
+    $FA = 0 ;
+    my @a ; 
+    tie @a, 'try' ;
+    my $a = @a ;
+}
+
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+
+    return $result ;
+}
+
+sub bad_one
+{
+    print STDERR <<EOM unless $bad_ones++ ;
+#
+# Some older versions of Berkeley DB will fail tests 51, 53 and 55.
+#
+# You can safely ignore the errors if you're never going to use the
+# broken functionality (recno databases with a modified bval). 
+# Otherwise you'll have to upgrade your DB library.
+#
+# If you want to upgrade Berkeley DB, the most recent version is 1.85.
+# Check out http://www.bostic.com/db for more details.
+#
+EOM
+}
+
+print "1..78\n";
+
+my $Dfile = "recno.tmp";
+unlink $Dfile ;
+
+umask(0);
+
+# Check the interface to RECNOINFO
+
+my $dbh = new DB_File::RECNOINFO ;
+ok(1, ! defined $dbh->{bval}) ;
+ok(2, ! defined $dbh->{cachesize}) ;
+ok(3, ! defined $dbh->{psize}) ;
+ok(4, ! defined $dbh->{flags}) ;
+ok(5, ! defined $dbh->{lorder}) ;
+ok(6, ! defined $dbh->{reclen}) ;
+ok(7, ! defined $dbh->{bfname}) ;
+
+$dbh->{bval} = 3000 ;
+ok(8, $dbh->{bval} == 3000 );
+
+$dbh->{cachesize} = 9000 ;
+ok(9, $dbh->{cachesize} == 9000 );
+
+$dbh->{psize} = 400 ;
+ok(10, $dbh->{psize} == 400 );
+
+$dbh->{flags} = 65 ;
+ok(11, $dbh->{flags} == 65 );
+
+$dbh->{lorder} = 123 ;
+ok(12, $dbh->{lorder} == 123 );
+
+$dbh->{reclen} = 1234 ;
+ok(13, $dbh->{reclen} == 1234 );
+
+$dbh->{bfname} = 1234 ;
+ok(14, $dbh->{bfname} == 1234 );
+
+
+# Check that an invalid entry is caught both for store & fetch
+eval '$dbh->{fred} = 1234' ;
+ok(15, $@ =~ /^DB_File::RECNOINFO::STORE - Unknown element 'fred' at/ );
+eval 'my $q = $dbh->{fred}' ;
+ok(16, $@ =~ /^DB_File::RECNOINFO::FETCH - Unknown element 'fred' at/ );
+
+# Now check the interface to RECNOINFO
+
+my $X  ;
+my @h ;
+ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
+
+ok(18, ((stat($Dfile))[2] & 0777) == ($^O eq 'os2' ? 0666 : 0640)
+	||  $^O eq 'MSWin32' || $^O eq 'amigaos') ;
+
+#my $l = @h ;
+my $l = $X->length ;
+ok(19, ($FA ? @h == 0 : !$l) );
+
+my @data = qw( a b c d ever f g h  i j k longername m n o p) ;
+
+$h[0] = shift @data ;
+ok(20, $h[0] eq 'a' );
+
+my $ i;
+foreach (@data)
+  { $h[++$i] = $_ }
+
+unshift (@data, 'a') ;
+
+ok(21, defined $h[1] );
+ok(22, ! defined $h[16] );
+ok(23, $FA ? @h == @data : $X->length == @data );
+
+
+# Overwrite an entry & check fetch it
+$h[3] = 'replaced' ;
+$data[3] = 'replaced' ;
+ok(24, $h[3] eq 'replaced' );
+
+#PUSH
+my @push_data = qw(added to the end) ;
+($FA ? push(@h, @push_data) : $X->push(@push_data)) ;
+push (@data, @push_data) ;
+ok(25, $h[++$i] eq 'added' );
+ok(26, $h[++$i] eq 'to' );
+ok(27, $h[++$i] eq 'the' );
+ok(28, $h[++$i] eq 'end' );
+
+# POP
+my $popped = pop (@data) ;
+my $value = ($FA ? pop @h : $X->pop) ;
+ok(29, $value eq $popped) ;
+
+# SHIFT
+$value = ($FA ? shift @h : $X->shift) ;
+my $shifted = shift @data ;
+ok(30, $value eq $shifted );
+
+# UNSHIFT
+
+# empty list
+($FA ? unshift @h : $X->unshift) ;
+ok(31, ($FA ? @h == @data : $X->length == @data ));
+
+my @new_data = qw(add this to the start of the array) ;
+$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ;
+unshift (@data, @new_data) ;
+ok(32, $FA ? @h == @data : $X->length == @data );
+ok(33, $h[0] eq "add") ;
+ok(34, $h[1] eq "this") ;
+ok(35, $h[2] eq "to") ;
+ok(36, $h[3] eq "the") ;
+ok(37, $h[4] eq "start") ;
+ok(38, $h[5] eq "of") ;
+ok(39, $h[6] eq "the") ;
+ok(40, $h[7] eq "array") ;
+ok(41, $h[8] eq $data[8]) ;
+
+# SPLICE
+
+# Now both arrays should be identical
+
+my $ok = 1 ;
+my $j = 0 ;
+foreach (@data)
+{
+   $ok = 0, last if $_ ne $h[$j ++] ; 
+}
+ok(42, $ok );
+
+# Neagtive subscripts
+
+# get the last element of the array
+ok(43, $h[-1] eq $data[-1] );
+ok(44, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] );
+
+# get the first element using a negative subscript
+eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ;
+ok(45, $@ eq "" );
+ok(46, $h[0] eq "abcd" );
+
+# now try to read before the start of the array
+eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ;
+ok(47, $@ =~ '^Modification of non-creatable array value attempted' );
+
+# IMPORTANT - $X must be undefined before the untie otherwise the
+#             underlying DB close routine will not get called.
+undef $X ;
+untie(@h);
+
+unlink $Dfile;
+
+sub docat
+{
+    my $file = shift;
+    local $/ = undef;
+    open(CAT,$file) || die "Cannot open $file:$!";
+    my $result = <CAT>;
+    close(CAT);
+    return $result;
+}
+
+
+{
+    # Check bval defaults to \n
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    ok(48, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    ok(49, $x eq "abc\ndef\n\nghi\n") ;
+}
+
+{
+    # Change bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{bval} = "-" ;
+    ok(50, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc-def--ghi-") ;
+    bad_one() unless $ok ;
+    ok(51, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with default bval (space)
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{reclen} = 5 ;
+    ok(52, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc  def       ghi  ") ;
+    bad_one() unless $ok ;
+    ok(53, $ok) ;
+}
+
+{
+    # Check R_FIXEDLEN with user-defined bval
+
+    my @h = () ;
+    my $dbh = new DB_File::RECNOINFO ;
+    $dbh->{flags} = R_FIXEDLEN ;
+    $dbh->{bval} = "-" ;
+    $dbh->{reclen} = 5 ;
+    ok(54, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[3] = "ghi" ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    unlink $Dfile;
+    my $ok = ($x eq "abc--def-------ghi--") ;
+    bad_one() unless $ok ;
+    ok(55, $ok) ;
+}
+
+{
+    # check that attempting to tie an associative array to a DB_RECNO will fail
+
+    my $filename = "xyz" ;
+    my %x ;
+    eval { tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO ; } ;
+    ok(56, $@ =~ /^DB_File can only tie an array to a DB_RECNO database/) ;
+    unlink $filename ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use DB_File;
+   @ISA=qw(DB_File);
+   @EXPORT = @DB_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub put { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::put($key, $value * 3) ;
+   }
+
+   sub get { 
+	my $self = shift ;
+        $self->SUPER::get($_[0], $_[1]) ;
+	$_[1] -= 2 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; } 
+    eval 'use SubDB ; ';
+    main::ok(57, $@ eq "") ;
+    my @h ;
+    my $X ;
+    eval '
+	$X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
+	' ;
+
+    main::ok(58, $@ eq "") ;
+
+    my $ret = eval '$h[3] = 3 ; return $h[3] ' ;
+    main::ok(59, $@ eq "") ;
+    main::ok(60, $ret == 5) ;
+
+    my $value = 0;
+    $ret = eval '$X->put(1, 4) ; $X->get(1, $value) ; return $value' ;
+    main::ok(61, $@ eq "") ;
+    main::ok(62, $ret == 10) ;
+
+    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
+    main::ok(63, $@ eq "" ) ;
+    main::ok(64, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method(1) ' ;
+    main::ok(65, $@ eq "") ;
+    main::ok(66, $ret eq "[[11]]") ;
+
+    undef $X;
+    untie(@h);
+    unlink "SubDB.pm", "recno.tmp" ;
+
+}
+
+{
+
+    # test $#
+    my $self ;
+    unlink $Dfile;
+    ok(67, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
+    $h[0] = "abc" ;
+    $h[1] = "def" ;
+    $h[2] = "ghi" ;
+    $h[3] = "jkl" ;
+    ok(68, $FA ? $#h == 3 : $self->length() == 4) ;
+    undef $self ;
+    untie @h ;
+    my $x = docat($Dfile) ;
+    ok(69, $x eq "abc\ndef\nghi\njkl\n") ;
+
+    # $# sets array to same length
+    ok(70, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 3 }
+    else 
+      { $self->STORESIZE(4) }
+    ok(71, $FA ? $#h == 3 : $self->length() == 4) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(72, $x eq "abc\ndef\nghi\njkl\n") ;
+
+    # $# sets array to bigger
+    ok(73, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 6 }
+    else 
+      { $self->STORESIZE(7) }
+    ok(74, $FA ? $#h == 6 : $self->length() == 7) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(75, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ;
+
+    # $# sets array smaller
+    ok(76, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
+    if ($FA)
+      { $#h = 2 }
+    else 
+      { $self->STORESIZE(3) }
+    ok(77, $FA ? $#h == 2 : $self->length() == 3) ;
+    undef $self ;
+    untie @h ;
+    $x = docat($Dfile) ;
+    ok(78, $x eq "abc\ndef\nghi\n") ;
+
+    unlink $Dfile;
+
+
+}
+
+exit ;
diff --git a/contrib/perl5/t/lib/dirhand.t b/contrib/perl5/t/lib/dirhand.t
new file mode 100755
index 0000000..aa7be35
--- /dev/null
+++ b/contrib/perl5/t/lib/dirhand.t
@@ -0,0 +1,33 @@
+#!./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 ".";
+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/contrib/perl5/t/lib/dosglob.t b/contrib/perl5/t/lib/dosglob.t
new file mode 100755
index 0000000..577d4ea
--- /dev/null
+++ b/contrib/perl5/t/lib/dosglob.t
@@ -0,0 +1,112 @@
+#!./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
+$_ = "lib/a*.t";
+my @r = glob;
+print "not " if $_ ne 'lib/a*.t';
+print "ok 1\n";
+# we should have at least abbrev.t, anydbm.t, autoloader.t
+print "# |@r|\nnot " if @r < 3;
+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 array 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/contrib/perl5/t/lib/dumper-ovl.t b/contrib/perl5/t/lib/dumper-ovl.t
new file mode 100755
index 0000000..db4a5d9
--- /dev/null
+++ b/contrib/perl5/t/lib/dumper-ovl.t
@@ -0,0 +1,30 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+use Data::Dumper;
+
+print "1..1\n";
+
+package Foo;
+use overload '""' => 'as_string';
+
+sub new { bless { foo => "bar" }, shift }
+sub as_string { "%%%%" }
+
+package main;
+
+my $f = Foo->new;
+
+print "#\$f=$f\n";
+
+$_ = Dumper($f);
+s/^/#/mg;
+print $_;
+
+print "not " unless /bar/ && /Foo/;
+print "ok 1\n";
+
diff --git a/contrib/perl5/t/lib/dumper.t b/contrib/perl5/t/lib/dumper.t
new file mode 100755
index 0000000..70f8abe
--- /dev/null
+++ b/contrib/perl5/t/lib/dumper.t
@@ -0,0 +1,611 @@
+#!./perl -w
+#
+# testsuite for Data::Dumper
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+use Data::Dumper;
+
+$Data::Dumper::Pad = "#";
+my $TMAX;
+my $XS;
+my $TNUM = 0;
+my $WANT = '';
+
+sub TEST {
+  my $string = shift;
+  my $t = eval $string;
+  ++$TNUM;
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+
+  ++$TNUM;
+  eval "$t";
+  print $@ ? "not ok $TNUM\n# \$@ says: $@\n" : "ok $TNUM\n";
+
+  $t = eval $string;
+  ++$TNUM;
+  print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
+	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
+}
+
+if (defined &Data::Dumper::Dumpxs) {
+  print "### XS extension loaded, will run XS tests\n";
+  $TMAX = 138; $XS = 1;
+}
+else {
+  print "### XS extensions not loaded, will NOT run XS tests\n";
+  $TMAX = 69; $XS = 0;
+}
+
+print "1..$TMAX\n";
+
+#############
+#############
+
+@c = ('c');
+$c = \@c;
+$b = {};
+$a = [1, $b, $c];
+$b->{a} = $a;
+$b->{b} = $a->[1];
+$b->{c} = $a->[2];
+
+############# 1
+##
+$WANT = <<'EOT';
+#$a = [
+#       1,
+#       {
+#         'a' => $a,
+#         'b' => $a->[1],
+#         'c' => [
+#                  'c'
+#                ]
+#       },
+#       $a->[1]{'c'}
+#     ];
+#$b = $a->[1];
+#$c = $a->[1]{'c'};
+EOT
+
+TEST q(Data::Dumper->Dump([$a,$b,$c], [qw(a b c)]));
+TEST q(Data::Dumper->Dumpxs([$a,$b,$c], [qw(a b c)])) if $XS;
+
+
+############# 7
+##
+$WANT = <<'EOT';
+#@a = (
+#       1,
+#       {
+#         'a' => [],
+#         'b' => {},
+#         'c' => [
+#                  'c'
+#                ]
+#       },
+#       []
+#     );
+#$a[1]{'a'} = \@a;
+#$a[1]{'b'} = $a[1];
+#$a[2] = $a[1]{'c'};
+#$b = $a[1];
+EOT
+
+$Data::Dumper::Purity = 1;         # fill in the holes for eval
+TEST q(Data::Dumper->Dump([$a, $b], [qw(*a b)])); # print as @a
+TEST q(Data::Dumper->Dumpxs([$a, $b], [qw(*a b)])) if $XS;
+
+############# 13
+##
+$WANT = <<'EOT';
+#%b = (
+#       'a' => [
+#                1,
+#                {},
+#                [
+#                  'c'
+#                ]
+#              ],
+#       'b' => {},
+#       'c' => []
+#     );
+#$b{'a'}[1] = \%b;
+#$b{'b'} = \%b;
+#$b{'c'} = $b{'a'}[2];
+#$a = $b{'a'};
+EOT
+
+TEST q(Data::Dumper->Dump([$b, $a], [qw(*b a)])); # print as %b
+TEST q(Data::Dumper->Dumpxs([$b, $a], [qw(*b a)])) if $XS;
+
+############# 19
+##
+$WANT = <<'EOT';
+#$a = [
+#  1,
+#  {
+#    'a' => [],
+#    'b' => {},
+#    'c' => []
+#  },
+#  []
+#];
+#$a->[1]{'a'} = $a;
+#$a->[1]{'b'} = $a->[1];
+#$a->[1]{'c'} = \@c;
+#$a->[2] = \@c;
+#$b = $a->[1];
+EOT
+
+$Data::Dumper::Indent = 1;
+TEST q(
+       $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+       $d->Seen({'*c' => $c});
+       $d->Dump;
+      );
+if ($XS) {
+  TEST q(
+	 $d = Data::Dumper->new([$a,$b], [qw(a b)]);
+	 $d->Seen({'*c' => $c});
+	 $d->Dumpxs;
+	);
+}
+
+
+############# 25
+##
+$WANT = <<'EOT';
+#$a = [
+#       #0
+#       1,
+#       #1
+#       {
+#         a => $a,
+#         b => $a->[1],
+#         c => [
+#                #0
+#                'c'
+#              ]
+#       },
+#       #2
+#       $a->[1]{c}
+#     ];
+#$b = $a->[1];
+EOT
+
+$d->Indent(3);
+$d->Purity(0)->Quotekeys(0);
+TEST q( $d->Reset; $d->Dump );
+
+TEST q( $d->Reset; $d->Dumpxs ) if $XS;
+
+############# 31
+##
+$WANT = <<'EOT';
+#$VAR1 = [
+#  1,
+#  {
+#    'a' => [],
+#    'b' => {},
+#    'c' => [
+#      'c'
+#    ]
+#  },
+#  []
+#];
+#$VAR1->[1]{'a'} = $VAR1;
+#$VAR1->[1]{'b'} = $VAR1->[1];
+#$VAR1->[2] = $VAR1->[1]{'c'};
+EOT
+
+TEST q(Dumper($a));
+TEST q(Data::Dumper::DumperX($a)) if $XS;
+
+############# 37
+##
+$WANT = <<'EOT';
+#[
+#  1,
+#  {
+#    a => $VAR1,
+#    b => $VAR1->[1],
+#    c => [
+#      'c'
+#    ]
+#  },
+#  $VAR1->[1]{c}
+#]
+EOT
+
+{
+  local $Data::Dumper::Purity = 0;
+  local $Data::Dumper::Quotekeys = 0;
+  local $Data::Dumper::Terse = 1;
+  TEST q(Dumper($a));
+  TEST q(Data::Dumper::DumperX($a)) if $XS;
+}
+
+
+############# 43
+##
+$WANT = <<'EOT';
+#$VAR1 = {
+#  "abc\000\efg" => "mno\000"
+#};
+EOT
+
+$foo = { "abc\000\efg" => "mno\000" };
+{
+  local $Data::Dumper::Useqq = 1;
+  TEST q(Dumper($foo));
+}
+
+  $WANT = <<"EOT";
+#\$VAR1 = {
+#  'abc\000\efg' => 'mno\000'
+#};
+EOT
+
+  {
+    local $Data::Dumper::Useqq = 1;
+    TEST q(Data::Dumper::DumperX($foo)) if $XS;   # cheat
+  }
+
+
+
+#############
+#############
+
+{
+  package main;
+  use Data::Dumper;
+  $foo = 5;
+  @foo = (10,\*foo);
+  %foo = (a=>1,b=>\$foo,c=>\@foo);
+  $foo{d} = \%foo;
+  $foo[2] = \%foo;
+
+############# 49
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#           #0
+#           10,
+#           #1
+#           '',
+#           #2
+#           {
+#             'a' => 1,
+#             'b' => '',
+#             'c' => [],
+#             'd' => {}
+#           }
+#         ];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#@bar = @{*::foo{ARRAY}};
+#%baz = %{*::foo{ARRAY}->[2]};
+EOT
+
+  $Data::Dumper::Purity = 1;
+  $Data::Dumper::Indent = 3;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 55
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#*::foo = \5;
+#*::foo = [
+#  10,
+#  '',
+#  {
+#    'a' => 1,
+#    'b' => '',
+#    'c' => [],
+#    'd' => {}
+#  }
+#];
+#*::foo{ARRAY}->[1] = $foo;
+#*::foo{ARRAY}->[2]{'b'} = *::foo{SCALAR};
+#*::foo{ARRAY}->[2]{'c'} = *::foo{ARRAY};
+#*::foo{ARRAY}->[2]{'d'} = *::foo{ARRAY}->[2];
+#*::foo = *::foo{ARRAY}->[2];
+#$bar = *::foo{ARRAY};
+#$baz = *::foo{ARRAY}->[2];
+EOT
+
+  $Data::Dumper::Indent = 1;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+############# 61
+##
+  $WANT = <<'EOT';
+#@bar = (
+#  10,
+#  \*::foo,
+#  {}
+#);
+#*::foo = \5;
+#*::foo = \@bar;
+#*::foo = {
+#  'a' => 1,
+#  'b' => '',
+#  'c' => [],
+#  'd' => {}
+#};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = \@bar;
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar[2] = *::foo{HASH};
+#%baz = %{*::foo{HASH}};
+#$foo = $bar[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['*bar', '*baz', '*foo'])) if $XS;
+
+############# 67
+##
+  $WANT = <<'EOT';
+#$bar = [
+#  10,
+#  \*::foo,
+#  {}
+#];
+#*::foo = \5;
+#*::foo = $bar;
+#*::foo = {
+#  'a' => 1,
+#  'b' => '',
+#  'c' => [],
+#  'd' => {}
+#};
+#*::foo{HASH}->{'b'} = *::foo{SCALAR};
+#*::foo{HASH}->{'c'} = $bar;
+#*::foo{HASH}->{'d'} = *::foo{HASH};
+#$bar->[2] = *::foo{HASH};
+#$baz = *::foo{HASH};
+#$foo = $bar->[1];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo']));
+  TEST q(Data::Dumper->Dumpxs([\\@foo, \\%foo, \\*foo], ['bar', 'baz', 'foo'])) if $XS;
+
+############# 73
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#@bar = (
+#  10,
+#  $foo,
+#  {
+#    a => 1,
+#    b => \5,
+#    c => \@bar,
+#    d => $bar[2]
+#  }
+#);
+#%baz = %{$bar[2]};
+EOT
+
+  $Data::Dumper::Purity = 0;
+  $Data::Dumper::Quotekeys = 0;
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['*foo', '*bar', '*baz'])) if $XS;
+
+############# 79
+##
+  $WANT = <<'EOT';
+#$foo = \*::foo;
+#$bar = [
+#  10,
+#  $foo,
+#  {
+#    a => 1,
+#    b => \5,
+#    c => $bar,
+#    d => $bar->[2]
+#  }
+#];
+#$baz = $bar->[2];
+EOT
+
+  TEST q(Data::Dumper->Dump([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz']));
+  TEST q(Data::Dumper->Dumpxs([\\*foo, \\@foo, \\%foo], ['foo', 'bar', 'baz'])) if $XS;
+
+}
+
+#############
+#############
+{
+  package main;
+  @dogs = ( 'Fido', 'Wags' );
+  %kennel = (
+            First => \$dogs[0],
+            Second =>  \$dogs[1],
+           );
+  $dogs[2] = \%kennel;
+  $mutts = \%kennel;
+  $mutts = $mutts;         # avoid warning
+  
+############# 85
+##
+  $WANT = <<'EOT';
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+#@dogs = (
+#  $kennels{First},
+#  $kennels{Second},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+
+  TEST q(
+	 $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+				[qw(*kennels *dogs *mutts)] );
+	 $d->Dump;
+	);
+  if ($XS) {
+    TEST q(
+	   $d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
+				  [qw(*kennels *dogs *mutts)] );
+	   $d->Dumpxs;
+	  );
+  }
+  
+############# 91
+##
+  $WANT = <<'EOT';
+#%kennels = %kennels;
+#@dogs = @dogs;
+#%mutts = %kennels;
+EOT
+
+  TEST q($d->Dump);
+  TEST q($d->Dumpxs) if $XS;
+  
+############# 97
+##
+  $WANT = <<'EOT';
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+#@dogs = (
+#  $kennels{First},
+#  $kennels{Second},
+#  \%kennels
+#);
+#%mutts = %kennels;
+EOT
+
+  
+  TEST q($d->Reset; $d->Dump);
+  if ($XS) {
+    TEST q($d->Reset; $d->Dumpxs);
+  }
+
+############# 103
+##
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    First => \$dogs[0],
+#    Second => \$dogs[1]
+#  }
+#);
+#%kennels = %{$dogs[2]};
+#%mutts = %{$dogs[2]};
+EOT
+
+  TEST q(
+	 $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+				[qw(*dogs *kennels *mutts)] );
+	 $d->Dump;
+	);
+  if ($XS) {
+    TEST q(
+	   $d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
+				  [qw(*dogs *kennels *mutts)] );
+	   $d->Dumpxs;
+	  );
+  }
+  
+############# 109
+##
+  TEST q($d->Reset->Dump);
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+
+############# 115
+##
+  $WANT = <<'EOT';
+#@dogs = (
+#  'Fido',
+#  'Wags',
+#  {
+#    First => \'Fido',
+#    Second => \'Wags'
+#  }
+#);
+#%kennels = (
+#  First => \'Fido',
+#  Second => \'Wags'
+#);
+EOT
+
+  TEST q(
+	 $d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
+	 $d->Deepcopy(1)->Dump;
+	);
+  if ($XS) {
+    TEST q($d->Reset->Dumpxs);
+  }
+  
+}
+
+{
+
+sub a { print "foo\n" }
+$c = [ \&a ];
+
+############# 121
+##
+  $WANT = <<'EOT';
+#$a = $b;
+#$c = [
+#  $b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dump;);
+TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dumpxs;)
+	if $XS;
+
+############# 127
+##
+  $WANT = <<'EOT';
+#$a = \&b;
+#$c = [
+#  \&b
+#];
+EOT
+
+TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dump;);
+TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dumpxs;)
+	if $XS;
+
+############# 133
+##
+  $WANT = <<'EOT';
+#*a = \&b;
+#@c = (
+#  \&b
+#);
+EOT
+
+TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dump;);
+TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dumpxs;)
+	if $XS;
+
+}
diff --git a/contrib/perl5/t/lib/english.t b/contrib/perl5/t/lib/english.t
new file mode 100755
index 0000000..9691229
--- /dev/null
+++ b/contrib/perl5/t/lib/english.t
@@ -0,0 +1,47 @@
+#!./perl
+
+print "1..16\n";
+
+BEGIN { @INC = '../lib' }
+use English;
+use Config;
+my $threads = $Config{'usethreads'} || 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);
+
+if ($threads) {
+    $_ = "ok 4\nok 5\nok 6\n";
+} else {
+    $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;
+
+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 == $0 ? "ok 15\n" : "not ok 15\n";
+print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
diff --git a/contrib/perl5/t/lib/env.t b/contrib/perl5/t/lib/env.t
new file mode 100755
index 0000000..5a82207
--- /dev/null
+++ b/contrib/perl5/t/lib/env.t
@@ -0,0 +1,18 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+	$ENV{FOO} = "foo";
+}
+
+use Env qw(FOO);
+
+$FOO .= "/bar";
+
+print "1..1\n";
+print "not " if $FOO ne 'foo/bar';
+print "ok 1\n";
diff --git a/contrib/perl5/t/lib/errno.t b/contrib/perl5/t/lib/errno.t
new file mode 100755
index 0000000..361723f
--- /dev/null
+++ b/contrib/perl5/t/lib/errno.t
@@ -0,0 +1,50 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Errno;
+
+print "1..5\n";
+
+print "not " unless @Errno::EXPORT_OK;
+print "ok 1\n";
+die unless @Errno::EXPORT_OK;
+
+$err = $Errno::EXPORT_OK[0];
+$num = &{"Errno::$err"};
+
+print "not " unless &{"Errno::$err"} == $num;
+print "ok 2\n";
+
+$! = $num;
+print "not " unless $!{$err};
+print "ok 3\n";
+
+$! = 0;
+print "not " if $!{$err};
+print "ok 4\n";
+
+$s1 = join(",",sort keys(%!));
+$s2 = join(",",sort @Errno::EXPORT_OK);
+
+if($s1 ne $s2) {
+    my @s1 = keys(%!);
+    my @s2 = @Errno::EXPORT_OK;
+    my(%s1,%s2);
+    @s1{@s1} = ();
+    @s2{@s2} = ();
+    delete @s2{@s1};
+    delete @s1{@s2};
+    print "# These are only in \%!\n";
+    print "# ",join(" ",map { "'$_'" } keys %s1),"\n";
+    print "# These are only in \@EXPORT_OK\n";
+    print "# ",join(" ",map { "'$_'" } keys %s2),"\n";
+    print "not ";
+}
+
+print "ok 5\n";
diff --git a/contrib/perl5/t/lib/fields.t b/contrib/perl5/t/lib/fields.t
new file mode 100755
index 0000000..139e469
--- /dev/null
+++ b/contrib/perl5/t/lib/fields.t
@@ -0,0 +1,112 @@
+#!./perl -w
+
+my $w;
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib' if -d '../lib';
+   $SIG{__WARN__} = sub {
+       if ($_[0] =~ /^Hides field 'b1' in base class/) {
+           $w++;
+           return;
+       }
+       print $_[0];
+   };
+}
+
+use strict;
+use vars qw($DEBUG);
+
+package B1;
+use fields qw(b1 b2 b3);
+
+package B2;
+use fields '_b1';
+use fields qw(b1 _b2 b2);
+
+sub new { bless [], shift }
+
+package D1;
+use base 'B1';
+use fields qw(d1 d2 d3);
+
+package D2;
+use base 'B1';
+use fields qw(_d1 _d2);
+use fields qw(d1 d2);
+
+package D3;
+use base 'B2';
+use fields qw(b1 d1 _b1 _d1);  # hide b1
+
+package D4;
+use base 'D3';
+use fields qw(_d3 d3);
+
+package M;
+sub m {}
+
+package D5;
+use base qw(M B2);
+
+package Foo::Bar;
+use base 'B1';
+
+package Foo::Bar::Baz;
+use base 'Foo::Bar';
+use fields qw(foo bar baz);
+
+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)+3, "\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 field "notthere"/;
+print "ok ", ++$testno, "\n";
+
+#fields::_dump();
diff --git a/contrib/perl5/t/lib/filecache.t b/contrib/perl5/t/lib/filecache.t
new file mode 100755
index 0000000..a97fdd5
--- /dev/null
+++ b/contrib/perl5/t/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/contrib/perl5/t/lib/filecopy.t b/contrib/perl5/t/lib/filecopy.t
new file mode 100755
index 0000000..329931f
--- /dev/null
+++ b/contrib/perl5/t/lib/filecopy.t
@@ -0,0 +1,90 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..11\n";
+
+$| = 1;
+
+use File::Copy;
+
+# First we create a file
+open(F, ">file-$$") or die;
+binmode F; # for DOSISH platforms, because test 3 copies to stdout
+print F "ok 3\n";
+close F;
+
+copy "file-$$", "copy-$$";
+
+open(F, "copy-$$") or die;
+$foo = <F>;
+close(F);
+
+print "not " if -s "file-$$" != -s "copy-$$";
+print "ok 1\n";
+
+print "not " unless $foo eq "ok 3\n";
+print "ok 2\n";
+
+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 "ok 3\n";
+print "ok 4\n";
+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 "ok 3\n";
+print "ok 5\n";
+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 "ok 3\n";
+print "ok 6\n";
+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 "ok 3\n";
+print "ok 7\n";
+unlink "file-$$" or die "unlink: $!";
+
+print "# moved missing file.\nnot " if move("file-$$", "copy-$$");
+print "# target disappeared.\nnot " if not -e "copy-$$";
+print "ok 8\n";
+
+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 "ok 3\n";
+print "ok 9\n";
+
+copy "file-$$", "lib";
+open(R, "lib/file-$$") or die; $foo = <R>; close(R);
+print "not " unless $foo eq "ok 3\n";
+print "ok 10\n";
+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 "ok 3\n" and not -e "file-$$";;
+print "ok 11\n";
+unlink "lib/file-$$" or die "unlink: $!";
+
diff --git a/contrib/perl5/t/lib/filefind.t b/contrib/perl5/t/lib/filefind.t
new file mode 100755
index 0000000..cd2e977
--- /dev/null
+++ b/contrib/perl5/t/lib/filefind.t
@@ -0,0 +1,14 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..2\n";
+
+use File::Find;
+
+# hope we will eventually find ourself
+find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, ".");
+finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, ".");
diff --git a/contrib/perl5/t/lib/filehand.t b/contrib/perl5/t/lib/filehand.t
new file mode 100755
index 0000000..b8ec95f
--- /dev/null
+++ b/contrib/perl5/t/lib/filehand.t
@@ -0,0 +1,90 @@
+#!./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') {
+  $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/contrib/perl5/t/lib/filepath.t b/contrib/perl5/t/lib/filepath.t
new file mode 100755
index 0000000..c3bf4a4
--- /dev/null
+++ b/contrib/perl5/t/lib/filepath.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Path;
+use strict;
+
+my $count = 0;
+$^W = 1;
+
+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/contrib/perl5/t/lib/filespec.t b/contrib/perl5/t/lib/filespec.t
new file mode 100755
index 0000000..ca22d3e
--- /dev/null
+++ b/contrib/perl5/t/lib/filespec.t
@@ -0,0 +1,43 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+use File::Spec;
+
+
+if (File::Spec->catfile('a','b','c') eq 'a/b/c') {
+	print "ok 1\n";
+} else {
+	print "not ok 1\n";
+}
+
+use File::Spec::OS2;
+
+if (File::Spec::OS2->catfile('a','b','c') eq 'a/b/c') {
+	print "ok 2\n";
+} else {
+	print "not ok 2\n";
+}
+
+use File::Spec::Win32;
+
+if (File::Spec::Win32->catfile('a','b','c') eq 'a\b\c') {
+	print "ok 3\n";
+} else {
+	print "not ok 3\n";
+}
+
+use File::Spec::Mac;
+
+if (File::Spec::Mac->catfile('a','b','c') eq 'a:b:c') {
+	print "ok 4\n";
+} else {
+	print "not ok 4\n";
+}
+
diff --git a/contrib/perl5/t/lib/findbin.t b/contrib/perl5/t/lib/findbin.t
new file mode 100755
index 0000000..3e742f9
--- /dev/null
+++ b/contrib/perl5/t/lib/findbin.t
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FindBin qw($Bin);
+
+print "not " unless $Bin =~ m,t[/.]lib\]?$,;
+print "ok 1\n";
diff --git a/contrib/perl5/t/lib/gdbm.t b/contrib/perl5/t/lib/gdbm.t
new file mode 100755
index 0000000..2395611
--- /dev/null
+++ b/contrib/perl5/t/lib/gdbm.t
@@ -0,0 +1,208 @@
+#!./perl
+
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
+
+BEGIN {
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use GDBM_File;
+
+print "1..20\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*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+    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\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 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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use GDBM_File;
+   @ISA=qw(GDBM_File);
+   @EXPORT = @GDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval ' &GDBM_WRCREAT eq &main::GDBM_WRCREAT ' ;
+    main::ok(17, $@ eq "" ) ;
+    main::ok(18, $ret == 1) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(19, $@ eq "") ;
+    main::ok(20, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/contrib/perl5/t/lib/getopt.t b/contrib/perl5/t/lib/getopt.t
new file mode 100755
index 0000000..fb70f10
--- /dev/null
+++ b/contrib/perl5/t/lib/getopt.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/contrib/perl5/t/lib/h2ph.h b/contrib/perl5/t/lib/h2ph.h
new file mode 100644
index 0000000..cddf0a7
--- /dev/null
+++ b/contrib/perl5/t/lib/h2ph.h
@@ -0,0 +1,85 @@
+/* 
+ * Test header file for h2ph
+ * 
+ * Try to test as many constructs as possible
+ * For example, the multi-line comment :)
+ */
+
+/* And here's a single line comment :) */
+
+/* Test #define with no indenting, over multiple lines */
+#define SQUARE(x) \
+((x)*(x))
+
+/* Test #ifndef and parameter interpretation*/
+#ifndef ERROR
+#define ERROR(x) fprintf(stderr, "%s\n", x[2][3][0])
+#endif /* ERROR */
+
+#ifndef _H2PH_H_
+#define _H2PH_H_
+
+/* #ident - doesn't really do anything, but I think it always gets included anyway */
+#ident "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $"
+
+/* Test #undef */
+#undef MAX
+#define MAX(a,b) ((a) > (b) ? (a) : (b))
+
+/* Test #ifdef */
+#ifdef __SOME_UNIMPORTANT_PROPERTY
+#define MIN(a,b) ((a) < (b) ? (a) : (b))
+#endif /* __SOME_UNIMPORTANT_PROPERTY */
+
+/* 
+ * Test #if, #elif, #else, #endif, #warn and #error, and `!'
+ * Also test whitespace between the `#' and the command
+ */
+#if !(defined __SOMETHING_MORE_IMPORTANT)
+#    warn Be careful...
+#elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT)
+#    error Nup, can't go on /* ' /* stupid font-lock-mode */
+#else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */
+#    define EVERYTHING_IS_OK
+#endif
+
+/* Test && and || */
+#undef WHATEVER
+#if (!((defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO)) \
+     || defined __SOMETHING_OVERPOWERING)
+#    define WHATEVER 6
+#elif !(defined __SOMETHING_TRIVIAL) /* defined __SOMETHING_LESS_SO */
+#    define WHATEVER 7
+#elif !(defined __SOMETHING_LESS_SO) /* defined __SOMETHING_TRIVIAL */
+#    define WHATEVER 8
+#else /* defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO */
+#    define WHATEVER 1000
+#endif
+
+/* 
+ * Test #include, #import and #include_next
+ * #include_next is difficult to test, it really depends on the actual
+ *  circumstances - for example, `#include_next <limits.h>' on a Linux system
+ *  with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever
+ *  your equivalent is...
+ */
+#include <sys/socket.h>
+#import "sys/ioctl.h"
+#include_next <sys/fcntl.h>
+
+/* typedefs should be ignored */
+typedef struct a_struct {
+  int typedefs_should;
+  char be_ignored;
+  long as_well;
+} a_typedef;
+
+/* 
+ * however, typedefs of enums and just plain enums should end up being treated
+ * like a bunch of #defines...
+ */
+
+typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon,
+			     Tue, Wed, Thu, Fri, Sat } days_of_week;
+
+#endif /* _H2PH_H_ */
diff --git a/contrib/perl5/t/lib/h2ph.pht b/contrib/perl5/t/lib/h2ph.pht
new file mode 100644
index 0000000..80867a6
--- /dev/null
+++ b/contrib/perl5/t/lib/h2ph.pht
@@ -0,0 +1,69 @@
+unless(defined(&SQUARE)) {
+    sub SQUARE {
+	local($x) = @_;
+	eval q((($x)*($x)));
+    }
+}
+unless(defined(&ERROR)) {
+    eval 'sub ERROR {
+        local($x) = @_;
+	    eval q( &fprintf( &stderr, \\"%s\\\\n\\", $x->[2][3][0]));
+    }' unless defined(&ERROR);
+}
+unless(defined(&_H2PH_H_)) {
+    eval 'sub _H2PH_H_ () {1;}' unless defined(&_H2PH_H_);
+    # "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $"
+    undef(&MAX) if defined(&MAX);
+    eval 'sub MAX {
+        local($a,$b) = @_;
+	    eval q((($a) > ($b) ? ($a) : ($b)));
+    }' unless defined(&MAX);
+    if(defined(&__SOME_UNIMPORTANT_PROPERTY)) {
+	eval 'sub MIN {
+	    local($a,$b) = @_;
+    	    eval q((($a) < ($b) ? ($a) : ($b)));
+	}' unless defined(&MIN);
+    }
+    if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
+    }
+ elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
+	die("Nup, can't go on ");
+    } else {
+	eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
+    }
+    undef(&WHATEVER) if defined(&WHATEVER);
+    if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)  && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) {
+	eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER);
+    }
+ elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) {
+	eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER);
+    }
+ elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) {
+	eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER);
+    } else {
+	eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
+    }
+    require 'sys/socket.ph';
+    require 'sys/ioctl.ph';
+    eval {
+	my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
+	my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC);
+	require "$REM[0]" if @REM;
+    };
+    warn($@) if $@;
+    eval("sub sun () { 0; }") unless defined(&sun);
+    eval("sub mon () { 1; }") unless defined(&mon);
+    eval("sub tue () { 2; }") unless defined(&tue);
+    eval("sub wed () { 3; }") unless defined(&wed);
+    eval("sub thu () { 4; }") unless defined(&thu);
+    eval("sub fri () { 5; }") unless defined(&fri);
+    eval("sub sat () { 6; }") unless defined(&sat);
+    eval("sub Sun () { 0; }") unless defined(&Sun);
+    eval("sub Mon () { 1; }") unless defined(&Mon);
+    eval("sub Tue () { 2; }") unless defined(&Tue);
+    eval("sub Wed () { 3; }") unless defined(&Wed);
+    eval("sub Thu () { 4; }") unless defined(&Thu);
+    eval("sub Fri () { 5; }") unless defined(&Fri);
+    eval("sub Sat () { 6; }") unless defined(&Sat);
+}
+1;
diff --git a/contrib/perl5/t/lib/h2ph.t b/contrib/perl5/t/lib/h2ph.t
new file mode 100755
index 0000000..1fa7f63
--- /dev/null
+++ b/contrib/perl5/t/lib/h2ph.t
@@ -0,0 +1,34 @@
+#!./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';
+}
+
+print "1..2\n";
+
+# quickly compare two text files
+sub txt_compare {
+    local ($/, $A, $B);
+    for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ }
+    $A cmp $B;
+}
+
+unless(-e '../utils/h2ph') {
+    print("ok 1\nok 2\n");
+    # i'll probably get in trouble for this :)
+} else {
+    # does it run?
+    $ok = system("./perl -I../lib ../utils/h2ph -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");
+}
diff --git a/contrib/perl5/t/lib/hostname.t b/contrib/perl5/t/lib/hostname.t
new file mode 100755
index 0000000..e4ac365
--- /dev/null
+++ b/contrib/perl5/t/lib/hostname.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Sys::Hostname;
+
+eval {
+    $host = hostname;
+};
+
+if ($@) {
+    print "1..0\n" if $@ =~ /Cannot get host name/;
+} else {
+    print "1..1\n";
+    print "ok 1\n";
+}
diff --git a/contrib/perl5/t/lib/io_dup.t b/contrib/perl5/t/lib/io_dup.t
new file mode 100755
index 0000000..6b0caf1
--- /dev/null
+++ b/contrib/perl5/t/lib/io_dup.t
@@ -0,0 +1,61 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+use IO::File;
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..6\n";
+
+print "ok 1\n";
+
+$dupout = IO::Handle->new->fdopen( \*STDOUT ,"w");
+$duperr = IO::Handle->new->fdopen( \*STDERR ,"w");
+
+$stdout = \*STDOUT; bless $stdout, "IO::File"; # "IO::Handle";
+$stderr = \*STDERR; bless $stderr, "IO::Handle";
+
+$stdout->open( "Io.dup","w") || die "Can't open stdout";
+$stderr->fdopen($stdout,"w");
+
+print $stdout "ok 2\n";
+print $stderr "ok 3\n";
+if ($^O eq 'MSWin32') {
+    print `echo ok 4`;
+    print `echo ok 5 1>&2`; # does this *really* work?
+}
+else {
+    system 'echo ok 4';
+    system 'echo ok 5 1>&2';
+}
+
+$stderr->close;
+$stdout->close;
+
+$stdout->fdopen($dupout,"w");
+$stderr->fdopen($duperr,"w");
+
+if ($^O eq 'MSWin32') { print `type Io.dup` }
+else                  { system 'cat Io.dup' }
+unlink 'Io.dup';
+
+print STDOUT "ok 6\n";
diff --git a/contrib/perl5/t/lib/io_pipe.t b/contrib/perl5/t/lib/io_pipe.t
new file mode 100755
index 0000000..e617c92
--- /dev/null
+++ b/contrib/perl5/t/lib/io_pipe.t
@@ -0,0 +1,117 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if (! $Config{'d_fork'} ||
+	    ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'))
+	{
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+use IO::Pipe;
+
+my $perl = './perl';
+
+$| = 1;
+print "1..10\n";
+
+$pipe = new IO::Pipe->reader($perl, '-e', 'print "not ok 1\n"');
+while (<$pipe>) {
+  s/^not //;
+  print;
+}
+$pipe->close or print "# \$!=$!\nnot ";
+print "ok 2\n";
+
+$cmd = 'BEGIN{$SIG{ALRM} = sub {print "not ok 4\n"; exit}; alarm 10} s/not //';
+$pipe = new IO::Pipe->writer($perl, '-pe', $cmd);
+print $pipe "not ok 3\n" ;
+$pipe->close or print "# \$!=$!\nnot ";
+print "ok 4\n";
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 5..10;
+    exit 0;
+}
+
+$pipe = new IO::Pipe;
+
+$pid = fork();
+
+if($pid)
+ {
+  $pipe->writer;
+  print $pipe "Xk 5\n";
+  print $pipe "oY 6\n";
+  $pipe->close;
+  wait;
+ }
+elsif(defined $pid)
+ {
+  $pipe->reader;
+  $stdin = bless \*STDIN, "IO::Handle";
+  $stdin->fdopen($pipe,"r");
+  exec 'tr', 'YX', 'ko';
+ }
+else
+ {
+  die "# error = $!";
+ }
+
+$pipe = new IO::Pipe;
+$pid = fork();
+
+if($pid)
+ {
+  $pipe->reader;
+  while(<$pipe>) {
+      s/^not //;
+      print;
+  }
+  $pipe->close;
+  wait;
+ }
+elsif(defined $pid)
+ {
+  $pipe->writer;
+
+  $stdout = bless \*STDOUT, "IO::Handle";
+  $stdout->fdopen($pipe,"w");
+  print STDOUT "not ok 7\n";
+  exec 'echo', 'not ok 8';
+ }
+else
+ {
+  die;
+ }
+
+$pipe = new IO::Pipe;
+$pipe->writer;
+
+$SIG{'PIPE'} = 'broken_pipe';
+
+sub broken_pipe {
+    print "ok 9\n";
+}
+
+print $pipe "not ok 9\n";
+$pipe->close;
+
+sleep 1;
+
+print "ok 10\n";
+
diff --git a/contrib/perl5/t/lib/io_sel.t b/contrib/perl5/t/lib/io_sel.t
new file mode 100755
index 0000000..3dc651b
--- /dev/null
+++ b/contrib/perl5/t/lib/io_sel.t
@@ -0,0 +1,116 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        @INC = '../lib' if -d '../lib';
+    }
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..21\n";
+
+use IO::Select 1.09;
+
+my $sel = new IO::Select(\*STDIN);
+$sel->add(4, 5) == 2 or print "not ";
+print "ok 1\n";
+
+$sel->add([\*STDOUT, 'foo']) == 1 or print "not ";
+print "ok 2\n";
+
+@handles = $sel->handles;
+print "not " unless $sel->count == 4 && @handles == 4;
+print "ok 3\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(\*STDIN) == 1 or print "not ";
+print "ok 4\n",
+;
+$sel->remove(\*STDIN, 5, 6) == 1  # two of there are not present
+  or print "not ";
+print "ok 5\n";
+
+print "not " unless $sel->count == 2;
+print "ok 6\n";
+#print $sel->as_string, "\n";
+
+$sel->remove(1, 4);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 7\n";
+
+$sel = new IO::Select;
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 8\n";
+
+$sel->remove([\*STDOUT, 5]);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 9\n";
+
+if ($^O eq 'MSWin32' || $^O eq 'dos') {  # 4-arg select is only valid on sockets
+    print "# skipping tests 10..15\n";
+    for (10 .. 15) { print "ok $_\n" }
+    $sel->add(\*STDOUT);  # update
+    goto POST_SOCKET;
+}
+
+@a = $sel->can_read();  # should return imediately
+print "not " unless @a == 0;
+print "ok 10\n";
+
+# we assume that we can write to STDOUT :-)
+$sel->add([\*STDOUT, "ok 12\n"]);
+
+@a = $sel->can_write;
+print "not " unless @a == 1;
+print "ok 11\n";
+
+my($fd, $msg) = @{shift @a};
+print $fd $msg;
+
+$sel->add(\*STDOUT);  # update
+
+@a = IO::Select::select(undef, $sel, undef, 1);
+print "not " unless @a == 3;
+print "ok 13\n";
+
+($r, $w, $e) = @a;
+
+print "not " unless @$r == 0 && @$w == 1 && @$e == 0;
+print "ok 14\n";
+
+$fd = $w->[0];
+print $fd "ok 15\n";
+
+POST_SOCKET:
+# Test new exists() method
+$sel->exists(\*STDIN) and print "not ";
+print "ok 16\n";
+
+($sel->exists(0) || $sel->exists([\*STDERR])) and print "not ";
+print "ok 17\n";
+
+$fd = $sel->exists(\*STDOUT);
+if ($fd) {
+    print $fd "ok 18\n";
+} else {
+    print "not ok 18\n";
+}
+
+$fd = $sel->exists([1, 'foo']);
+if ($fd) {
+    print $fd "ok 19\n";
+} else {
+    print "not ok 19\n";
+}
+
+# Try self clearing
+$sel->add(5,6,7,8,9,10);
+print "not " unless $sel->count == 7;
+print "ok 20\n";
+
+$sel->remove($sel->handles);
+print "not " unless $sel->count == 0 && !defined($sel->bits);
+print "ok 21\n";
diff --git a/contrib/perl5/t/lib/io_sock.t b/contrib/perl5/t/lib/io_sock.t
new file mode 100755
index 0000000..8fc52e4
--- /dev/null
+++ b/contrib/perl5/t/lib/io_sock.t
@@ -0,0 +1,91 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if (-d "lib" && -f "TEST") {
+        if (!$Config{'d_fork'} ||
+	    (($Config{'extensions'} !~ /\bSocket\b/ ||
+	      $Config{'extensions'} !~ /\bIO\b/) &&
+	     !(($^O eq 'VMS') && $Config{d_socket}))) {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+$| = 1;
+print "1..5\n";
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+				Proto => 'tcp',
+			       ) or die "$!";
+
+print "ok 1\n";
+
+# Check if can fork with dynamic extensions (bug in CRT):
+if ($^O eq 'os2' and
+    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
+    print "ok $_ # skipped: broken fork\n" for 2..5;
+    exit 0;
+}
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept();
+    print "ok 2\n";
+
+    $sock->autoflush(1);
+    print $sock->getline();
+
+    print $sock "ok 4\n";
+
+    $sock->close;
+
+    waitpid($pid,0);
+
+    print "ok 5\n";
+
+} elsif(defined $pid) {
+
+    # This can fail if localhost is undefined or the
+    # special 'loopback' address 127.0.0.1 is not configured
+    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
+
+    $sock = IO::Socket::INET->new(PeerPort => $port,
+				  Proto => 'tcp',
+				  PeerAddr => 'localhost'
+				 )
+	    or die "$! (maybe your system does not have the 'localhost' address defined)";
+
+    $sock->autoflush(1);
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}
+
+
+
+
+
+
diff --git a/contrib/perl5/t/lib/io_taint.t b/contrib/perl5/t/lib/io_taint.t
new file mode 100755
index 0000000..0ef2cfd
--- /dev/null
+++ b/contrib/perl5/t/lib/io_taint.t
@@ -0,0 +1,48 @@
+#!./perl -T
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+END { unlink "./__taint__$$" }
+
+print "1..3\n";
+use IO::File;
+$x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+print $x "$$\n";
+$x->close;
+
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+chop($unsafe = <$x>);
+eval { kill 0 * $unsafe };
+print "not " if $^O ne 'MSWin32' and ($@ !~ /^Insecure/o);
+print "ok 1\n";
+$x->close;
+
+# We could have just done a seek on $x, but technically we haven't tested
+# seek yet...
+$x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
+$x->untaint;
+print "not " if ($?);
+print "ok 2\n"; # Calling the method worked
+chop($unsafe = <$x>);
+eval { kill 0 * $unsafe };
+print "not " if ($@ =~ /^Insecure/o);
+print "ok 3\n"; # No Insecure message from using the data
+$x->close;
+
+exit 0;
diff --git a/contrib/perl5/t/lib/io_tell.t b/contrib/perl5/t/lib/io_tell.t
new file mode 100755
index 0000000..2009d61
--- /dev/null
+++ b/contrib/perl5/t/lib/io_tell.t
@@ -0,0 +1,64 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+	$tell_file = "TEST";
+    }
+    else {
+	$tell_file = "Makefile";
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+print "1..13\n";
+
+use IO::File;
+
+$tst = IO::File->new("$tell_file","r") || die("Can't open $tell_file");
+binmode $tst if ($^O eq 'MSWin32' or $^O eq 'dos');
+if ($tst->eof) { print "not ok 1\n"; } else { print "ok 1\n"; }
+
+$firstline = <$tst>;
+$secondpos = tell;
+
+$x = 0;
+while (<$tst>) {
+    if (eof) {$x++;}
+}
+if ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+$lastpos = tell;
+
+unless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
+
+if ($tst->seek(0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
+
+if (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
+
+if ($firstline eq <$tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+if ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
+
+if ($tst->seek(0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+if ($tst->eof) { print "not ok 9\n"; } else { print "ok 9\n"; }
+
+if ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
+
+if ($tst->seek(0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
+
+if ($lastpos == $tst->tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
+
+unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
diff --git a/contrib/perl5/t/lib/io_udp.t b/contrib/perl5/t/lib/io_udp.t
new file mode 100755
index 0000000..014e12d
--- /dev/null
+++ b/contrib/perl5/t/lib/io_udp.t
@@ -0,0 +1,48 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
+              $Config{'extensions'} !~ /\bIO\b/	||
+	      $^O eq 'os2')    &&
+              !(($^O eq 'VMS') && $Config{d_socket})) {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+$| = 1;
+print "1..3\n";
+
+use Socket;
+use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
+
+    # This can fail if localhost is undefined or the
+    # special 'loopback' address 127.0.0.1 is not configured
+    # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
+
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
+
+print "ok 1\n";
+
+$udpa->send("ok 2\n",0,$udpb->sockname);
+$udpb->recv($buf="",5);
+print $buf;
+$udpb->send("ok 3\n");
+$udpa->recv($buf="",5);
+print $buf;
diff --git a/contrib/perl5/t/lib/io_xs.t b/contrib/perl5/t/lib/io_xs.t
new file mode 100755
index 0000000..1a6fd38
--- /dev/null
+++ b/contrib/perl5/t/lib/io_xs.t
@@ -0,0 +1,42 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	@INC = '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+use IO::File;
+use IO::Seekable;
+
+print "1..4\n";
+
+$x = new_tmpfile IO::File or print "not ";
+print "ok 1\n";
+print $x "ok 2\n";
+$x->seek(0,SEEK_SET);
+print <$x>;
+
+$x->seek(0,SEEK_SET);
+print $x "not ok 3\n";
+$p = $x->getpos;
+print $x "ok 3\n";
+$x->flush;
+$x->setpos($p);
+print scalar <$x>;
+
+$! = 0;
+$x->setpos(undef);
+print $! ? "ok 4 # $!\n" : "not ok 4\n";
diff --git a/contrib/perl5/t/lib/ipc_sysv.t b/contrib/perl5/t/lib/ipc_sysv.t
new file mode 100755
index 0000000..30ea48d
--- /dev/null
+++ b/contrib/perl5/t/lib/ipc_sysv.t
@@ -0,0 +1,178 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+
+    @INC = '../lib';
+
+    require Config; import Config;
+
+    unless ($Config{'d_msg'} eq 'define' &&
+	    $Config{'d_sem'} eq 'define') {
+	print "1..0\n";
+	exit;
+    }
+}
+
+# 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 S_IRWXG S_IRWXO);
+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);
+};
+
+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, S_IRWXU | S_IRWXG | S_IRWXO);
+    # 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";
+
+    msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
+    print "ok 2\n";
+
+    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;
+    msgrcv($msg,$msgbuf,256,0,IPC_NOWAIT) or print "not ";
+    print "ok 5\n";
+
+    my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
+
+    print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
+    print "ok 6\n";
+} else {
+    for (1..6) {
+	print "ok $_\n"; # fake it
+    }
+}
+
+if($Config{'d_semget'} eq 'define' &&
+   $Config{'d_semctl'} eq 'define') {
+
+    use IPC::SysV qw(IPC_CREAT GETALL SETALL);
+
+    $sem = semget(IPC_PRIVATE, 10, S_IRWXU | S_IRWXG | S_IRWXO | 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 $template;
+
+    # Find the pack/unpack template capable of handling native C shorts.
+
+    if      ($Config{shortsize} == 2) {
+	$template = "s";
+    } elsif ($Config{shortsize} == 4) {
+	$template = "l";
+    } elsif ($Config{shortsize} == 8) {
+	# Try quad last because not supported everywhere.
+	foreach my $t (qw(i q)) {
+	    # We could trap the unsupported quad template with eval
+	    # but if we get this far we should have quad support anyway.
+	    if (length(pack($t, 0)) == 8) {
+		$template = $t;
+		last;
+	    }
+	}
+    }
+
+    die "$0: cannot pack native shorts\n" unless defined $template;
+
+    $template .= "*";
+
+    my $nsem = 10;
+
+    semctl($sem,0,SETALL,pack($template,(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($template,(0) x $nsem));
+    print "ok 12\n";
+
+    my @data = unpack($template,$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($template,@data)) or print "not ";
+    print "ok 14\n";
+    
+    $data = "";
+    semctl($sem,0,GETALL,$data) or print "not ";
+    print "ok 15\n";
+
+    @data = unpack($template,$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 $_\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/contrib/perl5/t/lib/ndbm.t b/contrib/perl5/t/lib/ndbm.t
new file mode 100755
index 0000000..a97dbd1
--- /dev/null
+++ b/contrib/perl5/t/lib/ndbm.t
@@ -0,0 +1,207 @@
+#!./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'} !~ /\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..18\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*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+    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\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 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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use NDBM_File;
+   @ISA=qw(NDBM_File);
+   @EXPORT = @NDBM_File::EXPORT if defined @NDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ; ';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/contrib/perl5/t/lib/odbm.t b/contrib/perl5/t/lib/odbm.t
new file mode 100755
index 0000000..8ba9bcf
--- /dev/null
+++ b/contrib/perl5/t/lib/odbm.t
@@ -0,0 +1,207 @@
+#!./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'} !~ /\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..18\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*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32') {
+    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\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 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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+unlink 'Op.dbmx.dir', $Dfile;
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw(@ISA @EXPORT) ;
+
+   require Exporter ;
+   use ODBM_File;
+   @ISA=qw(ODBM_File);
+   @EXPORT = @ODBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash.tmp*> ;
+
+}
diff --git a/contrib/perl5/t/lib/opcode.t b/contrib/perl5/t/lib/opcode.t
new file mode 100755
index 0000000..a785fce
--- /dev/null
+++ b/contrib/perl5/t/lib/opcode.t
@@ -0,0 +1,115 @@
+#!./perl -w
+
+$|=1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+use Opcode qw(
+	opcodes opdesc opmask verify_opset
+	opset opset_to_ops opset_to_hex invert_opset
+	opmask_add full_opset empty_opset define_optag
+);
+
+use strict;
+
+my $t = 1;
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my($s1, $s2, $s3);
+my(@o1, @o2, @o3);
+
+# --- opset_to_ops and opset
+
+my @empty_l = opset_to_ops(empty_opset);
+print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+
+my @full_l1  = opset_to_ops(full_opset);
+print @full_l1 == opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
+my @full_l2 = @full_l1;	# = opcodes();	# XXX to be fixed
+print "@full_l1" eq "@full_l2" ? "ok $t\n" : "not ok $t\n"; $t++;
+
+@empty_l = opset_to_ops(opset(':none'));
+print @empty_l == 0 ?   "ok $t\n" : "not ok $t\n"; $t++;
+
+my @full_l3 = opset_to_ops(opset(':all'));
+print  @full_l1  ==  @full_l3  ? "ok $t\n" : "not ok $t\n"; $t++;
+print "@full_l1" eq "@full_l3" ? "ok $t\n" : "not ok $t\n"; $t++;
+
+die $t unless $t == 7;
+$s1 = opset(      'padsv');
+$s2 = opset($s1,  'padav');
+$s3 = opset($s2, '!padav');
+print $s1 eq $s2 ? "not ok $t\n" : "ok $t\n"; ++$t;
+print $s1 eq $s3 ? "ok $t\n" : "not ok $t\n"; ++$t;
+
+# --- define_optag
+
+print eval { opset(':_tst_') } ? "not ok $t\n" : "ok $t\n"; ++$t;
+define_optag(":_tst_", opset(qw(padsv padav padhv)));
+print eval { opset(':_tst_') } ? "ok $t\n" : "not ok $t\n"; ++$t;
+
+# --- opdesc and opcodes
+
+die $t unless $t == 11;
+print opdesc("gv") eq "glob value" ? "ok $t\n" : "not ok $t\n"; $t++;
+my @desc = opdesc(':_tst_','stub');
+print "@desc" eq "private variable private array private hash stub"
+				    ? "ok $t\n" : "not ok $t\n#@desc\n"; $t++;
+print opcodes() ? "ok $t\n" : "not ok $t\n"; $t++;
+print "ok $t\n"; ++$t;
+
+# --- invert_opset
+
+$s1 = opset(qw(fileno padsv padav));
+@o2 = opset_to_ops(invert_opset($s1));
+print @o2 == opcodes-3 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+# --- opmask
+
+die $t unless $t == 16;
+print opmask() eq empty_opset() ? "ok $t\n" : "not ok $t\n"; $t++;	# work
+print length opmask() == int((opcodes()+7)/8) ? "ok $t\n" : "not ok $t\n"; $t++;
+
+# --- verify_opset
+
+print verify_opset($s1) && !verify_opset(42) ? "ok $t\n":"not ok $t\n"; $t++;
+
+# --- opmask_add
+
+opmask_add(opset(qw(fileno)));	# add to global op_mask
+print eval 'fileno STDOUT' ? "not ok $t\n" : "ok $t\n";	$t++; # fail
+print $@ =~ /fileno trapped/ ? "ok $t\n" : "not ok $t\n# $@\n"; $t++;
+
+# --- check use of bit vector ops on opsets
+
+$s1 = opset('padsv');
+$s2 = opset('padav');
+$s3 = opset('padsv', 'padav', 'padhv');
+
+# Non-negated
+print (($s1 | $s2) eq opset($s1,$s2) ? "ok $t\n":"not ok $t\n"); $t++;
+print (($s2 & $s3) eq opset($s2)     ? "ok $t\n":"not ok $t\n"); $t++;
+print (($s2 ^ $s3) eq opset('padsv','padhv') ? "ok $t\n":"not ok $t\n"); $t++;
+
+# Negated, e.g., with possible extra bits in last byte beyond last op bit.
+# The extra bits mean we can't just say ~mask eq invert_opset(mask).
+
+@o1 = opset_to_ops(           ~ $s3);
+@o2 = opset_to_ops(invert_opset $s3);
+print "@o1" eq "@o2" ? "ok $t\n":"not ok $t\n"; $t++;
+
+# --- finally, check some opname assertions
+
+foreach(@full_l1) { die "bad opname: $_" if /\W/ or /^\d/ }
+
+print "ok $last_test\n";
+BEGIN { $last_test = 25 }
diff --git a/contrib/perl5/t/lib/open2.t b/contrib/perl5/t/lib/open2.t
new file mode 100755
index 0000000..85b807c
--- /dev/null
+++ b/contrib/perl5/t/lib/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' || $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') {
+		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/contrib/perl5/t/lib/open3.t b/contrib/perl5/t/lib/open3.t
new file mode 100755
index 0000000..b84dac9
--- /dev/null
+++ b/contrib/perl5/t/lib/open3.t
@@ -0,0 +1,136 @@
+#!./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' || $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 = './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') {
+		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..21\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;
diff --git a/contrib/perl5/t/lib/ops.t b/contrib/perl5/t/lib/ops.t
new file mode 100755
index 0000000..56b1bac
--- /dev/null
+++ b/contrib/perl5/t/lib/ops.t
@@ -0,0 +1,29 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+print "1..2\n";
+
+eval <<'EOP';
+	no ops 'fileno';	# equiv to "perl -M-ops=fileno"
+	$a = fileno STDIN;
+EOP
+
+print $@ =~ /trapped/ ? "ok 1\n" : "not ok 1\n# $@\n";
+
+eval <<'EOP';
+	use ops ':default';	# equiv to "perl -M(as above) -Mops=:default"
+	eval 1;
+EOP
+
+print $@ =~ /trapped/ ? "ok 2\n" : "not ok 2\n# $@\n";
+
+1;
diff --git a/contrib/perl5/t/lib/parsewords.t b/contrib/perl5/t/lib/parsewords.t
new file mode 100755
index 0000000..9079179
--- /dev/null
+++ b/contrib/perl5/t/lib/parsewords.t
@@ -0,0 +1,103 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Text::ParseWords;
+
+print "1..17\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
+local($^W) = 0;
+
+# 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";
+
+$^W = 1;
+
+# 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
+$^W = 0;
+
+@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";
+
+$^W = 1;
+
+# 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";
diff --git a/contrib/perl5/t/lib/ph.t b/contrib/perl5/t/lib/ph.t
new file mode 100755
index 0000000..de27dee
--- /dev/null
+++ b/contrib/perl5/t/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/contrib/perl5/t/lib/posix.t b/contrib/perl5/t/lib/posix.t
new file mode 100755
index 0000000..8dafc80
--- /dev/null
+++ b/contrib/perl5/t/lib/posix.t
@@ -0,0 +1,101 @@
+#!./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 strftime write);
+use strict subs;
+
+$| = 1;
+print "1..18\n";
+
+$Is_W32 = $^O eq 'MSWin32';
+
+$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;
+
+if ($Is_W32) {
+    for (6..11) {
+	print "ok $_ # skipped, no sigaction support on win32\n";
+    }
+}
+else {
+$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";
+
+# Check string conversion functions.
+
+if ($Config{d_strtod}) {
+    $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC, 'C') if $Config{d_setlocale};
+    ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
+    print (($n == 3.14159) && ($x == 6) ? "ok 14\n" : "not ok 14\n");
+    &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if $Config{d_setlocale};
+} else { print "# strtod not present\n", "ok 14\n"; }
+
+if ($Config{d_strtol}) {
+    ($n, $x) = &POSIX::strtol('21_PENGUINS');
+    print (($n == 21) && ($x == 9) ? "ok 15\n" : "not ok 15\n");
+} else { print "# strtol not present\n", "ok 15\n"; }
+
+if ($Config{d_strtoul}) {
+    ($n, $x) = &POSIX::strtoul('88_TEARS');
+    print (($n == 88) && ($x == 6) ? "ok 16\n" : "not ok 16\n");
+} else { print "# strtoul not present\n", "ok 16\n"; }
+
+# Pick up whether we're really able to dynamically load everything.
+print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
+
+# This can coredump if struct tm has a timezone field and we
+# didn't detect it.  If this fails, try adding
+# -DSTRUCT_TM_HASZONE to your cflags when compiling ext/POSIX/POSIX.c.
+# See ext/POSIX/hints/sunos_4.pl and ext/POSIX/hints/linux.pl 
+print POSIX::strftime("ok 18 # %H:%M, on %D\n", localtime());
+
+$| = 0;
+# The following line assumes buffered output, which may be not true with EMX:
+print '@#!*$@(!@#$' unless $^O eq 'os2';
+_exit(0);
diff --git a/contrib/perl5/t/lib/safe1.t b/contrib/perl5/t/lib/safe1.t
new file mode 100755
index 0000000..27993d9
--- /dev/null
+++ b/contrib/perl5/t/lib/safe1.t
@@ -0,0 +1,68 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+# Tests Todo:
+#	'main' as root
+
+package test;	# test from somewhere other than main
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+	opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my $t = 1;
+my $cpt;
+# create and destroy some automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root" or die;
+
+foreach(1..3) {
+	$foo = 42;
+
+	$cpt->share(qw($foo));
+
+	print ${$cpt->varglob('foo')}       == 42 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+	${$cpt->varglob('foo')} = 9;
+
+	print $foo == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+
+	print $cpt->reval('$foo')       == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	# check 'main' has been changed:
+	print $cpt->reval('$::foo')     == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	print $cpt->reval('$main::foo') == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	# check we can't see our test package:
+	print $cpt->reval('$test::foo')     	? "not ok $t\n" : "ok $t\n"; $t++;
+	print $cpt->reval('${"test::foo"}')		? "not ok $t\n" : "ok $t\n"; $t++;
+
+	$cpt->erase;	# erase the compartment, e.g., delete all variables
+
+	print $cpt->reval('$foo') ? "not ok $t\n" : "ok $t\n"; $t++;
+
+	# Note that we *must* use $cpt->varglob here because if we used
+	# $Root::foo etc we would still see the original values!
+	# This seems to be because the compiler has created an extra ref.
+
+	print ${$cpt->varglob('foo')} ? "not ok $t\n" : "ok $t\n"; $t++;
+}
+
+print "ok $last_test\n";
+BEGIN { $last_test = 28 }
diff --git a/contrib/perl5/t/lib/safe2.t b/contrib/perl5/t/lib/safe2.t
new file mode 100755
index 0000000..c9e3880
--- /dev/null
+++ b/contrib/perl5/t/lib/safe2.t
@@ -0,0 +1,146 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+  # test 30 rather naughtily expects English error messages
+  $ENV{'LC_ALL'} = 'C';
+}
+
+# Tests Todo:
+#	'main' as root
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+	opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+$bar = "invisible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+
+my $cpt;
+# create and destroy a couple of automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root";
+
+$cpt->reval(q{ system("echo not ok 1"); });
+if ($@ =~ /^system trapped by operation mask/) {
+    print "ok 1\n";
+} else {
+    print "#$@" if $@;
+    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 = (); push(@baz, "o", "10"); $" = 'k ';
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+sub sayok { print "ok @_\n" }
+
+$cpt->share(qw($foo %bar @baz *glob sayok));
+$cpt->share('$"') unless $Config{archname} =~ /-thread$/;
+
+$cpt->reval(q{
+    package other;
+    sub other_sayok { print "ok @_\n" }
+    package main;
+    print $foo ? $foo : "not ok 8\n";
+    print $bar{key} ? $bar{key} : "not ok 9\n";
+    (@baz) ? print "@baz\n" : print "not ok 10\n";
+    print $glob;
+    other::other_sayok(12);
+    $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";
+
+use strict;
+
+print 1 ? "ok 19\n" : "not ok 19\n";
+print 1 ? "ok 20\n" : "not ok 20\n";
+
+my $m1 = $cpt->mask;
+$cpt->trap("negate");
+my $m2 = $cpt->mask;
+my @masked = opset_to_ops($m1);
+print $m2 eq opset("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+
+print eval { $cpt->mask("a bad mask") } ? "not ok 22\n" : "ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
+
+$cpt->mask(empty_opset);
+my $t_scalar = $cpt->reval('print wantarray ? "not ok 24\n" : "ok 24\n"');
+print $cpt->reval('@ary=(6,7,8);@ary') == 3 ? "ok 25\n" : "not ok 25\n";
+my @t_array  = $cpt->reval('print wantarray ? "ok 26\n" : "not ok 26\n"; (2,3,4)');
+print $t_array[2] == 4 ? "ok 27\n" : "not ok 27\n";
+
+my $t_scalar2 = $cpt->reval('die "foo bar"; 1');
+print defined $t_scalar2 ? "not ok 28\n" : "ok 28\n";
+print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
+
+# --- rdo
+  
+my $t = 30;
+$cpt->rdo('/non/existant/file.name');
+print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) ||
+      $! =~ /A file or directory in the path name does not exist/ ||
+      $! =~ /Invalid argument/ ||
+      $! =~ /Device not configured/ ?
+      "ok $t\n" : "not ok $t # $!\n"); $t++;
+print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
+  
+#my $rdo_file = "tmp_rdo.tpl";
+#if (open X,">$rdo_file") {
+#    print X "999\n";
+#    close X;
+#    $cpt->permit_only('const', 'leaveeval');
+#    print  $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++;
+#    unlink $rdo_file;
+#}
+#else {
+#    print "# test $t skipped, can't open file: $!\nok $t\n"; $t++;
+#}
+
+
+print "ok $last_test\n";
+BEGIN { $last_test = 32 }
diff --git a/contrib/perl5/t/lib/sdbm.t b/contrib/perl5/t/lib/sdbm.t
new file mode 100755
index 0000000..591fe14
--- /dev/null
+++ b/contrib/perl5/t/lib/sdbm.t
@@ -0,0 +1,212 @@
+#!./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'} !~ /\bSDBM_File\b/) && ($^O ne 'VMS')){
+	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..18\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.*>;
+}
+if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos') {
+    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\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 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");
+print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
+
+untie %h;
+if ($^O eq 'VMS') {
+  unlink 'Op_dbmx.sdbm_dir', $Dfile;
+} else {
+  unlink 'Op_dbmx.dir', $Dfile;
+}
+
+
+sub ok
+{
+    my $no = shift ;
+    my $result = shift ;
+
+    print "not " unless $result ;
+    print "ok $no\n" ;
+}
+
+{
+   # sub-class test
+
+   package Another ;
+
+   use strict ;
+
+   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
+   print FILE <<'EOM' ;
+
+   package SubDB ;
+
+   use strict ;
+   use vars qw( @ISA @EXPORT) ;
+
+   require Exporter ;
+   use SDBM_File;
+   @ISA=qw(SDBM_File);
+   @EXPORT = @SDBM_File::EXPORT if defined @SDBM_File::EXPORT ;
+
+   sub STORE { 
+	my $self = shift ;
+        my $key = shift ;
+        my $value = shift ;
+        $self->SUPER::STORE($key, $value * 2) ;
+   }
+
+   sub FETCH { 
+	my $self = shift ;
+        my $key = shift ;
+        $self->SUPER::FETCH($key) - 1 ;
+   }
+
+   sub A_new_method
+   {
+	my $self = shift ;
+        my $key = shift ;
+        my $value = $self->FETCH($key) ;
+	return "[[$value]]" ;
+   }
+
+   1 ;
+EOM
+
+    close FILE ;
+
+    BEGIN { push @INC, '.'; }
+
+    eval 'use SubDB ; use Fcntl ;';
+    main::ok(13, $@ eq "") ;
+    my %h ;
+    my $X ;
+    eval '
+	$X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 );
+	' ;
+
+    main::ok(14, $@ eq "") ;
+
+    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
+    main::ok(15, $@ eq "") ;
+    main::ok(16, $ret == 5) ;
+
+    $ret = eval '$X->A_new_method("fred") ' ;
+    main::ok(17, $@ eq "") ;
+    main::ok(18, $ret eq "[[5]]") ;
+
+    undef $X;
+    untie(%h);
+    unlink "SubDB.pm", <dbhash_tmp.*> ;
+
+}
diff --git a/contrib/perl5/t/lib/searchdict.t b/contrib/perl5/t/lib/searchdict.t
new file mode 100755
index 0000000..447c425
--- /dev/null
+++ b/contrib/perl5/t/lib/searchdict.t
@@ -0,0 +1,65 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\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, "abash";
+chomp($word = <DICT>);
+print "not " if $pos < 0 || $word ne "abash";
+print "ok 1\n";
+
+$pos = look *DICT, "foo";
+chomp($word = <DICT>);
+
+print "not " if $pos != length($DICT);  # will search to end of file
+print "ok 2\n";
+
+$pos = look *DICT, "aarhus", 1, 1;
+chomp($word = <DICT>);
+
+print "not " if $pos < 0 || $word ne "Aarhus";
+print "ok 3\n";
+
+close DICT or die "cannot close";
+unlink "dict-$$";
diff --git a/contrib/perl5/t/lib/selectsaver.t b/contrib/perl5/t/lib/selectsaver.t
new file mode 100755
index 0000000..3b58d70
--- /dev/null
+++ b/contrib/perl5/t/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/contrib/perl5/t/lib/socket.t b/contrib/perl5/t/lib/socket.t
new file mode 100755
index 0000000..4e38295
--- /dev/null
+++ b/contrib/perl5/t/lib/socket.t
@@ -0,0 +1,76 @@
+#!./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_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!
+	while ($read > 0 && length($buff) < 5) {
+	    # adjust for fact that TCP doesn't guarantee size of reads/writes
+	    $read = sysread(T,$buff,10,length($buff));
+	}
+	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!
+	while ($read > 0 && length($buff) < 5) {
+	    # adjust for fact that TCP doesn't guarantee size of reads/writes
+	    $read = sysread(S,$buff,10,length($buff));
+	}
+	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/contrib/perl5/t/lib/soundex.t b/contrib/perl5/t/lib/soundex.t
new file mode 100755
index 0000000..d35f264
--- /dev/null
+++ b/contrib/perl5/t/lib/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/contrib/perl5/t/lib/symbol.t b/contrib/perl5/t/lib/symbol.t
new file mode 100755
index 0000000..03449a3
--- /dev/null
+++ b/contrib/perl5/t/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/contrib/perl5/t/lib/texttabs.t b/contrib/perl5/t/lib/texttabs.t
new file mode 100755
index 0000000..ea9012c
--- /dev/null
+++ b/contrib/perl5/t/lib/texttabs.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+use Text::Tabs;
+
+$tabstop = 4;
+
+$s1 = "foo\tbar\tb\tb";
+$s2 = expand $s1;
+$s3 = unexpand $s2;
+
+print "not " unless $s2 eq "foo bar b   b";
+print "ok 1\n";
+
+print "not " unless $s3 eq "foo bar b\tb";
+print "ok 2\n";
+
+
+$tabstop = 8;
+
+print "not " unless unexpand("                    foo") eq "\t\t    foo";
+print "ok 3\n";
diff --git a/contrib/perl5/t/lib/textwrap.t b/contrib/perl5/t/lib/textwrap.t
new file mode 100755
index 0000000..9c8d1b4
--- /dev/null
+++ b/contrib/perl5/t/lib/textwrap.t
@@ -0,0 +1,40 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..5\n";
+
+use Text::Wrap qw(wrap $columns);
+
+$columns = 30;
+
+$text = <<'EOT';
+Text::Wrap is a very simple paragraph formatter.  It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line ($initial_tab) and
+all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
+should be set to the full width of your output device.
+EOT
+
+$text =~ s/\n/ /g;
+$_ = wrap "|  ", "|", $text;
+
+#print "$_\n";
+
+print "not " unless /^\|  Text::Wrap is/;  # start is ok
+print "ok 1\n";
+
+print "not " if /^.{31,}$/m;  # no line longer than 30 chars
+print "ok 2\n";
+
+print "not " unless /^\|\w/m;  # other lines start with 
+print "ok 3\n";
+
+print "not " unless /\bsubsquent\b/; # look for a random word
+print "ok 4\n";
+
+print "not " unless /\bdevice\./;  # look for last word
+print "ok 5\n";
diff --git a/contrib/perl5/t/lib/thread.t b/contrib/perl5/t/lib/thread.t
new file mode 100755
index 0000000..83407a9
--- /dev/null
+++ b/contrib/perl5/t/lib/thread.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if (! $Config{'usethreads'}) {
+	print "1..0\n";
+	exit 0;
+    }
+
+    # XXX known trouble with global destruction
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+$| = 1;
+print "1..14\n";
+use Thread;
+print "ok 1\n";
+
+sub content
+{
+ print shift;
+ return shift;
+}
+
+# create a thread passing args and immedaietly wait for it.
+my $t = new Thread \&content,("ok 2\n","ok 3\n");
+print $t->join;
+
+# check that lock works ...
+{lock $foo;
+ $t = new Thread sub { lock $foo; print "ok 5\n" };
+ print "ok 4\n";
+}
+$t->join;
+
+sub dorecurse
+{
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&dorecurse, @_);
+   $ret->join;
+  }
+}
+
+$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
+$t->join;
+
+# test that sleep lets other thread run
+$t = new Thread \&dorecurse,"ok 11\n";
+sleep 6;
+print "ok 12\n";
+$t->join;
+
+sub islocked
+{
+ use attrs 'locked';
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&islocked, shift);
+  }
+ $ret;
+}
+
+$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
+$t->join->join;
+
diff --git a/contrib/perl5/t/lib/tie-push.t b/contrib/perl5/t/lib/tie-push.t
new file mode 100755
index 0000000..dd718de
--- /dev/null
+++ b/contrib/perl5/t/lib/tie-push.t
@@ -0,0 +1,24 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @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 "../t/op/push.t"
diff --git a/contrib/perl5/t/lib/tie-stdarray.t b/contrib/perl5/t/lib/tie-stdarray.t
new file mode 100755
index 0000000..7ca4d76
--- /dev/null
+++ b/contrib/perl5/t/lib/tie-stdarray.t
@@ -0,0 +1,12 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @foo,Tie::StdArray;
+tie @ary,Tie::StdArray;
+tie @bar,Tie::StdArray;
+require "../t/op/array.t"
diff --git a/contrib/perl5/t/lib/tie-stdpush.t b/contrib/perl5/t/lib/tie-stdpush.t
new file mode 100755
index 0000000..34a6947
--- /dev/null
+++ b/contrib/perl5/t/lib/tie-stdpush.t
@@ -0,0 +1,10 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Tie::Array;
+tie @x,Tie::StdArray;
+require "../t/op/push.t"
diff --git a/contrib/perl5/t/lib/timelocal.t b/contrib/perl5/t/lib/timelocal.t
new file mode 100755
index 0000000..100e076
--- /dev/null
+++ b/contrib/perl5/t/lib/timelocal.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/contrib/perl5/t/lib/trig.t b/contrib/perl5/t/lib/trig.t
new file mode 100755
index 0000000..3114176
--- /dev/null
+++ b/contrib/perl5/t/lib/trig.t
@@ -0,0 +1,160 @@
+#!./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 ($$;$) {
+    abs($_[0] - $_[1]) < (defined $_[2] ? $_[2] : $eps);
+}
+
+print "1..20\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";
+}
+
+# eof
diff --git a/contrib/perl5/t/op/append.t b/contrib/perl5/t/op/append.t
new file mode 100755
index 0000000..d115146
--- /dev/null
+++ b/contrib/perl5/t/op/append.t
@@ -0,0 +1,21 @@
+#!./perl
+
+# $RCSfile: append.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:36 $
+
+print "1..3\n";
+
+$a = 'ab' . 'c';	# compile time
+$b = 'def';
+
+$c = $a . $b;
+print "#1\t:$c: eq :abcdef:\n";
+if ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$c .= 'xyz';
+print "#2\t:$c: eq :abcdefxyz:\n";
+if ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = $a;
+$_ .= $b;
+print "#3\t:$_: eq :abcdef:\n";
+if ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/contrib/perl5/t/op/arith.t b/contrib/perl5/t/op/arith.t
new file mode 100755
index 0000000..43af807
--- /dev/null
+++ b/contrib/perl5/t/op/arith.t
@@ -0,0 +1,12 @@
+#!./perl
+
+print "1..4\n";
+
+sub try ($$) {
+   print +($_[1] ? "ok" : "not ok"), " $_[0]\n";
+}
+
+try 1,  13 %  4 ==  1;
+try 2, -13 %  4 ==  3;
+try 3,  13 % -4 == -3;
+try 4, -13 % -4 == -1;
diff --git a/contrib/perl5/t/op/array.t b/contrib/perl5/t/op/array.t
new file mode 100755
index 0000000..8dea44d
--- /dev/null
+++ b/contrib/perl5/t/op/array.t
@@ -0,0 +1,208 @@
+#!./perl
+
+print "1..63\n";
+
+#
+# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
+#
+
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 2\n";} else {print "not ok 2\n";}
+if ($#ary == 3) {print "ok 3\n";} else {print "not ok 3\n";}
+if (join('',@ary) eq '1234') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$[ = 1;
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 5\n";} else {print "not ok 5\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 6\n";} else {print "not ok 6\n";}
+if ($#ary == 4) {print "ok 7\n";} else {print "not ok 7\n";}
+if (join('',@ary) eq '1234') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if ($ary[5] eq '') {print "ok 9\n";} else {print "not ok 9\n";}
+
+$#ary += 1;	# see if element 5 gone for good
+if ($#ary == 5) {print "ok 10\n";} else {print "not ok 10\n";}
+if (defined $ary[5]) {print "not ok 11\n";} else {print "ok 11\n";}
+
+$[ = 0;
+@foo = ();
+$r = join(',', $#foo, @foo);
+if ($r eq "-1") {print "ok 12\n";} else {print "not ok 12 $r\n";}
+$foo[0] = '0';
+$r = join(',', $#foo, @foo);
+if ($r eq "0,0") {print "ok 13\n";} else {print "not ok 13 $r\n";}
+$foo[2] = '2';
+$r = join(',', $#foo, @foo);
+if ($r eq "2,0,,2") {print "ok 14\n";} else {print "not ok 14 $r\n";}
+@bar = ();
+$bar[0] = '0';
+$bar[1] = '1';
+$r = join(',', $#bar, @bar);
+if ($r eq "1,0,1") {print "ok 15\n";} else {print "not ok 15 $r\n";}
+@bar = ();
+$r = join(',', $#bar, @bar);
+if ($r eq "-1") {print "ok 16\n";} else {print "not ok 16 $r\n";}
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 17\n";} else {print "not ok 17 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 18\n";} else {print "not ok 18 $r\n";}
+reset 'b';
+@bar = ();
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 19\n";} else {print "not ok 19 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 20\n";} else {print "not ok 20 $r\n";}
+
+$foo = 'now is the time';
+if (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)) {
+    if ($F1 eq 'now' && $F2 eq 'is' && $Etc eq 'the time') {
+	print "ok 21\n";
+    }
+    else {
+	print "not ok 21\n";
+    }
+}
+else {
+    print "not ok 21\n";
+}
+
+$foo = 'lskjdf';
+if ($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))) {
+    print "not ok 22 $cnt $F1:$F2:$Etc\n";
+}
+else {
+    print "ok 22\n";
+}
+
+%foo = ('blurfl','dyick','foo','bar','etc.','etc.');
+%bar = %foo;
+print $bar{'foo'} eq 'bar' ? "ok 23\n" : "not ok 23\n";
+%bar = ();
+print $bar{'foo'} eq '' ? "ok 24\n" : "not ok 24\n";
+(%bar,$a,$b) = (%foo,'how','now');
+print $bar{'foo'} eq 'bar' ? "ok 25\n" : "not ok 25\n";
+print $bar{'how'} eq 'now' ? "ok 26\n" : "not ok 26\n";
+@bar{keys %foo} = values %foo;
+print $bar{'foo'} eq 'bar' ? "ok 27\n" : "not ok 27\n";
+print $bar{'how'} eq 'now' ? "ok 28\n" : "not ok 28\n";
+
+@foo = grep(/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'the time men come' ? "ok 29\n" : "not ok 29\n";
+
+@foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'now is for all good to to' ? "ok 30\n" : "not ok 30\n";
+
+$foo = join('',('a','b','c','d','e','f')[0..5]);
+print $foo eq 'abcdef' ? "ok 31\n" : "not ok 31\n";
+
+$foo = join('',('a','b','c','d','e','f')[0..1]);
+print $foo eq 'ab' ? "ok 32\n" : "not ok 32\n";
+
+$foo = join('',('a','b','c','d','e','f')[6]);
+print $foo eq '' ? "ok 33\n" : "not ok 33\n";
+
+@foo = ('a','b','c','d','e','f')[0,2,4];
+@bar = ('a','b','c','d','e','f')[1,3,5];
+$foo = join('',(@foo,@bar)[0..5]);
+print $foo eq 'acebdf' ? "ok 34\n" : "not ok 34\n";
+
+$foo = ('a','b','c','d','e','f')[0,2,4];
+print $foo eq 'e' ? "ok 35\n" : "not ok 35\n";
+
+$foo = ('a','b','c','d','e','f')[1];
+print $foo eq 'b' ? "ok 36\n" : "not ok 36\n";
+
+@foo = ( 'foo', 'bar', 'burbl');
+push(foo, 'blah');
+print $#foo == 3 ? "ok 37\n" : "not ok 37\n";
+
+# various AASSIGN_COMMON checks (see newASSIGNOP() in op.c)
+
+$test = 37;
+sub t { ++$test; print "not " unless $_[0]; print "ok $test\n"; }
+
+@foo = @foo;
+t("@foo" eq "foo bar burbl blah");				# 38
+
+(undef,@foo) = @foo;
+t("@foo" eq "bar burbl blah");					# 39
+
+@foo = ('XXX',@foo, 'YYY');
+t("@foo" eq "XXX bar burbl blah YYY");				# 40
+
+@foo = @foo = qw(foo bar burbl blah);
+t("@foo" eq "foo bar burbl blah");				# 41
+
+@bar = @foo = qw(foo bar);					# 42
+t("@foo" eq "foo bar");
+t("@bar" eq "foo bar");						# 43
+
+# try the same with local
+# XXX tie-stdarray fails the tests involving local, so we use
+# different variable names to escape the 'tie'
+
+@bee = ( 'foo', 'bar', 'burbl', 'blah');
+{
+
+    local @bee = @bee;
+    t("@bee" eq "foo bar burbl blah");				# 44
+    {
+	local (undef,@bee) = @bee;
+	t("@bee" eq "bar burbl blah");				# 45
+	{
+	    local @bee = ('XXX',@bee,'YYY');
+	    t("@bee" eq "XXX bar burbl blah YYY");		# 46
+	    {
+		local @bee = local(@bee) = qw(foo bar burbl blah);
+		t("@bee" eq "foo bar burbl blah");		# 47
+		{
+		    local (@bim) = local(@bee) = qw(foo bar);
+		    t("@bee" eq "foo bar");			# 48
+		    t("@bim" eq "foo bar");			# 49
+		}
+		t("@bee" eq "foo bar burbl blah");		# 50
+	    }
+	    t("@bee" eq "XXX bar burbl blah YYY");		# 51
+	}
+	t("@bee" eq "bar burbl blah");				# 52
+    }
+    t("@bee" eq "foo bar burbl blah");				# 53
+}
+
+# try the same with my
+{
+
+    my @bee = @bee;
+    t("@bee" eq "foo bar burbl blah");				# 54
+    {
+	my (undef,@bee) = @bee;
+	t("@bee" eq "bar burbl blah");				# 55
+	{
+	    my @bee = ('XXX',@bee,'YYY');
+	    t("@bee" eq "XXX bar burbl blah YYY");		# 56
+	    {
+		my @bee = my @bee = qw(foo bar burbl blah);
+		t("@bee" eq "foo bar burbl blah");		# 57
+		{
+		    my (@bim) = my(@bee) = qw(foo bar);
+		    t("@bee" eq "foo bar");			# 58
+		    t("@bim" eq "foo bar");			# 59
+		}
+		t("@bee" eq "foo bar burbl blah");		# 60
+	    }
+	    t("@bee" eq "XXX bar burbl blah YYY");		# 61
+	}
+	t("@bee" eq "bar burbl blah");				# 62
+    }
+    t("@bee" eq "foo bar burbl blah");				# 63
+}
+
diff --git a/contrib/perl5/t/op/assignwarn.t b/contrib/perl5/t/op/assignwarn.t
new file mode 100755
index 0000000..57e89c4
--- /dev/null
+++ b/contrib/perl5/t/op/assignwarn.t
@@ -0,0 +1,61 @@
+#!./perl
+
+#
+# Verify which OP= operators warn if their targets are undefined.
+# Based on redef.t, contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+$^W = 1;
+my $warn = "";
+$SIG{q(__WARN__)} = sub { print $warn; $warn .= join("",@_) };
+
+sub ok { print $_[1] ? "ok " : "not ok ", $_[0], "\n"; }
+
+sub uninitialized { $warn =~ s/Use of uninitialized value[^\n]+\n//s; }
+    
+print "1..23\n";
+
+{ my $x; $x ++;     ok  1, ! uninitialized; }
+{ my $x; $x --;     ok  2, ! uninitialized; }
+{ my $x; ++ $x;     ok  3, ! uninitialized; }
+{ my $x; -- $x;	    ok  4, ! uninitialized; }
+
+{ my $x; $x **= 1;  ok  5,  uninitialized; }
+
+{ my $x; $x += 1;   ok  6, ! uninitialized; }
+{ my $x; $x -= 1;   ok  7, ! uninitialized; }
+
+{ my $x; $x .= 1;   ok  8, ! uninitialized; }
+
+{ my $x; $x *= 1;   ok  9,  uninitialized; }
+{ my $x; $x /= 1;   ok 10,  uninitialized; }
+{ my $x; $x %= 1;   ok 11,  uninitialized; }
+
+{ my $x; $x x= 1;   ok 12,  uninitialized; }
+
+{ my $x; $x &= 1;   ok 13,  uninitialized; }
+{ my $x; $x |= 1;   ok 14, ! uninitialized; }
+{ my $x; $x ^= 1;   ok 15, ! uninitialized; }
+
+{ my $x; $x &&= 1;  ok 16, ! uninitialized; }
+{ my $x; $x ||= 1;  ok 17, ! uninitialized; }
+
+{ my $x; $x <<= 1;  ok 18,  uninitialized; }
+{ my $x; $x >>= 1;  ok 19,  uninitialized; }
+
+{ my $x; $x &= "x"; ok 20,  uninitialized; }
+{ my $x; $x |= "x"; ok 21, ! uninitialized; }
+{ my $x; $x ^= "x"; ok 22, ! uninitialized; }
+
+ok 23, $warn eq '';
+
+# If we got any errors that we were not expecting, then print them
+print map "#$_\n", split /\n/, $warn if length $warn;
diff --git a/contrib/perl5/t/op/auto.t b/contrib/perl5/t/op/auto.t
new file mode 100755
index 0000000..2eb0097
--- /dev/null
+++ b/contrib/perl5/t/op/auto.t
@@ -0,0 +1,52 @@
+#!./perl
+
+# $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
+
+print "1..37\n";
+
+$x = 10000;
+if (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
+if (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
+if (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
+if (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
+if (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
+if (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
+if (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
+if (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
+if (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
+if ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
+
+$x[0] = 10000;
+if (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
+if (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
+if (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
+if (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
+if (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
+if (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
+if (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
+if (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
+if (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
+if ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
+
+$x{0} = 10000;
+if (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
+if (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
+if (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
+if (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
+if (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
+if (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
+if (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
+if (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
+if (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
+if ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
+
+# test magical autoincrement
+
+if (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
+if (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
+if (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
+if (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
+if (++($foo = 'A99') eq 'B00') {print "ok 35\n";} else {print "not ok 35\n";}
+# EBCDIC guards: i and j, r and s, are not contiguous.
+if (++($foo = 'zi') eq 'zj') {print "ok 36\n";} else {print "not ok 36\n";}
+if (++($foo = 'zr') eq 'zs') {print "ok 37\n";} else {print "not ok 37\n";}
diff --git a/contrib/perl5/t/op/avhv.t b/contrib/perl5/t/op/avhv.t
new file mode 100755
index 0000000..55cc992
--- /dev/null
+++ b/contrib/perl5/t/op/avhv.t
@@ -0,0 +1,110 @@
+#!./perl
+      
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+require Tie::Array;
+
+package Tie::BasicArray;
+@ISA = 'Tie::Array';
+sub TIEARRAY  { bless [], $_[0] }
+sub STORE     { $_[0]->[$_[1]] = $_[2] }
+sub FETCH     { $_[0]->[$_[1]] }
+sub FETCHSIZE { scalar(@{$_[0]})} 
+sub STORESIZE { $#{$_[0]} = $_[1]+1 } 
+
+package main;
+
+print "1..12\n";
+
+$sch = {
+    'abc' => 1,
+    'def' => 2,
+    'jkl' => 3,
+};
+
+# basic normal array
+$a = [];
+$a->[0] = $sch;
+
+$a->{'abc'} = 'ABC';
+$a->{'def'} = 'DEF';
+$a->{'jkl'} = 'JKL';
+
+@keys = keys %$a;
+@values = values %$a;
+
+if ($#keys == 2 && $#values == 2) {print "ok 1\n";} else {print "not ok 1\n";}
+
+$i = 0;		# stop -w complaints
+
+while (($key,$value) = each %$a) {
+    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 == 3) {print "ok 2\n";} else {print "not ok 2\n";}
+
+# quick check with tied array
+tie @fake, 'Tie::StdArray';
+$a = \@fake;
+$a->[0] = $sch;
+
+$a->{'abc'} = 'ABC';
+if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";}
+
+# quick check with tied array
+tie @fake, 'Tie::BasicArray';
+$a = \@fake;
+$a->[0] = $sch;
+
+$a->{'abc'} = 'ABC';
+if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";}
+
+# quick check with tied array & tied hash
+require Tie::Hash;
+tie %fake, Tie::StdHash;
+%fake = %$sch;
+$a->[0] = \%fake;
+
+$a->{'abc'} = 'ABC';
+if ($a->{'abc'} eq 'ABC') {print "ok 5\n";} else {print "not ok 5\n";}
+
+# hash slice
+my $slice = join('', 'x',@$a{'abc','def'},'x');
+print "not " if $slice ne 'xABCx';
+print "ok 6\n";
+
+# evaluation in scalar context
+my $avhv = [{}];
+print "not " if %$avhv;
+print "ok 7\n";
+
+push @$avhv, "a";
+print "not " if %$avhv;
+print "ok 8\n";
+
+$avhv = [];
+eval { $a = %$avhv };
+print "not " unless $@ and $@ =~ /^Can't coerce array into hash/;
+print "ok 9\n";
+
+$avhv = [{foo=>1, bar=>2}];
+print "not " unless %$avhv =~ m,^\d+/\d+,;
+print "ok 10\n";
+
+# check if defelem magic works
+sub f {
+    print "not " unless $_[0] eq 'a';
+    $_[0] = 'b';
+    print "ok 11\n";
+}
+$a = [{key => 1}, 'a'];
+f($a->{key});
+print "not " unless $a->[1] eq 'b';
+print "ok 12\n";
+
diff --git a/contrib/perl5/t/op/bop.t b/contrib/perl5/t/op/bop.t
new file mode 100755
index 0000000..b247341
--- /dev/null
+++ b/contrib/perl5/t/op/bop.t
@@ -0,0 +1,64 @@
+#!./perl
+
+#
+# test the bit operators '&', '|', '^', '~', '<<', and '>>'
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..18\n";
+
+# numerics
+print ((0xdead & 0xbeef) == 0x9ead ? "ok 1\n" : "not ok 1\n");
+print ((0xdead | 0xbeef) == 0xfeef ? "ok 2\n" : "not ok 2\n");
+print ((0xdead ^ 0xbeef) == 0x6042 ? "ok 3\n" : "not ok 3\n");
+print ((~0xdead & 0xbeef) == 0x2042 ? "ok 4\n" : "not ok 4\n");
+
+# shifts
+print ((257 << 7) == 32896 ? "ok 5\n" : "not ok 5\n");
+print ((33023 >> 7) == 257 ? "ok 6\n" : "not ok 6\n");
+
+# signed vs. unsigned
+print ((~0 > 0 && do { use integer; ~0 } == -1)
+       ? "ok 7\n" : "not ok 7\n");
+
+my $bits = 0;
+for (my $i = ~0; $i; $i >>= 1) { ++$bits; }
+my $cusp = 1 << ($bits - 1);
+
+print ((($cusp & -1) > 0 && do { use integer; $cusp & -1 } < 0)
+       ? "ok 8\n" : "not ok 8\n");
+print ((($cusp | 1) > 0 && do { use integer; $cusp | 1 } < 0)
+       ? "ok 9\n" : "not ok 9\n");
+print ((($cusp ^ 1) > 0 && do { use integer; $cusp ^ 1 } < 0)
+       ? "ok 10\n" : "not ok 10\n");
+print (((1 << ($bits - 1)) == $cusp &&
+	do { use integer; 1 << ($bits - 1) } == -$cusp)
+       ? "ok 11\n" : "not ok 11\n");
+print ((($cusp >> 1) == ($cusp / 2) &&
+	do { use integer; $cusp >> 1 } == -($cusp / 2))
+       ? "ok 12\n" : "not ok 12\n");
+
+$Aaz = chr(ord("A") & ord("z"));
+$Aoz = chr(ord("A") | ord("z"));
+$Axz = chr(ord("A") ^ ord("z"));
+
+# short strings
+print (("AAAAA" & "zzzzz") eq ($Aaz x 5) ? "ok 13\n" : "not ok 13\n");
+print (("AAAAA" | "zzzzz") eq ($Aoz x 5) ? "ok 14\n" : "not ok 14\n");
+print (("AAAAA" ^ "zzzzz") eq ($Axz x 5) ? "ok 15\n" : "not ok 15\n");
+
+# long strings
+$foo = "A" x 150;
+$bar = "z" x 75;
+$zap = "A" x 75;
+# & truncates
+print (($foo & $bar) eq ($Aaz x 75 ) ? "ok 16\n" : "not ok 16\n");
+# | does not truncate
+print (($foo | $bar) eq ($Aoz x 75 . $zap) ? "ok 17\n" : "not ok 17\n");
+# ^ does not truncate
+print (($foo ^ $bar) eq ($Axz x 75 . $zap) ? "ok 18\n" : "not ok 18\n");
+
diff --git a/contrib/perl5/t/op/chop.t b/contrib/perl5/t/op/chop.t
new file mode 100755
index 0000000..77263ad
--- /dev/null
+++ b/contrib/perl5/t/op/chop.t
@@ -0,0 +1,87 @@
+#!./perl
+
+# $RCSfile: chop.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:40 $
+
+print "1..28\n";
+
+# optimized
+
+$_ = 'abc';
+$c = do foo();
+if ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1 $c$_\n";}
+
+# unoptimized
+
+$_ = 'abc';
+$c = chop($_);
+if ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
+
+sub foo {
+    chop;
+}
+
+@foo = ("hi \n","there\n","!\n");
+@bar = @foo;
+chop(@bar);
+print join('',@bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n";
+
+$foo = "\n";
+chop($foo,@foo);
+print join('',$foo,@foo) eq 'hi there!' ? "ok 4\n" : "not ok 4\n";
+
+$_ = "foo\n\n";
+print chomp() == 1 ? "ok 5\n" : "not ok 5\n";
+print $_ eq "foo\n" ? "ok 6\n" : "not ok 6\n";
+
+$_ = "foo\n";
+print chomp() == 1 ? "ok 7\n" : "not ok 7\n";
+print $_ eq "foo" ? "ok 8\n" : "not ok 8\n";
+
+$_ = "foo";
+print chomp() == 0 ? "ok 9\n" : "not ok 9\n";
+print $_ eq "foo" ? "ok 10\n" : "not ok 10\n";
+
+$_ = "foo";
+$/ = "oo";
+print chomp() == 2 ? "ok 11\n" : "not ok 11\n";
+print $_ eq "f" ? "ok 12\n" : "not ok 12\n";
+
+$_ = "bar";
+$/ = "oo";
+print chomp() == 0 ? "ok 13\n" : "not ok 13\n";
+print $_ eq "bar" ? "ok 14\n" : "not ok 14\n";
+
+$_ = "f\n\n\n\n\n";
+$/ = "";
+print chomp() == 5 ? "ok 15\n" : "not ok 15\n";
+print $_ eq "f" ? "ok 16\n" : "not ok 16\n";
+
+$_ = "f\n\n";
+$/ = "";
+print chomp() == 2 ? "ok 17\n" : "not ok 17\n";
+print $_ eq "f" ? "ok 18\n" : "not ok 18\n";
+
+$_ = "f\n";
+$/ = "";
+print chomp() == 1 ? "ok 19\n" : "not ok 19\n";
+print $_ eq "f" ? "ok 20\n" : "not ok 20\n";
+
+$_ = "f";
+$/ = "";
+print chomp() == 0 ? "ok 21\n" : "not ok 21\n";
+print $_ eq "f" ? "ok 22\n" : "not ok 22\n";
+
+$_ = "xx";
+$/ = "xx";
+print chomp() == 2 ? "ok 23\n" : "not ok 23\n";
+print $_ eq "" ? "ok 24\n" : "not ok 24\n";
+
+$_ = "axx";
+$/ = "xx";
+print chomp() == 2 ? "ok 25\n" : "not ok 25\n";
+print $_ eq "a" ? "ok 26\n" : "not ok 26\n";
+
+$_ = "axx";
+$/ = "yy";
+print chomp() == 0 ? "ok 27\n" : "not ok 27\n";
+print $_ eq "axx" ? "ok 28\n" : "not ok 28\n";
diff --git a/contrib/perl5/t/op/closure.t b/contrib/perl5/t/op/closure.t
new file mode 100755
index 0000000..95d44f5
--- /dev/null
+++ b/contrib/perl5/t/op/closure.t
@@ -0,0 +1,482 @@
+#!./perl
+#                              -*- Mode: Perl -*-
+# closure.t:
+#   Original written by Ulrich Pfeifer on 2 Jan 1997.
+#   Greatly extended by Tom Phoenix <rootbeer@teleport.com> on 28 Jan 1997.
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
+print "1..169\n";
+
+my $test = 1;
+sub test (&) {
+  print ((&{$_[0]})?"ok $test\n":"not ok $test\n");
+  $test++;
+}
+
+my $i = 1;
+sub foo { $i = shift if @_; $i }
+
+# no closure
+test { foo == 1 };
+foo(2);
+test { foo == 2 };
+
+# closure: lexical outside sub
+my $foo = sub {$i = shift if @_; $i };
+my $bar = sub {$i = shift if @_; $i };
+test {&$foo() == 2 };
+&$foo(3);
+test {&$foo() == 3 };
+# did the lexical change?
+test { foo == 3 and $i == 3};
+# did the second closure notice?
+test {&$bar() == 3 };
+
+# closure: lexical inside sub
+sub bar {
+  my $i = shift;
+  sub { $i = shift if @_; $i }
+}
+
+$foo = bar(4);
+$bar = bar(5);
+test {&$foo() == 4 };
+&$foo(6);
+test {&$foo() == 6 };
+test {&$bar() == 5 };
+
+# nested closures
+sub bizz {
+  my $i = 7;
+  if (@_) {
+    my $i = shift;
+    sub {$i = shift if @_; $i };
+  } else {
+    my $i = $i;
+    sub {$i = shift if @_; $i };
+  }
+}
+$foo = bizz();
+$bar = bizz();
+test {&$foo() == 7 };
+&$foo(8);
+test {&$foo() == 8 };
+test {&$bar() == 7 };
+
+$foo = bizz(9);
+$bar = bizz(10);
+test {&$foo(11)-1 == &$bar()};
+
+my @foo;
+for (qw(0 1 2 3 4)) {
+  my $i = $_;
+  $foo[$_] = sub {$i = shift if @_; $i };
+}
+
+test {
+  &{$foo[0]}() == 0 and
+  &{$foo[1]}() == 1 and
+  &{$foo[2]}() == 2 and
+  &{$foo[3]}() == 3 and
+  &{$foo[4]}() == 4
+  };
+
+for (0 .. 4) {
+  &{$foo[$_]}(4-$_);
+}
+
+test {
+  &{$foo[0]}() == 4 and
+  &{$foo[1]}() == 3 and
+  &{$foo[2]}() == 2 and
+  &{$foo[3]}() == 1 and
+  &{$foo[4]}() == 0
+  };
+
+sub barf {
+  my @foo;
+  for (qw(0 1 2 3 4)) {
+    my $i = $_;
+    $foo[$_] = sub {$i = shift if @_; $i };
+  }
+  @foo;
+}
+
+@foo = barf();
+test {
+  &{$foo[0]}() == 0 and
+  &{$foo[1]}() == 1 and
+  &{$foo[2]}() == 2 and
+  &{$foo[3]}() == 3 and
+  &{$foo[4]}() == 4
+  };
+
+for (0 .. 4) {
+  &{$foo[$_]}(4-$_);
+}
+
+test {
+  &{$foo[0]}() == 4 and
+  &{$foo[1]}() == 3 and
+  &{$foo[2]}() == 2 and
+  &{$foo[3]}() == 1 and
+  &{$foo[4]}() == 0
+  };
+
+# test if closures get created in optimized for loops
+
+my %foo;
+for my $n ('A'..'E') {
+    $foo{$n} = sub { $n eq $_[0] };
+}
+
+test {
+  &{$foo{A}}('A') and
+  &{$foo{B}}('B') and
+  &{$foo{C}}('C') and
+  &{$foo{D}}('D') and
+  &{$foo{E}}('E')
+};
+
+for my $n (0..4) {
+    $foo[$n] = sub { $n == $_[0] };
+}
+
+test {
+  &{$foo[0]}(0) and
+  &{$foo[1]}(1) and
+  &{$foo[2]}(2) and
+  &{$foo[3]}(3) and
+  &{$foo[4]}(4)
+};
+
+# Additional tests by Tom Phoenix <rootbeer@teleport.com>.
+
+{
+    use strict;
+
+    use vars qw!$test!;
+    my($debugging, %expected, $inner_type, $where_declared, $within);
+    my($nc_attempt, $call_outer, $call_inner, $undef_outer);
+    my($code, $inner_sub_test, $expected, $line, $errors, $output);
+    my(@inners, $sub_test, $pid);
+    $debugging = 1 if defined($ARGV[0]) and $ARGV[0] eq '-debug';
+
+    # The expected values for these tests
+    %expected = (
+	'global_scalar'	=> 1001,
+	'global_array'	=> 2101,
+	'global_hash'	=> 3004,
+	'fs_scalar'	=> 4001,
+	'fs_array'	=> 5101,
+	'fs_hash'	=> 6004,
+	'sub_scalar'	=> 7001,
+	'sub_array'	=> 8101,
+	'sub_hash'	=> 9004,
+	'foreach'	=> 10011,
+    );
+
+    # Our innermost sub is either named or anonymous
+    for $inner_type (qw!named anon!) {
+      # And it may be declared at filescope, within a named
+      # sub, or within an anon sub
+      for $where_declared (qw!filescope in_named in_anon!) {
+	# And that, in turn, may be within a foreach loop,
+	# a naked block, or another named sub
+	for $within (qw!foreach naked other_sub!) {
+
+	  # Here are a number of variables which show what's
+	  # going on, in a way.
+	  $nc_attempt = 0+		# Named closure attempted
+	      ( ($inner_type eq 'named') ||
+	      ($within eq 'other_sub') ) ;
+	  $call_inner = 0+		# Need to call &inner
+	      ( ($inner_type eq 'anon') &&
+	      ($within eq 'other_sub') ) ;
+	  $call_outer = 0+		# Need to call &outer or &$outer
+	      ( ($inner_type eq 'anon') &&
+	      ($within ne 'other_sub') ) ;
+	  $undef_outer = 0+		# $outer is created but unused
+	      ( ($where_declared eq 'in_anon') &&
+	      (not $call_outer) ) ;
+
+	  $code = "# This is a test script built by t/op/closure.t\n\n";
+
+	  $code .= <<"DEBUG_INFO" if $debugging;
+# inner_type: $inner_type 
+# where_declared: $where_declared 
+# within: $within
+# nc_attempt: $nc_attempt
+# call_inner: $call_inner
+# call_outer: $call_outer
+# undef_outer: $undef_outer
+DEBUG_INFO
+
+	  $code .= <<"END_MARK_ONE";
+
+BEGIN { \$SIG{__WARN__} = sub { 
+    my \$msg = \$_[0];
+END_MARK_ONE
+
+	  $code .=  <<"END_MARK_TWO" if $nc_attempt;
+    return if index(\$msg, 'will not stay shared') != -1;
+    return if index(\$msg, 'may be unavailable') != -1;
+END_MARK_TWO
+
+	  $code .= <<"END_MARK_THREE";		# Backwhack a lot!
+    print "not ok: got unexpected warning \$msg\\n";
+} }
+
+{
+    my \$test = $test;
+    sub test (&) {
+      my \$result = &{\$_[0]};
+      print "not " unless \$result;
+      print "ok \$test\\n";
+      \$test++;
+    }
+}
+
+# some of the variables which the closure will access
+\$global_scalar = 1000;
+\@global_array = (2000, 2100, 2200, 2300);
+%global_hash = 3000..3009;
+
+my \$fs_scalar = 4000;
+my \@fs_array = (5000, 5100, 5200, 5300);
+my %fs_hash = 6000..6009;
+
+END_MARK_THREE
+
+	  if ($where_declared eq 'filescope') {
+	    # Nothing here
+	  } elsif ($where_declared eq 'in_named') {
+	    $code .= <<'END';
+sub outer {
+  my $sub_scalar = 7000;
+  my @sub_array = (8000, 8100, 8200, 8300);
+  my %sub_hash = 9000..9009;
+END
+    # }
+	  } elsif ($where_declared eq 'in_anon') {
+	    $code .= <<'END';
+$outer = sub {
+  my $sub_scalar = 7000;
+  my @sub_array = (8000, 8100, 8200, 8300);
+  my %sub_hash = 9000..9009;
+END
+    # }
+	  } else {
+	    die "What was $where_declared?"
+	  }
+
+	  if ($within eq 'foreach') {
+	    $code .= "
+      my \$foreach = 12000;
+      my \@list = (10000, 10010);
+      foreach \$foreach (\@list) {
+    " # }
+	  } elsif ($within eq 'naked') {
+	    $code .= "  { # naked block\n"	# }
+	  } elsif ($within eq 'other_sub') {
+	    $code .= "  sub inner_sub {\n"	# }
+	  } else {
+	    die "What was $within?"
+	  }
+
+	  $sub_test = $test;
+	  @inners = ( qw!global_scalar global_array global_hash! ,
+	    qw!fs_scalar fs_array fs_hash! );
+	  push @inners, 'foreach' if $within eq 'foreach';
+	  if ($where_declared ne 'filescope') {
+	    push @inners, qw!sub_scalar sub_array sub_hash!;
+	  }
+	  for $inner_sub_test (@inners) {
+
+	    if ($inner_type eq 'named') {
+	      $code .= "    sub named_$sub_test "
+	    } elsif ($inner_type eq 'anon') {
+	      $code .= "    \$anon_$sub_test = sub "
+	    } else {
+	      die "What was $inner_type?"
+	    }
+
+	    # Now to write the body of the test sub
+	    if ($inner_sub_test eq 'global_scalar') {
+	      $code .= '{ ++$global_scalar }'
+	    } elsif ($inner_sub_test eq 'fs_scalar') {
+	      $code .= '{ ++$fs_scalar }'
+	    } elsif ($inner_sub_test eq 'sub_scalar') {
+	      $code .= '{ ++$sub_scalar }'
+	    } elsif ($inner_sub_test eq 'global_array') {
+	      $code .= '{ ++$global_array[1] }'
+	    } elsif ($inner_sub_test eq 'fs_array') {
+	      $code .= '{ ++$fs_array[1] }'
+	    } elsif ($inner_sub_test eq 'sub_array') {
+	      $code .= '{ ++$sub_array[1] }'
+	    } elsif ($inner_sub_test eq 'global_hash') {
+	      $code .= '{ ++$global_hash{3002} }'
+	    } elsif ($inner_sub_test eq 'fs_hash') {
+	      $code .= '{ ++$fs_hash{6002} }'
+	    } elsif ($inner_sub_test eq 'sub_hash') {
+	      $code .= '{ ++$sub_hash{9002} }'
+	    } elsif ($inner_sub_test eq 'foreach') {
+	      $code .= '{ ++$foreach }'
+	    } else {
+	      die "What was $inner_sub_test?"
+	    }
+	  
+	    # Close up
+	    if ($inner_type eq 'anon') {
+	      $code .= ';'
+	    }
+	    $code .= "\n";
+	    $sub_test++;	# sub name sequence number
+
+	  } # End of foreach $inner_sub_test
+
+	  # Close up $within block		# {
+	  $code .= "  }\n\n";
+
+	  # Close up $where_declared block
+	  if ($where_declared eq 'in_named') {	# {
+	    $code .= "}\n\n";
+	  } elsif ($where_declared eq 'in_anon') {	# {
+	    $code .= "};\n\n";
+	  }
+
+	  # We may need to do something with the sub we just made...
+	  $code .= "undef \$outer;\n" if $undef_outer;
+	  $code .= "&inner_sub;\n" if $call_inner;
+	  if ($call_outer) {
+	    if ($where_declared eq 'in_named') {
+	      $code .= "&outer;\n\n";
+	    } elsif ($where_declared eq 'in_anon') {
+	      $code .= "&\$outer;\n\n"
+	    }
+	  }
+
+	  # Now, we can actually prep to run the tests.
+	  for $inner_sub_test (@inners) {
+	    $expected = $expected{$inner_sub_test} or
+	      die "expected $inner_sub_test missing";
+
+	    # Named closures won't access the expected vars
+	    if ( $nc_attempt and 
+		substr($inner_sub_test, 0, 4) eq "sub_" ) {
+	      $expected = 1;
+	    }
+
+	    # If you make a sub within a foreach loop,
+	    # what happens if it tries to access the 
+	    # foreach index variable? If it's a named
+	    # sub, it gets the var from "outside" the loop,
+	    # but if it's anon, it gets the value to which
+	    # the index variable is aliased.
+	    #
+	    # Of course, if the value was set only
+	    # within another sub which was never called,
+	    # the value has not been set yet.
+	    #
+	    if ($inner_sub_test eq 'foreach') {
+	      if ($inner_type eq 'named') {
+		if ($call_outer || ($where_declared eq 'filescope')) {
+		  $expected = 12001
+		} else {
+		  $expected = 1
+		}
+	      }
+	    }
+
+	    # Here's the test:
+	    if ($inner_type eq 'anon') {
+	      $code .= "test { &\$anon_$test == $expected };\n"
+	    } else {
+	      $code .= "test { &named_$test == $expected };\n"
+	    }
+	    $test++;
+	  }
+
+	  if ($Config{d_fork} and $^O ne 'VMS' and $^O ne 'MSWin32') {
+	    # Fork off a new perl to run the tests.
+	    # (This is so we can catch spurious warnings.)
+	    $| = 1; print ""; $| = 0; # flush output before forking
+	    pipe READ, WRITE or die "Can't make pipe: $!";
+	    pipe READ2, WRITE2 or die "Can't make second pipe: $!";
+	    die "Can't fork: $!" unless defined($pid = open PERL, "|-");
+	    unless ($pid) {
+	      # Child process here. We're going to send errors back
+	      # through the extra pipe.
+	      close READ;
+	      close READ2;
+	      open STDOUT, ">&WRITE"  or die "Can't redirect STDOUT: $!";
+	      open STDERR, ">&WRITE2" or die "Can't redirect STDERR: $!";
+	      exec './perl', '-w', '-'
+		or die "Can't exec ./perl: $!";
+	    } else {
+	      # Parent process here.
+	      close WRITE;
+	      close WRITE2;
+	      print PERL $code;
+	      close PERL;
+	      { local $/;
+	        $output = join '', <READ>;
+	        $errors = join '', <READ2>; }
+	      close READ;
+	      close READ2;
+	    }
+	  } else {
+	    # No fork().  Do it the hard way.
+	    my $cmdfile = "tcmd$$";  $cmdfile++ while -e $cmdfile;
+	    my $errfile = "terr$$";  $errfile++ while -e $errfile;
+	    my @tmpfiles = ($cmdfile, $errfile);
+	    open CMD, ">$cmdfile"; print CMD $code; close CMD;
+	    my $cmd = (($^O eq 'VMS') ? "MCR $^X"
+		       : ($^O eq 'MSWin32') ? '.\perl'
+		       : './perl');
+	    $cmd .= " -w $cmdfile 2>$errfile";
+	    if ($^O eq 'VMS' or $^O eq 'MSWin32') {
+	      # Use pipe instead of system so we don't inherit STD* from
+	      # this process, and then foul our pipe back to parent by
+	      # redirecting output in the child.
+	      open PERL,"$cmd |" or die "Can't open pipe: $!\n";
+	      { local $/; $output = join '', <PERL> }
+	      close PERL;
+	    } else {
+	      my $outfile = "tout$$";  $outfile++ while -e $outfile;
+	      push @tmpfiles, $outfile;
+	      system "$cmd >$outfile";
+	      { local $/; open IN, $outfile; $output = <IN>; close IN }
+	    }
+	    if ($?) {
+	      printf "not ok: exited with error code %04X\n", $?;
+	      $debugging or do { 1 while unlink @tmpfiles };
+	      exit;
+	    }
+	    { local $/; open IN, $errfile; $errors = <IN>; close IN }
+	    1 while unlink @tmpfiles;
+	  }
+	  print $output;
+	  print STDERR $errors;
+	  if ($debugging && ($errors || $? || ($output =~ /not ok/))) {
+	    my $lnum = 0;
+	    for $line (split '\n', $code) {
+	      printf "%3d:  %s\n", ++$lnum, $line;
+	    }
+	  }
+	  printf "not ok: exited with error code %04X\n", $? if $?;
+	  print "-" x 30, "\n" if $debugging;
+
+	}	# End of foreach $within
+      }	# End of foreach $where_declared
+    }	# End of foreach $inner_type
+
+}
+
diff --git a/contrib/perl5/t/op/cmp.t b/contrib/perl5/t/op/cmp.t
new file mode 100755
index 0000000..4a7e68d
--- /dev/null
+++ b/contrib/perl5/t/op/cmp.t
@@ -0,0 +1,35 @@
+#!./perl
+
+@FOO = ('s', 'N/A', 'a', 'NaN', -1, undef, 0, 1);
+
+$expect = ($#FOO+2) * ($#FOO+1);
+print "1..$expect\n";
+
+my $ok = 0;
+for my $i (0..$#FOO) {
+    for my $j ($i..$#FOO) {
+	$ok++;
+	my $cmp = $FOO[$i] <=> $FOO[$j];
+	if (!defined($cmp) ||
+	    $cmp == -1 && $FOO[$i] < $FOO[$j] ||
+	    $cmp == 0  && $FOO[$i] == $FOO[$j] ||
+	    $cmp == 1  && $FOO[$i] > $FOO[$j])
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    print "not ok $ok ($FOO[$i] <=> $FOO[$j]) gives: '$cmp'\n";
+	}
+	$ok++;
+	$cmp = $FOO[$i] cmp $FOO[$j];
+	if ($cmp == -1 && $FOO[$i] lt $FOO[$j] ||
+	    $cmp == 0  && $FOO[$i] eq $FOO[$j] ||
+	    $cmp == 1  && $FOO[$i] gt $FOO[$j])
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    print "not ok $ok ($FOO[$i] cmp $FOO[$j]) gives '$cmp'\n";
+	}
+    }
+}
diff --git a/contrib/perl5/t/op/cond.t b/contrib/perl5/t/op/cond.t
new file mode 100755
index 0000000..427efb4
--- /dev/null
+++ b/contrib/perl5/t/op/cond.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:41 $
+
+print "1..4\n";
+
+print 1 ? "ok 1\n" : "not ok 1\n";	# compile time
+print 0 ? "not ok 2\n" : "ok 2\n";
+
+$x = 1;
+print $x ? "ok 3\n" : "not ok 3\n";	# run time
+print !$x ? "not ok 4\n" : "ok 4\n";
diff --git a/contrib/perl5/t/op/context.t b/contrib/perl5/t/op/context.t
new file mode 100755
index 0000000..4625441
--- /dev/null
+++ b/contrib/perl5/t/op/context.t
@@ -0,0 +1,18 @@
+#!./perl
+
+$n=0;
+
+print "1..3\n";
+
+sub foo {
+    $a='abcd';
+
+    $a=~/(.)/g;
+
+    $1 eq 'a' or print 'not ';
+    print "ok ",++$n,"\n";
+}
+
+$a=foo;
+@a=foo;
+foo;
diff --git a/contrib/perl5/t/op/defins.t b/contrib/perl5/t/op/defins.t
new file mode 100755
index 0000000..33c74ea
--- /dev/null
+++ b/contrib/perl5/t/op/defins.t
@@ -0,0 +1,147 @@
+#!./perl -w
+
+#
+# test auto defined() test insertion
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $SIG{__WARN__} = sub { $warns++; warn $_[0] };
+    print "1..14\n";
+}
+
+$wanted_filename = $^O eq 'VMS' ? '0.' : '0';
+    
+print "not " if $warns;
+print "ok 1\n";
+
+open(FILE,">./0");
+print FILE "1\n";
+print FILE "0";
+close(FILE);
+
+open(FILE,"<./0");
+my $seen = 0;
+my $dummy;
+while (my $name = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 2\n";
+
+seek(FILE,0,0);
+$seen = 0;
+my $line = '';
+do 
+ {
+  $seen++ if $line eq '0';
+ } while ($line = <FILE>);
+
+print "not " unless $seen;
+print "ok 3\n";
+
+
+seek(FILE,0,0);
+$seen = 0;    
+while (($seen ? $dummy : $name) = <FILE>)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 4\n";
+
+seek(FILE,0,0);
+$seen = 0;    
+my %where;    
+while ($where{$seen} = <FILE>)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 5\n";
+close FILE;
+
+opendir(DIR,'.');
+$seen = 0;
+while (my $name = readdir(DIR))
+ {
+  $seen++ if $name eq $wanted_filename;
+ }            
+print "not " unless $seen;
+print "ok 6\n";
+
+rewinddir(DIR);
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = readdir(DIR))
+ {
+  $seen++ if $name eq $wanted_filename;
+ }
+print "not " unless $seen;
+print "ok 7\n";
+
+rewinddir(DIR);
+$seen = 0;    
+while ($where{$seen} = readdir(DIR))
+ {
+  $seen++ if $where{$seen} eq $wanted_filename;
+ }
+print "not " unless $seen;
+print "ok 8\n";
+
+$seen = 0;
+while (my $name = glob('*'))
+ {
+  $seen++ if $name eq $wanted_filename;
+ }            
+print "not " unless $seen;
+print "ok 9\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = glob('*'))
+ {
+  $seen++ if $name eq $wanted_filename;
+ }
+print "not " unless $seen;
+print "ok 10\n";
+
+$seen = 0;    
+while ($where{$seen} = glob('*'))
+ {
+  $seen++ if $where{$seen} eq $wanted_filename;
+ }
+print "not " unless $seen;
+print "ok 11\n";
+
+unlink("./0");
+
+my %hash = (0 => 1, 1 => 2);
+
+$seen = 0;
+while (my $name = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }            
+print "not " unless $seen;
+print "ok 12\n";
+
+$seen = 0;    
+$dummy = '';
+while (($seen ? $dummy : $name) = each %hash)
+ {
+  $seen++ if $name eq '0';
+ }
+print "not " unless $seen;
+print "ok 13\n";
+
+$seen = 0;    
+while ($where{$seen} = each %hash)
+ {
+  $seen++ if $where{$seen} eq '0';
+ }
+print "not " unless $seen;
+print "ok 14\n";
+
diff --git a/contrib/perl5/t/op/delete.t b/contrib/perl5/t/op/delete.t
new file mode 100755
index 0000000..6cc4475
--- /dev/null
+++ b/contrib/perl5/t/op/delete.t
@@ -0,0 +1,51 @@
+#!./perl
+
+# $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $
+
+print "1..16\n";
+
+$foo{1} = 'a';
+$foo{2} = 'b';
+$foo{3} = 'c';
+$foo{4} = 'd';
+$foo{5} = 'e';
+
+$foo = delete $foo{2};
+
+if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
+if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
+if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
+if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";}
+if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";}
+
+@foo = delete @foo{4, 5};
+
+if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";}
+if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";}
+if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";}
+if ($foo{4} eq '') {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";}
+if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";}
+if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";}
+if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";}
+
+$foo = join('',values(%foo));
+if ($foo eq 'ac' || $foo eq 'ca') {print "ok 14\n";} else {print "not ok 14\n";}
+
+foreach $key (keys %foo) {
+    delete $foo{$key};
+}
+
+$foo{'foo'} = 'x';
+$foo{'bar'} = 'y';
+
+$foo = join('',values(%foo));
+print +($foo eq 'xy' || $foo eq 'yx') ? "ok 15\n" : "not ok 15\n";
+
+$refhash{"top"}->{"foo"} = "FOO";
+$refhash{"top"}->{"bar"} = "BAR";
+
+delete $refhash{"top"}->{"bar"};
+@list = keys %{$refhash{"top"}};
+
+print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n";
diff --git a/contrib/perl5/t/op/die.t b/contrib/perl5/t/op/die.t
new file mode 100755
index 0000000..d473ed6
--- /dev/null
+++ b/contrib/perl5/t/op/die.t
@@ -0,0 +1,43 @@
+#!./perl
+
+print "1..10\n";
+
+$SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
+
+$err = "ok 1\n";
+eval {
+    die $err;
+};
+
+print "not " unless $@ eq $err;
+print "ok 2\n";
+
+$x = [3];
+eval { die $x; };
+
+print "not " unless $x->[0] == 4;
+print "ok 4\n";
+
+eval {
+    eval {
+	die [ 5 ];
+    };
+    die if $@;
+};
+
+eval {
+    eval {
+	die bless [ 7 ], "Error";
+    };
+    die if $@;
+};
+
+print "not " unless ref($@) eq "Out";
+print "ok 10\n";
+
+package Error;
+
+sub PROPAGATE {
+    print "ok ",$_[0]->[0]++,"\n";
+    bless [$_[0]->[0]], "Out";
+}
diff --git a/contrib/perl5/t/op/die_exit.t b/contrib/perl5/t/op/die_exit.t
new file mode 100755
index 0000000..ffbb1e0
--- /dev/null
+++ b/contrib/perl5/t/op/die_exit.t
@@ -0,0 +1,53 @@
+#!./perl
+
+#
+# Verify that C<die> return the return code
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -e '../lib';
+}
+my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl';
+
+use strict;
+
+my %tests = (
+	 1 => [   0,   0],
+	 2 => [   0,   1], 
+	 3 => [   0, 127], 
+	 4 => [   0, 128], 
+	 5 => [   0, 255], 
+	 6 => [   0, 256], 
+	 7 => [   0, 512], 
+	 8 => [   1,   0],
+	 9 => [   1,   1],
+	10 => [   1, 256],
+	11 => [ 128,   0],
+	12 => [ 128,   1],
+	13 => [ 128, 256],
+	14 => [ 255,   0],
+	15 => [ 255,   1],
+	16 => [ 255, 256],
+	# see if implicit close preserves $?
+	17 => [  42,  42, '{ local *F; open F, q[TEST]; close F } die;'],
+);
+
+my $max = keys %tests;
+
+print "1..$max\n";
+
+foreach my $test (1 .. $max) {
+    my($bang, $query, $code) = @{$tests{$test}};
+    $code ||= 'die;';
+    my $exit =
+	($^O eq 'MSWin32'
+	 ? system qq($perl -e "\$! = $bang; \$? = $query; $code" 2> nul)
+	 : system qq($perl -e '\$! = $bang; \$? = $query; $code' 2> /dev/null));
+
+    printf "# 0x%04x  0x%04x  0x%04x\nnot ", $exit, $bang, $query
+	unless $exit == (($bang || ($query >> 8) || 255) << 8);
+    print "ok $test\n";
+}
+    
diff --git a/contrib/perl5/t/op/do.t b/contrib/perl5/t/op/do.t
new file mode 100755
index 0000000..87ec08d
--- /dev/null
+++ b/contrib/perl5/t/op/do.t
@@ -0,0 +1,44 @@
+#!./perl
+
+# $RCSfile: do.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:45 $
+
+sub foo1
+{
+    print $_[0];
+    'value';
+}
+
+sub foo2
+{
+    shift;
+    print $_[0];
+    $x = 'value';
+    $x;
+}
+
+print "1..15\n";
+
+$_[0] = "not ok 1\n";
+$result = do foo1("ok 1\n");
+print "#2\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; }
+if ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; }
+
+$_[0] = "not ok 4\n";
+$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n");
+print "#5\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; }
+if ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; }
+
+$result = do{print "ok 7\n"; 'value';};
+print "#8\t:$result: eq :value:\n";
+if ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; }
+
+sub blather {
+    print @_;
+}
+
+do blather("ok 9\n","ok 10\n");
+@x = ("ok 11\n", "ok 12\n");
+@y = ("ok 14\n", "ok 15\n");
+do blather(@x,"ok 13\n",@y);
diff --git a/contrib/perl5/t/op/each.t b/contrib/perl5/t/op/each.t
new file mode 100755
index 0000000..9063c2c
--- /dev/null
+++ b/contrib/perl5/t/op/each.t
@@ -0,0 +1,122 @@
+#!./perl
+
+# $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
+
+print "1..16\n";
+
+$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{'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';
+
+@keys = keys %h;
+@values = values %h;
+
+if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
+
+$i = 0;		# stop -w complaints
+
+while (($key,$value) = each(%h)) {
+    if ($key eq $keys[$i] && $value eq $values[$i]
+        && (('a' lt 'A' && $key lt $value) || $key gt $value)) {
+	$key =~ y/a-z/A-Z/;
+	$i++ if $key eq $value;
+    }
+}
+
+if ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
+
+@keys = ('blurfl', keys(%h), 'dyick');
+if ($#keys == 31) {print "ok 3\n";} else {print "not ok 3\n";}
+
+$size = ((split('/',scalar %h))[1]);
+keys %h = $size * 5;
+$newsize = ((split('/',scalar %h))[1]);
+if ($newsize == $size * 8) {print "ok 4\n";} else {print "not ok 4\n";}
+keys %h = 1;
+$size = ((split('/',scalar %h))[1]);
+if ($size == $newsize) {print "ok 5\n";} else {print "not ok 5\n";}
+%h = (1,1);
+$size = ((split('/',scalar %h))[1]);
+if ($size == $newsize) {print "ok 6\n";} else {print "not ok 6\n";}
+undef %h;
+%h = (1,1);
+$size = ((split('/',scalar %h))[1]);
+if ($size == 8) {print "ok 7\n";} else {print "not ok 7\n";}
+
+# test scalar each
+%hash = 1..20;
+$total = 0;
+$total += $key while $key = each %hash;
+print "# Scalar each is bad.\nnot " unless $total == 100;
+print "ok 8\n";
+
+for (1..3) { @foo = each %hash }
+keys %hash;
+$total = 0;
+$total += $key while $key = each %hash;
+print "# Scalar keys isn't resetting the iterator.\nnot " if $total != 100;
+print "ok 9\n";
+
+for (1..3) { @foo = each %hash }
+$total = 0;
+$total += $key while $key = each %hash;
+print "# Iterator of each isn't being maintained.\nnot " if $total == 100;
+print "ok 10\n";
+
+for (1..3) { @foo = each %hash }
+values %hash;
+$total = 0;
+$total += $key while $key = each %hash;
+print "# Scalar values isn't resetting the iterator.\nnot " if $total != 100;
+print "ok 11\n";
+
+$size = (split('/', scalar %hash))[1];
+keys(%hash) = $size / 2;
+print "not " if $size != (split('/', scalar %hash))[1];
+print "ok 12\n";
+keys(%hash) = $size + 100;
+print "not " if $size == (split('/', scalar %hash))[1];
+print "ok 13\n";
+
+print "not " if keys(%hash) != 10;
+print "ok 14\n";
+
+print keys(hash) != 10 ? "not ok 15\n" : "ok 15\n";
+
+$i = 0;
+%h = (a => A, b => B, c=> C, d => D, abc => ABC);
+@keys = keys(h);
+@values = values(h);
+while (($key, $value) = each(h)) {
+	if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
+		$i++;
+	}
+}
+if ($i == 5) { print "ok 16\n" } else { print "not ok\n" }
diff --git a/contrib/perl5/t/op/eval.t b/contrib/perl5/t/op/eval.t
new file mode 100755
index 0000000..9368281
--- /dev/null
+++ b/contrib/perl5/t/op/eval.t
@@ -0,0 +1,81 @@
+#!./perl
+
+# $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
+
+print "1..23\n";
+
+eval 'print "ok 1\n";';
+
+if ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";}
+
+eval "\$foo\n    = # this is a comment\n'ok 3';";
+print $foo,"\n";
+
+eval "\$foo\n    = # this is a comment\n'ok 4\n';";
+print $foo;
+
+print eval '
+$foo =;';		# this tests for a call through yyerror()
+if ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
+
+print eval '$foo = /';	# this tests for a call through fatal()
+if ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";}
+
+print eval '"ok 7\n";';
+
+# calculate a factorial with recursive evals
+
+$foo = 5;
+$fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
+$ans = eval $fact;
+if ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
+
+$foo = 5;
+$fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
+$ans = eval $fact;
+if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
+
+open(try,'>Op.eval');
+print try 'print "ok 10\n"; unlink "Op.eval";',"\n";
+close try;
+
+do 'Op.eval'; print $@;
+
+# Test the singlequoted eval optimizer
+
+$i = 11;
+for (1..3) {
+    eval 'print "ok ", $i++, "\n"';
+}
+
+eval {
+    print "ok 14\n";
+    die "ok 16\n";
+    1;
+} || print "ok 15\n$@";
+
+# check whether eval EXPR determines value of EXPR correctly
+
+{
+  my @a = qw(a b c d);
+  my @b = eval @a;
+  print "@b" eq '4' ? "ok 17\n" : "not ok 17\n";
+  print $@ ? "not ok 18\n" : "ok 18\n";
+
+  my $a = q[defined(wantarray) ? (wantarray ? ($b='A') : ($b='S')) : ($b='V')];
+  my $b;
+  @a = eval $a;
+  print "@a" eq 'A' ? "ok 19\n" : "# $b\nnot ok 19\n";
+  print   $b eq 'A' ? "ok 20\n" : "# $b\nnot ok 20\n";
+  $_ = eval $a;
+  print   $b eq 'S' ? "ok 21\n" : "# $b\nnot ok 21\n";
+  eval $a;
+  print   $b eq 'V' ? "ok 22\n" : "# $b\nnot ok 22\n";
+
+  $b = 'wrong';
+  $x = sub {
+     my $b = "right";
+     print eval('"$b"') eq $b ? "ok 23\n" : "not ok 23\n";
+  };
+  &$x();
+}
diff --git a/contrib/perl5/t/op/exec.t b/contrib/perl5/t/op/exec.t
new file mode 100755
index 0000000..098a455
--- /dev/null
+++ b/contrib/perl5/t/op/exec.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $
+
+$| = 1;				# flush stdout
+
+if ($^O eq 'MSWin32') {
+    print "# exec is unsupported on Win32\n";
+    # XXX the system tests could be written to use ./perl and so work on Win32
+    print "1..0\n";
+    exit(0);
+}
+
+print "1..8\n";
+
+if ($^O ne 'os2') {
+  print "not ok 1\n" if system "echo ok \\1";	# shell interpreted
+} 
+else {
+  print "ok 1 # skipped: bug/feature of pdksh\n"; # shell interpreted
+}
+print "not ok 2\n" if system "echo ok 2";	# split and directly called
+print "not ok 3\n" if system "echo", "ok", "3"; # directly called
+
+# these should probably be rewritten to match the examples in perlfunc.pod
+if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
+
+if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
+print "ok 5\n";
+
+if ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";}
+
+unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
+
+exec "echo","ok","8";
diff --git a/contrib/perl5/t/op/exp.t b/contrib/perl5/t/op/exp.t
new file mode 100755
index 0000000..5efc9ba
--- /dev/null
+++ b/contrib/perl5/t/op/exp.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# $RCSfile: exp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:50 $
+
+print "1..6\n";
+
+# compile time evaluation
+
+$s = sqrt(2);
+if (substr($s,0,5) eq '1.414') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$s = exp(1);
+if (substr($s,0,7) eq '2.71828') {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (exp(log(1)) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
+
+# run time evaluation
+
+$x1 = 1;
+$x2 = 2;
+$s = sqrt($x2);
+if (substr($s,0,5) eq '1.414') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$s = exp($x1);
+if (substr($s,0,7) eq '2.71828') {print "ok 5\n";} else {print "not ok 5\n";}
+
+if (exp(log($x1)) == 1) {print "ok 6\n";} else {print "not ok 6\n";}
diff --git a/contrib/perl5/t/op/flip.t b/contrib/perl5/t/op/flip.t
new file mode 100755
index 0000000..20167f3
--- /dev/null
+++ b/contrib/perl5/t/op/flip.t
@@ -0,0 +1,29 @@
+#!./perl
+
+# $RCSfile: flip.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:52 $
+
+print "1..9\n";
+
+@a = (1,2,3,4,5,6,7,8,9,10,11,12);
+
+while ($_ = shift(@a)) {
+    if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
+    $y .= /1/../2/;
+}
+
+if ($z eq '5E0') {print "ok 6\n";} else {print "not ok 6\n";}
+
+if ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";}
+
+@a = ('a','b','c','d','e','f','g');
+
+open(of,'../Configure');
+while (<of>) {
+    (3 .. 5) && ($foo .= $_);
+}
+$x = ($foo =~ y/\n/\n/);
+
+if ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";}
+
+$x = 3.14;
+if (($x...$x) eq "1") {print "ok 9\n";} else {print "not ok 9\n";}
diff --git a/contrib/perl5/t/op/fork.t b/contrib/perl5/t/op/fork.t
new file mode 100755
index 0000000..9790ff0
--- /dev/null
+++ b/contrib/perl5/t/op/fork.t
@@ -0,0 +1,26 @@
+#!./perl
+
+# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'d_fork'}) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+$| = 1;
+print "1..2\n";
+
+if ($cid = fork) {
+    sleep 2;
+    if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";}
+}
+else {
+    $| = 1;
+    print "ok 1\n";
+    sleep 10;
+}
diff --git a/contrib/perl5/t/op/glob.t b/contrib/perl5/t/op/glob.t
new file mode 100755
index 0000000..253e4a3
--- /dev/null
+++ b/contrib/perl5/t/op/glob.t
@@ -0,0 +1,37 @@
+#!./perl
+
+# $RCSfile: glob.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:55 $
+
+print "1..6\n";
+
+@oops = @ops = <op/*>;
+
+if ($^O eq 'MSWin32') {
+  map { $files{lc($_)}++ } <op/*>;
+  map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op & dir /b /l /ah op 2>nul"`,
+}
+else {
+  map { $files{$_}++ } <op/*>;
+  map { delete $files{$_} } split /[\s\n]/, `echo op/*`;
+}
+if (keys %files) {
+	print "not ok 1\t(",join(' ', sort keys %files),"\n";
+} else { print "ok 1\n"; }
+
+print $/ eq "\n" ? "ok 2\n" : "not ok 2\n";
+
+while (<jskdfjskdfj* op/* jskdjfjkosvk*>) {
+    $not = "not " unless $_ eq shift @ops;
+    $not = "not at all " if $/ eq "\0";
+}
+print "${not}ok 3\n";
+
+print $/ eq "\n" ? "ok 4\n" : "not ok 4\n";
+
+# test the "glob" operator
+$_ = "op/*";
+@glops = glob $_;
+print "@glops" eq "@oops" ? "ok 5\n" : "not ok 5\n";
+
+@glops = glob;
+print "@glops" eq "@oops" ? "ok 6\n" : "not ok 6\n";
diff --git a/contrib/perl5/t/op/goto.t b/contrib/perl5/t/op/goto.t
new file mode 100755
index 0000000..1b34acd
--- /dev/null
+++ b/contrib/perl5/t/op/goto.t
@@ -0,0 +1,90 @@
+#!./perl
+
+# $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
+
+# "This IS structured code.  It's just randomly structured."
+
+print "1..9\n";
+
+while ($?) {
+    $foo = 1;
+  label1:
+    $foo = 2;
+    goto label2;
+} continue {
+    $foo = 0;
+    goto label4;
+  label3:
+    $foo = 4;
+    goto label4;
+}
+goto label1;
+
+$foo = 3;
+
+label2:
+print "#1\t:$foo: == 2\n";
+if ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
+goto label3;
+
+label4:
+print "#2\t:$foo: == 4\n";
+if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl';
+$x = `$PERL -e "goto foo;" 2>&1`;
+if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; }
+
+if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
+
+sub foo {
+    goto bar;
+    print "not ok 4\n";
+    return;
+bar:
+    print "ok 4\n";
+}
+
+&foo;
+
+sub bar {
+    $x = 'bypass';
+    eval "goto $x";
+}
+
+&bar;
+exit;
+
+FINALE:
+print "ok 9\n";
+exit;
+
+bypass:
+print "ok 5\n";
+
+# Test autoloading mechanism.
+
+sub two {
+    ($pack, $file, $line) = caller;	# Should indicate original call stats.
+    print "@_ $pack $file $line" eq "1 2 3 main $FILE $LINE"
+	? "ok 7\n"
+	: "not ok 7\n";
+}
+
+sub one {
+    eval <<'END';
+    sub one { print "ok 6\n"; goto &two; print "not ok 6\n"; }
+END
+    goto &one;
+}
+
+$FILE = __FILE__;
+$LINE = __LINE__ + 1;
+&one(1,2,3);
+
+$wherever = NOWHERE;
+eval { goto $wherever };
+print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
+
+$wherever = FINALE;
+goto $wherever;
diff --git a/contrib/perl5/t/op/goto_xs.t b/contrib/perl5/t/op/goto_xs.t
new file mode 100755
index 0000000..a35575e
--- /dev/null
+++ b/contrib/perl5/t/op/goto_xs.t
@@ -0,0 +1,98 @@
+#!./perl
+# tests for "goto &sub"-ing into XSUBs
+
+# $RCSfile$$Revision$$Date$
+
+# Note: This only tests things that should *work*.  At some point, it may
+#       be worth while to write some failure tests for things that should
+#       *break* (such as calls with wrong number of args).  For now, I'm
+#       guessing that if all of these work correctly, the bad ones will
+#       break correctly as well.
+
+chdir 't' if -d 't';
+@INC = "../lib";
+$ENV{PERL5LIB} = "../lib";
+
+# turn warnings into fatal errors
+$SIG{__WARN__} = sub { die "WARNING: @_" } ;
+
+BEGIN { $| = 1; }
+eval 'require Fcntl'
+  or do { print "1..0\n# Fcntl unavailable, can't test XS goto.\n"; exit 0 };
+
+print "1..10\n";
+
+# We don't know what symbols are defined in platform X's system headers.
+# We don't even want to guess, because some platform out there will
+# likely do the unthinkable.  However, Fcntl::constant("LOCK_SH",0)
+# should always return a value, even on platforms which don't define the
+# cpp symbol; Fcntl.xs says:
+#           /* We support flock() on systems which don't have it, so
+#              always supply the constants. */
+# If this ceases to be the case, we're in trouble. =)
+$VALID = 'LOCK_SH';
+
+### First, we check whether Fcntl::constant returns sane answers.
+# Fcntl::constant("LOCK_SH",0) should always succeed.
+
+$value = Fcntl::constant($VALID,0);
+print((!defined $value)
+      ? "not ok 1\n# Sanity check broke, remaining tests will fail.\n"
+      : "ok 1\n");
+
+### OK, we're ready to do real tests.
+
+# test "goto &function_constant"
+sub goto_const { goto &Fcntl::constant; }
+
+$ret = goto_const($VALID,0);
+print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n");
+
+# test "goto &$function_package_and_name"
+$FNAME1 = 'Fcntl::constant';
+sub goto_name1 { goto &$FNAME1; }
+
+$ret = goto_name1($VALID,0);
+print(($ret == $value) ? "ok 3\n" : "not ok 3\n# ($ret != $value)\n");
+
+# test "goto &$function_package_and_name" again, with dirtier stack
+$ret = goto_name1($VALID,0);
+print(($ret == $value) ? "ok 4\n" : "not ok 4\n# ($ret != $value)\n");
+$ret = goto_name1($VALID,0);
+print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n");
+
+# test "goto &$function_name" from local package
+package Fcntl;
+$FNAME2 = 'constant';
+sub goto_name2 { goto &$FNAME2; }
+package main;
+
+$ret = Fcntl::goto_name2($VALID,0);
+print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n");
+
+# test "goto &$function_ref"
+$FREF = \&Fcntl::constant;
+sub goto_ref { goto &$FREF; }
+
+$ret = goto_ref($VALID,0);
+print(($ret == $value) ? "ok 7\n" : "not ok 7\n# ($ret != $value)\n");
+
+### tests where the args are not on stack but in GvAV(defgv) (ie, @_)
+
+# test "goto &function_constant" from a sub called without arglist
+sub call_goto_const { &goto_const; }
+
+$ret = call_goto_const($VALID,0);
+print(($ret == $value) ? "ok 8\n" : "not ok 8\n# ($ret != $value)\n");
+
+# test "goto &$function_package_and_name" from a sub called without arglist
+sub call_goto_name1 { &goto_name1; }
+
+$ret = call_goto_name1($VALID,0);
+print(($ret == $value) ? "ok 9\n" : "not ok 9\n# ($ret != $value)\n");
+
+# test "goto &$function_ref" from a sub called without arglist
+sub call_goto_ref { &goto_ref; }
+
+$ret = call_goto_ref($VALID,0);
+print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n");
diff --git a/contrib/perl5/t/op/groups.t b/contrib/perl5/t/op/groups.t
new file mode 100755
index 0000000..47aabe3
--- /dev/null
+++ b/contrib/perl5/t/op/groups.t
@@ -0,0 +1,50 @@
+#!./perl
+
+if (! -x ($groups = '/usr/ucb/groups') &&
+    ! -x ($groups = '/usr/bin/groups') &&
+    ! -x ($groups = '/bin/groups')
+) {
+    print "1..0\n";
+    exit 0;
+}
+
+print "1..2\n";
+
+$pwgid = $( + 0;
+($pwgnam) = getgrgid($pwgid);
+@basegroup{$pwgid,$pwgnam} = (1,1);
+
+$seen{$pwgid}++;
+
+for (split(' ', $()) {
+    next if $seen{$_}++;
+    ($group) = getgrgid($_);
+    if (defined $group) {
+	push(@gr, $group);
+    }
+    else {
+	push(@gr, $_);
+    }
+} 
+
+$gr1 = join(' ', sort @gr);
+
+$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`$groups`)));
+
+if ($gr1 eq $gr2) {
+    print "ok 1\n";
+}
+else {
+    print "#gr1 is <$gr1>\n";
+    print "#gr2 is <$gr2>\n";
+    print "not ok 1\n";
+}
+
+# multiple 0's indicate GROUPSTYPE is currently long but should be short
+
+if ($pwgid == 0 || $seen{0} < 2) {
+    print "ok 2\n";
+}
+else {
+    print "not ok 2 (groupstype should be type short, not long)\n";
+}
diff --git a/contrib/perl5/t/op/gv.t b/contrib/perl5/t/op/gv.t
new file mode 100755
index 0000000..c253e4b
--- /dev/null
+++ b/contrib/perl5/t/op/gv.t
@@ -0,0 +1,98 @@
+#!./perl
+
+#
+# various typeglob tests
+#
+
+print "1..23\n";
+
+# type coersion on assignment
+$foo = 'foo';
+$bar = *main::foo;
+$bar = $foo;
+print ref(\$bar) eq 'SCALAR' ? "ok 1\n" : "not ok 1\n";
+$foo = *main::bar;
+
+# type coersion (not) on misc ops
+
+if ($foo) {
+  print ref(\$foo) eq 'GLOB' ? "ok 2\n" : "not ok 2\n";
+}
+
+unless ($foo =~ /abcd/) {
+  print ref(\$foo) eq 'GLOB' ? "ok 3\n" : "not ok 3\n";
+}
+
+if ($foo eq '*main::bar') {
+  print ref(\$foo) eq 'GLOB' ? "ok 4\n" : "not ok 4\n";
+}
+
+# type coersion on substitutions that match
+$a = *main::foo;
+$b = $a;
+$a =~ s/^X//;
+print ref(\$a) eq 'GLOB' ? "ok 5\n" : "not ok 5\n";
+$a =~ s/^\*//;
+print $a eq 'main::foo' ? "ok 6\n" : "not ok 6\n";
+print ref(\$b) eq 'GLOB' ? "ok 7\n" : "not ok 7\n";
+
+# typeglobs as lvalues
+substr($foo, 0, 1) = "XXX";
+print ref(\$foo) eq 'SCALAR' ? "ok 8\n" : "not ok 8\n";
+print $foo eq 'XXXmain::bar' ? "ok 9\n" : "not ok 9\n";
+
+# returning glob values
+sub foo {
+  local($bar) = *main::foo;
+  $foo = *main::bar;
+  return ($foo, $bar);
+}
+
+($fuu, $baa) = foo();
+if (defined $fuu) {
+  print ref(\$fuu) eq 'GLOB' ? "ok 10\n" : "not ok 10\n";
+}
+
+if (defined $baa) {
+  print ref(\$baa) eq 'GLOB' ? "ok 11\n" : "not ok 11\n";
+}
+
+# nested package globs
+# NOTE:  It's probably OK if these semantics change, because the
+#        fact that %X::Y:: is stored in %X:: isn't documented.
+#        (I hope.)
+
+{ package Foo::Bar }
+print exists $Foo::{'Bar::'} ? "ok 12\n" : "not ok 12\n";
+print $Foo::{'Bar::'} eq '*Foo::Bar::' ? "ok 13\n" : "not ok 13\n";
+
+# test undef operator clearing out entire glob
+$foo = 'stuff';
+@foo = qw(more stuff);
+%foo = qw(even more random stuff);
+undef *foo;
+print +($foo || @foo || %foo) ? "not ok" : "ok", " 14\n";
+
+# test warnings from assignment of undef to glob
+{
+    my $msg;
+    local $SIG{__WARN__} = sub { $msg = $_[0] };
+    local $^W = 1;
+    *foo = 'bar';
+    print $msg ? "not ok" : "ok", " 15\n";
+    *foo = undef;
+    print $msg ? "ok" : "not ok", " 16\n";
+}
+
+# test *glob{THING} syntax
+$x = "ok 17\n";
+@x = ("ok 18\n");
+%x = ("ok 19" => "\n");
+sub x { "ok 20\n" }
+print ${*x{SCALAR}}, @{*x{ARRAY}}, %{*x{HASH}}, &{*x{CODE}};
+*x = *STDOUT;
+print *{*x{GLOB}} eq "*main::STDOUT" ? "ok 21\n" : "not ok 21\n";
+print {*x{IO}} "ok 22\n";
+print {*x{FILEHANDLE}} "ok 23\n";
+
+
diff --git a/contrib/perl5/t/op/hashwarn.t b/contrib/perl5/t/op/hashwarn.t
new file mode 100755
index 0000000..6343a2a
--- /dev/null
+++ b/contrib/perl5/t/op/hashwarn.t
@@ -0,0 +1,71 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict;
+
+use vars qw{ @warnings };
+
+BEGIN {
+    $^W |= 1;		# Insist upon warnings
+    # ...and save 'em as we go
+    $SIG{'__WARN__'} = sub { push @warnings, @_ };
+    $| = 1;
+    print "1..7\n";
+}
+
+END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
+
+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;
+}
+
+sub test_warning ($$$) {
+    my($num, $got, $expected) = @_;
+    my($pattern, $ok);
+    if (($pattern) = ($expected =~ m#^/(.+)/$#s) or
+	(undef, $pattern) = ($expected =~ m#^m([^\w\s])(.+)\1$#s)) {
+	    # it's a regexp
+	    $ok = ($got =~ /$pattern/);
+	    test $num, $ok, "Expected pattern /$pattern/, got '$got'\n";
+    } else {
+	$ok = ($got eq $expected);
+	test $num, $ok, "Expected string '$expected', got '$got'\n";
+    }
+#   print "# $num: $got\n";
+}
+
+my $odd_msg = '/^Odd number of elements in hash/';
+my $ref_msg = '/^Reference found where even-sized list expected/';
+
+{
+    my %hash = (1..3);
+    test_warning 1, shift @warnings, $odd_msg;
+
+    %hash = 1;
+    test_warning 2, shift @warnings, $odd_msg;
+
+    %hash = { 1..3 };
+    test_warning 3, shift @warnings, $odd_msg;
+    test_warning 4, shift @warnings, $ref_msg;
+
+    %hash = [ 1..3 ];
+    test_warning 5, shift @warnings, $ref_msg;
+
+    %hash = sub { print "ok" };
+    test_warning 6, shift @warnings, $odd_msg;
+
+    $_ = { 1..10 };
+    test 7, ! @warnings, "Unexpected warning";
+}
diff --git a/contrib/perl5/t/op/inc.t b/contrib/perl5/t/op/inc.t
new file mode 100755
index 0000000..e5a2a92
--- /dev/null
+++ b/contrib/perl5/t/op/inc.t
@@ -0,0 +1,52 @@
+#!./perl
+
+
+# $RCSfile$
+
+print "1..6\n";
+
+# Verify that addition/subtraction properly upgrade to doubles.
+# These tests are only significant on machines with 32 bit longs,
+# and two's complement negation, but shouldn't fail anywhere.
+
+$a = 2147483647;
+$c=$a++;
+if ($a == 2147483648) 
+	{print "ok 1\n"}
+else
+	{print "not ok 1\n";}
+
+$a = 2147483647;
+$c=++$a;
+if ($a == 2147483648) 
+	{print "ok 2\n"}
+else
+	{print "not ok 2\n";}
+
+$a = 2147483647;
+$a=$a+1;
+if ($a == 2147483648) 
+	{print "ok 3\n"}
+else
+	{print "not ok 3\n";}
+
+$a = -2147483648;
+$c=$a--;
+if ($a == -2147483649) 
+	{print "ok 4\n"}
+else
+	{print "not ok 4\n";}
+
+$a = -2147483648;
+$c=--$a;
+if ($a == -2147483649) 
+	{print "ok 5\n"}
+else
+	{print "not ok 5\n";}
+
+$a = -2147483648;
+$a=$a-1;
+if ($a == -2147483649) 
+	{print "ok 6\n"}
+else
+	{print "not ok 6\n";}
diff --git a/contrib/perl5/t/op/index.t b/contrib/perl5/t/op/index.t
new file mode 100755
index 0000000..0b08f08
--- /dev/null
+++ b/contrib/perl5/t/op/index.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $RCSfile: index.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:59 $
+
+print "1..20\n";
+
+
+$foo = 'Now is the time for all good men to come to the aid of their country.';
+
+$first = substr($foo,0,index($foo,'the'));
+print ($first eq "Now is " ? "ok 1\n" : "not ok 1\n");
+
+$last = substr($foo,rindex($foo,'the'),100);
+print ($last eq "their country." ? "ok 2\n" : "not ok 2\n");
+
+$last = substr($foo,index($foo,'Now'),2);
+print ($last eq "No" ? "ok 3\n" : "not ok 3\n");
+
+$last = substr($foo,rindex($foo,'Now'),2);
+print ($last eq "No" ? "ok 4\n" : "not ok 4\n");
+
+$last = substr($foo,index($foo,'.'),100);
+print ($last eq "." ? "ok 5\n" : "not ok 5\n");
+
+$last = substr($foo,rindex($foo,'.'),100);
+print ($last eq "." ? "ok 6\n" : "not ok 6\n");
+
+print index("ababa","a",-1) == 0 ? "ok 7\n" : "not ok 7\n";
+print index("ababa","a",0) == 0 ? "ok 8\n" : "not ok 8\n";
+print index("ababa","a",1) == 2 ? "ok 9\n" : "not ok 9\n";
+print index("ababa","a",2) == 2 ? "ok 10\n" : "not ok 10\n";
+print index("ababa","a",3) == 4 ? "ok 11\n" : "not ok 11\n";
+print index("ababa","a",4) == 4 ? "ok 12\n" : "not ok 12\n";
+print index("ababa","a",5) == -1 ? "ok 13\n" : "not ok 13\n";
+
+print rindex("ababa","a",-1) == -1 ? "ok 14\n" : "not ok 14\n";
+print rindex("ababa","a",0) == 0 ? "ok 15\n" : "not ok 15\n";
+print rindex("ababa","a",1) == 0 ? "ok 16\n" : "not ok 16\n";
+print rindex("ababa","a",2) == 2 ? "ok 17\n" : "not ok 17\n";
+print rindex("ababa","a",3) == 2 ? "ok 18\n" : "not ok 18\n";
+print rindex("ababa","a",4) == 4 ? "ok 19\n" : "not ok 19\n";
+print rindex("ababa","a",5) == 4 ? "ok 20\n" : "not ok 20\n";
diff --git a/contrib/perl5/t/op/int.t b/contrib/perl5/t/op/int.t
new file mode 100755
index 0000000..eb060ac
--- /dev/null
+++ b/contrib/perl5/t/op/int.t
@@ -0,0 +1,17 @@
+#!./perl
+
+# $RCSfile: int.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:00 $
+
+print "1..4\n";
+
+# compile time evaluation
+
+if (int(1.234) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
+
+if (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";}
+
+# run time evaluation
+
+$x = 1.234;
+if (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
+if (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";}
diff --git a/contrib/perl5/t/op/join.t b/contrib/perl5/t/op/join.t
new file mode 100755
index 0000000..eec4611
--- /dev/null
+++ b/contrib/perl5/t/op/join.t
@@ -0,0 +1,12 @@
+#!./perl
+
+# $RCSfile: join.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:01 $
+
+print "1..3\n";
+
+@x = (1, 2, 3);
+if (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
+
+if (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/contrib/perl5/t/op/list.t b/contrib/perl5/t/op/list.t
new file mode 100755
index 0000000..a4230b6
--- /dev/null
+++ b/contrib/perl5/t/op/list.t
@@ -0,0 +1,83 @@
+#!./perl
+
+# $RCSfile: list.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:02 $
+
+print "1..27\n";
+
+@foo = (1, 2, 3, 4);
+if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
+
+$_ = join(':',@foo);
+if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+
+($a,$b,$c,$d) = (1,2,3,4);
+if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
+
+($c,$b,$a) = split(/ /,"111 222 333");
+if ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
+
+($a,$b,$c) = ($c,$b,$a);
+if ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5 $a;$b;$c\n";}
+
+($a, $b) = ($b, $a);
+if ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
+
+($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
+if ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
+if ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
+
+@foo = (1,2,3,4,5,6,7,8);
+($a, $b, $c, $d) = @foo;
+print "#11	$a;$b;$c;$d eq 1;2;3;4\n";
+if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = @bar = (1);
+if (join(':',@foo,@bar) eq '1:1') {print "ok 12\n";} else {print "not ok 12\n";}
+
+@foo = ();
+@foo = 1+2+3;
+if (join(':',@foo) eq '6') {print "ok 13\n";} else {print "not ok 13\n";}
+
+for ($x = 0; $x < 3; $x++) {
+    ($a, $b, $c) = 
+	    $x == 0?
+		    ('ok ', 14, "\n"):
+	    $x == 1?
+		    ('ok ', 15, "\n"):
+	    # default
+		    ('ok ', 16, "\n");
+
+    print $a,$b,$c;
+}
+
+@a = ($x == 12345 || (1,2,3));
+if (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
+
+@a = ($x == $x || (4,5,6));
+if (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
+
+if (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
+if (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
+if (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
+if (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
+if (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
+if (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
+
+for ($x = 0; $x < 3; $x++) {
+    ($a, $b, $c) = do {
+	    if ($x == 0) {
+		('ok ', 25, "\n");
+	    }
+	    elsif ($x == 1) {
+		('ok ', 26, "\n");
+	    }
+	    else {
+		('ok ', 27, "\n");
+	    }
+	};
+
+    print $a,$b,$c;
+}
+
diff --git a/contrib/perl5/t/op/local.t b/contrib/perl5/t/op/local.t
new file mode 100755
index 0000000..2f674d1
--- /dev/null
+++ b/contrib/perl5/t/op/local.t
@@ -0,0 +1,200 @@
+#!./perl
+
+# $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
+
+print "1..58\n";
+
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+
+sub foo {
+    local($a, $b) = @_;
+    local($c, $d);
+    $c = "ok 3\n";
+    $d = "ok 4\n";
+    { local($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+    print $a, $b;
+    $c . $d;
+}
+
+$a = "ok 5\n";
+$b = "ok 6\n";
+$c = "ok 7\n";
+$d = "ok 8\n";
+
+print &foo("ok 1\n","ok 2\n");
+
+print $a,$b,$c,$d,$x,$y;
+
+# same thing, only with arrays and associative arrays
+
+sub foo2 {
+    local($a, @b) = @_;
+    local(@c, %d);
+    @c = "ok 13\n";
+    $d{''} = "ok 14\n";
+    { local($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
+    print $a, @b;
+    $c[0] . $d{''};
+}
+
+$a = "ok 15\n";
+@b = "ok 16\n";
+@c = "ok 17\n";
+$d{''} = "ok 18\n";
+
+print &foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
+
+eval 'local($$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n";
+
+eval 'local(@$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
+
+eval 'local(%$e)';
+print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
+
+# Array and hash elements
+
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = 'foo';
+    local($a[2]) = $a[2];
+    print +($a[1] eq 'foo') ? "" : "not ", "ok 24\n";
+    print +($a[2] eq 'c') ? "" : "not ", "ok 25\n";
+    undef @a;
+}
+print +($a[1] eq 'b') ? "" : "not ", "ok 26\n";
+print +($a[2] eq 'c') ? "" : "not ", "ok 27\n";
+print +(!defined $a[0]) ? "" : "not ", "ok 28\n";
+
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = "X";
+    shift @a;
+}
+print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 29\n";
+
+%h = ('a' => 1, 'b' => 2, 'c' => 3);
+{
+    local($h{'a'}) = 'foo';
+    local($h{'b'}) = $h{'b'};
+    print +($h{'a'} eq 'foo') ? "" : "not ", "ok 30\n";
+    print +($h{'b'} == 2) ? "" : "not ", "ok 31\n";
+    local($h{'c'});
+    delete $h{'c'};
+}
+print +($h{'a'} == 1) ? "" : "not ", "ok 32\n";
+print +($h{'b'} == 2) ? "" : "not ", "ok 33\n";
+print +($h{'c'} == 3) ? "" : "not ", "ok 34\n";
+
+# check for scope leakage
+$a = 'outer';
+if (1) { local $a = 'inner' }
+print +($a eq 'outer') ? "" : "not ", "ok 35\n";
+
+# see if localization works when scope unwinds
+local $m = 5;
+eval {
+    for $m (6) {
+	local $m = 7;
+	die "bye";
+    }
+};
+print $m == 5 ? "" : "not ", "ok 36\n";
+
+# see if localization works on tied arrays
+{
+    package TA;
+    sub TIEARRAY { bless [], $_[0] }
+    sub STORE { print "# STORE [@_]\n"; $_[0]->[$_[1]] = $_[2] }
+    sub FETCH { my $v = $_[0]->[$_[1]]; print "# FETCH [@_=$v]\n"; $v }
+    sub CLEAR { print "# CLEAR [@_]\n"; @{$_[0]} = (); }
+    sub FETCHSIZE { scalar(@{$_[0]}) }
+    sub SHIFT { shift (@{$_[0]}) }
+    sub EXTEND {}
+}
+
+tie @a, 'TA';
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = 'foo';
+    local($a[2]) = $a[2];
+    print +($a[1] eq 'foo') ? "" : "not ", "ok 37\n";
+    print +($a[2] eq 'c') ? "" : "not ", "ok 38\n";
+    @a = ();
+}
+print +($a[1] eq 'b') ? "" : "not ", "ok 39\n";
+print +($a[2] eq 'c') ? "" : "not ", "ok 40\n";
+print +(!defined $a[0]) ? "" : "not ", "ok 41\n";
+
+{
+    package TH;
+    sub TIEHASH { bless {}, $_[0] }
+    sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] }
+    sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v }
+    sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; }
+    sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); }
+}
+
+# see if localization works on tied hashes
+tie %h, 'TH';
+%h = ('a' => 1, 'b' => 2, 'c' => 3);
+
+{
+    local($h{'a'}) = 'foo';
+    local($h{'b'}) = $h{'b'};
+    print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n";
+    print +($h{'b'} == 2) ? "" : "not ", "ok 43\n";
+    local($h{'c'});
+    delete $h{'c'};
+}
+print +($h{'a'} == 1) ? "" : "not ", "ok 44\n";
+print +($h{'b'} == 2) ? "" : "not ", "ok 45\n";
+print +($h{'c'} == 3) ? "" : "not ", "ok 46\n";
+
+@a = ('a', 'b', 'c');
+{
+    local($a[1]) = "X";
+    shift @a;
+}
+print +($a[0].$a[1] eq "Xb") ? "" : "not ", "ok 47\n";
+
+# now try the same for %SIG
+
+$SIG{TERM} = 'foo';
+$SIG{INT} = \&foo;
+$SIG{__WARN__} = $SIG{INT};
+{
+    local($SIG{TERM}) = $SIG{TERM};
+    local($SIG{INT}) = $SIG{INT};
+    local($SIG{__WARN__}) = $SIG{__WARN__};
+    print +($SIG{TERM}		eq 'main::foo') ? "" : "not ", "ok 48\n";
+    print +($SIG{INT}		eq \&foo) ? "" : "not ", "ok 49\n";
+    print +($SIG{__WARN__}	eq \&foo) ? "" : "not ", "ok 50\n";
+    local($SIG{INT});
+    delete $SIG{__WARN__};
+}
+print +($SIG{TERM}	eq 'main::foo') ? "" : "not ", "ok 51\n";
+print +($SIG{INT}	eq \&foo) ? "" : "not ", "ok 52\n";
+print +($SIG{__WARN__}	eq \&foo) ? "" : "not ", "ok 53\n";
+
+# and for %ENV
+
+$ENV{_X_} = 'a';
+$ENV{_Y_} = 'b';
+$ENV{_Z_} = 'c';
+{
+    local($ENV{_X_}) = 'foo';
+    local($ENV{_Y_}) = $ENV{_Y_};
+    print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n";
+    print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 55\n";
+    local($ENV{_Z_});
+    delete $ENV{_Z_};
+}
+print +($ENV{_X_} eq 'a') ? "" : "not ", "ok 56\n";
+print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 57\n";
+print +($ENV{_Z_} eq 'c') ? "" : "not ", "ok 58\n";
+
diff --git a/contrib/perl5/t/op/magic.t b/contrib/perl5/t/op/magic.t
new file mode 100755
index 0000000..7f08e06
--- /dev/null
+++ b/contrib/perl5/t/op/magic.t
@@ -0,0 +1,209 @@
+#!./perl
+
+BEGIN {
+    $^W = 1;
+    $| = 1;
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
+}
+
+sub ok {
+    my ($n, $result, $info) = @_;
+    if ($result) {
+	print "ok $n\n";
+    }
+    else {
+    	print "not ok $n\n";
+	print "# $info\n" if $info;
+    }
+}
+
+$Is_MSWin32 = $^O eq 'MSWin32';
+$Is_VMS     = $^O eq 'VMS';
+$Is_Dos   = $^O eq 'dos';
+$PERL = ($Is_MSWin32 ? '.\perl' : './perl');
+
+print "1..35\n";
+
+eval '$ENV{"FOO"} = "hi there";';	# check that ENV is inited inside eval
+if ($Is_MSWin32) { ok 1, `cmd /x /c set FOO` eq "FOO=hi there\n"; }
+else             { ok 1, `echo \$FOO` eq "hi there\n"; }
+
+unlink 'ajslkdfpqjsjfk';
+$! = 0;
+open(FOO,'ajslkdfpqjsjfk');
+ok 2, $!, $!;
+close FOO; # just mention it, squelch used-only-once
+
+if ($Is_MSWin32 || $Is_Dos) {
+    ok "3 # skipped",1;
+    ok "4 # skipped",1;
+}
+else {
+  # the next tests are embedded inside system simply because sh spits out
+  # a newline onto stderr when a child process kills itself with SIGINT.
+  system './perl', '-e', <<'END';
+
+    $| = 1;		# command buffering
+
+    $SIG{"INT"} = "ok3";     kill "INT",$$; sleep 1;
+    $SIG{"INT"} = "IGNORE";  kill "INT",$$; sleep 1; print "ok 4\n";
+    $SIG{"INT"} = "DEFAULT"; kill "INT",$$; sleep 1; print "not ok\n";
+
+    sub ok3 {
+	if (($x = pop(@_)) eq "INT") {
+	    print "ok 3\n";
+	}
+	else {
+	    print "not ok 3 ($x @_)\n";
+	}
+    }
+
+END
+}
+
+# can we slice ENV?
+@val1 = @ENV{keys(%ENV)};
+@val2 = values(%ENV);
+ok 5, join(':',@val1) eq join(':',@val2);
+ok 6, @val1 > 1;
+
+# regex vars
+'foobarbaz' =~ /b(a)r/;
+ok 7, $` eq 'foo', $`;
+ok 8, $& eq 'bar', $&;
+ok 9, $' eq 'baz', $';
+ok 10, $+ eq 'a', $+;
+
+# $"
+@a = qw(foo bar baz);
+ok 11, "@a" eq "foo bar baz", "@a";
+{
+    local $" = ',';
+    ok 12, "@a" eq "foo,bar,baz", "@a";
+}
+
+# $;
+%h = ();
+$h{'foo', 'bar'} = 1;
+ok 13, (keys %h)[0] eq "foo\034bar", (keys %h)[0];
+{
+    local $; = 'x';
+    %h = ();
+    $h{'foo', 'bar'} = 1;
+    ok 14, (keys %h)[0] eq 'fooxbar', (keys %h)[0];
+}
+
+# $?, $@, $$
+system qq[$PERL -e "exit(0)"];
+ok 15, $? == 0, $?;
+system qq[$PERL -e "exit(1)"];
+ok 16, $? != 0, $?;
+
+eval { die "foo\n" };
+ok 17, $@ eq "foo\n", $@;
+
+ok 18, $$ > 0, $$;
+
+# $^X and $0
+{
+    if ($^O eq 'qnx') {
+	chomp($wd = `/usr/bin/fullpath -t`);
+    }
+    else {
+	$wd = '.';
+    }
+    my $perl = "$wd/perl";
+    my $headmaybe = '';
+    my $tailmaybe = '';
+    $script = "$wd/show-shebang";
+    if ($Is_MSWin32) {
+	chomp($wd = `cd`);
+	$perl = "$wd\\perl.exe";
+	$script = "$wd\\show-shebang.bat";
+	$headmaybe = <<EOH ;
+\@rem ='
+\@echo off
+$perl -x \%0
+goto endofperl
+\@rem ';
+EOH
+	$tailmaybe = <<EOT ;
+
+__END__
+:endofperl
+EOT
+    }
+    if ($^O eq 'os390') {  # no shebang
+	$headmaybe = <<EOH ;
+    eval 'exec ./perl -S \$0 \${1+"\$\@"}'
+        if 0;
+EOH
+    }
+    $s1 = $s2 = "\$^X is $perl, \$0 is $script\n";
+    ok 19, open(SCRIPT, ">$script"), $!;
+    ok 20, print(SCRIPT $headmaybe . <<EOB . <<'EOF' . $tailmaybe), $!;
+#!$wd/perl
+EOB
+print "\$^X is $^X, \$0 is $0\n";
+EOF
+    ok 21, close(SCRIPT), $!;
+    ok 22, chmod(0755, $script), $!;
+    $_ = `$script`;
+    s/.exe//i if $Is_Dos;
+    s{\bminiperl\b}{perl}; # so that test doesn't fail with miniperl
+    s{is perl}{is $perl}; # for systems where $^X is only a basename
+    ok 23, ($Is_MSWin32 ? uc($_) eq uc($s2) : $_ eq $s2), ":$_:!=:$s2:";
+    $_ = `$perl $script`;
+    s/.exe//i if $Is_Dos;
+    ok 24, ($Is_MSWin32 ? uc($_) eq uc($s1) : $_ eq $s1), ":$_:!=:$s1: after `$perl $script`";
+    ok 25, unlink($script), $!;
+}
+
+# $], $^O, $^T
+ok 26, $] >= 5.00319, $];
+ok 27, $^O;
+ok 28, $^T > 850000000, $^T;
+
+if ($Is_VMS || $Is_Dos) {
+	ok "29 # skipped", 1;
+	ok "30 # skipped", 1;
+}
+else {
+	$PATH = $ENV{PATH};
+	$ENV{foo} = "bar";
+	%ENV = ();
+	$ENV{PATH} = $PATH;
+	ok 29, ($Is_MSWin32 ? (`cmd /x /c set foo 2>NUL` eq "")
+				: (`echo \$foo` eq "\n") );
+
+	$ENV{NoNeSuCh} = "foo";
+	$0 = "bar";
+	ok 30, ($Is_MSWin32 ? (`cmd /x /c set NoNeSuCh` eq "NoNeSuCh=foo\n")
+						: (`echo \$NoNeSuCh` eq "foo\n") );
+}
+
+{
+    local $SIG{'__WARN__'} = sub { print "not " };
+    $! = undef;
+    print "ok 31\n";
+}
+
+# test case-insignificance of %ENV (these tests must be enabled only
+# when perl is compiled with -DENV_IS_CASELESS)
+if ($Is_MSWin32) {
+    %ENV = ();
+    $ENV{'Foo'} = 'bar';
+    $ENV{'fOo'} = 'baz';
+    ok 32, (scalar(keys(%ENV)) == 1);
+    ok 33, exists($ENV{'FOo'});
+    ok 34, (delete($ENV{'foO'}) eq 'baz');
+    ok 35, (scalar(keys(%ENV)) == 0);
+}
+else {
+    ok "32 # skipped",1;
+    ok "33 # skipped",1;
+    ok "34 # skipped",1;
+    ok "35 # skipped",1;
+}
diff --git a/contrib/perl5/t/op/method.t b/contrib/perl5/t/op/method.t
new file mode 100755
index 0000000..f1b1888
--- /dev/null
+++ b/contrib/perl5/t/op/method.t
@@ -0,0 +1,128 @@
+#!./perl
+
+#
+# test method calls and autoloading.
+#
+
+print "1..26\n";
+
+@A::ISA = 'B';
+@B::ISA = 'C';
+
+sub C::d {"C::d"}
+sub D::d {"D::d"}
+
+my $cnt = 0;
+sub test {
+  print "# got `$_[0]', expected `$_[1]'\nnot " unless $_[0] eq $_[1]; 
+  # print "not " unless shift eq shift;
+  print "ok ", ++$cnt, "\n"
+}
+
+test( A->d, "C::d");		# Update hash table;
+
+*B::d = \&D::d;			# Import now.
+test (A->d, "D::d");		# Update hash table;
+
+{
+    local @A::ISA = qw(C);	# Update hash table with split() assignment
+    test (A->d, "C::d");
+    $#A::ISA = -1;
+    test (eval { A->d } || "fail", "fail");
+}
+test (A->d, "D::d");
+
+{
+    local *B::d;
+    eval 'sub B::d {"B::d1"}';	# Import now.
+    test (A->d, "B::d1");	# Update hash table;
+    undef &B::d;
+    test ((eval { A->d }, ($@ =~ /Undefined subroutine/)), 1);
+}
+
+test (A->d, "D::d");		# Back to previous state
+
+eval 'sub B::d {"B::d2"}';	# Import now.
+test (A->d, "B::d2");		# Update hash table;
+
+# What follows is hardly guarantied to work, since the names in scripts
+# are already linked to "pruned" globs. Say, `undef &B::d' if it were
+# after `delete $B::{d}; sub B::d {}' would reach an old subroutine.
+
+undef &B::d;
+delete $B::{d};
+test (A->d, "C::d");		# Update hash table;
+
+eval 'sub B::d {"B::d3"}';	# Import now.
+test (A->d, "B::d3");		# Update hash table;
+
+delete $B::{d};
+*dummy::dummy = sub {};		# Mark as updated
+test (A->d, "C::d");
+
+eval 'sub B::d {"B::d4"}';	# Import now.
+test (A->d, "B::d4");		# Update hash table;
+
+delete $B::{d};			# Should work without any help too
+test (A->d, "C::d");
+
+{
+    local *C::d;
+    test (eval { A->d } || "nope", "nope");
+}
+test (A->d, "C::d");
+
+*A::x = *A::d;			# See if cache incorrectly follows synonyms
+A->d;
+test (eval { A->x } || "nope", "nope");
+
+eval <<'EOF';
+sub C::e;
+BEGIN { *B::e = \&C::e }	# Shouldn't prevent AUTOLOAD in original pkg
+sub Y::f;
+$counter = 0;
+
+@X::ISA = 'Y';
+@Y::ISA = 'B';
+
+sub B::AUTOLOAD {
+  my $c = ++$counter;
+  my $method = $B::AUTOLOAD; 
+  my $msg = "B: In $method, $c";
+  eval "sub $method { \$msg }";
+  goto &$method;
+}
+sub C::AUTOLOAD {
+  my $c = ++$counter;
+  my $method = $C::AUTOLOAD; 
+  my $msg = "C: In $method, $c";
+  eval "sub $method { \$msg }";
+  goto &$method;
+}
+EOF
+
+test(A->e(), "C: In C::e, 1");	# We get a correct autoload
+test(A->e(), "C: In C::e, 1");	# Which sticks
+
+test(A->ee(), "B: In A::ee, 2"); # We get a generic autoload, method in top
+test(A->ee(), "B: In A::ee, 2"); # Which sticks
+
+test(Y->f(), "B: In Y::f, 3");	# We vivify a correct method
+test(Y->f(), "B: In Y::f, 3");	# Which sticks
+
+# This test is not intended to be reasonable. It is here just to let you
+# know that you broke some old construction. Feel free to rewrite the test
+# if your patch breaks it.
+
+*B::AUTOLOAD = sub {
+  my $c = ++$counter;
+  my $method = $AUTOLOAD; 
+  *$AUTOLOAD = sub { "new B: In $method, $c" };
+  goto &$AUTOLOAD;
+};
+
+test(A->eee(), "new B: In A::eee, 4");	# We get a correct $autoload
+test(A->eee(), "new B: In A::eee, 4");	# Which sticks
+
+# this test added due to bug discovery
+test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
diff --git a/contrib/perl5/t/op/misc.t b/contrib/perl5/t/op/misc.t
new file mode 100755
index 0000000..7292ffe
--- /dev/null
+++ b/contrib/perl5/t/op/misc.t
@@ -0,0 +1,420 @@
+#!./perl
+
+# NOTE: Please don't add tests to this file unless they *need* to be run in
+# separate executable and can't simply use eval.
+
+chdir 't' if -d 't';
+@INC = "../lib";
+$ENV{PERL5LIB} = "../lib";
+
+$|=1;
+
+undef $/;
+@prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+$tmpfile = "misctmp000";
+1 while -f ++$tmpfile;
+END { unlink $tmpfile if $tmpfile; }
+
+$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat');
+
+for (@prgs){
+    my $switch;
+    if (s/^\s*(-\w.*)//){
+	$switch = $1;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ($^O eq 'MSWin32') {
+      open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1";
+    }
+    else {
+      open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+    }
+    print TEST $prog, "\n";
+    close TEST;
+    $status = $?;
+    $results = `$CAT $tmpfile`;
+    $results =~ s/\n+$//;
+    $results =~ s/syntax error/syntax error/i;
+    $expected =~ s/\n+$//;
+    if ( $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";
+}
+
+__END__
+()=()
+########
+$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
+EXPECT
+a := b := c
+########
+$cusp = ~0 ^ (~0 >> 1);
+$, = " ";
+print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
+EXPECT
+7 0 0 1 !
+########
+$foo=undef; $foo->go;
+EXPECT
+Can't call method "go" on an undefined value at - line 1.
+########
+BEGIN
+        {
+	    "foo";
+        }
+########
+$array[128]=1
+########
+$x=0x0eabcd; print $x->ref;
+EXPECT
+Can't call method "ref" without a package or object reference at - line 1.
+########
+chop ($str .= <STDIN>);
+########
+close ($banana);
+########
+$x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
+EXPECT
+25
+########
+eval {sub bar {print "In bar";}}
+########
+system './perl -ne "print if eof" /dev/null'
+########
+chop($file = <>);
+########
+package N;
+sub new {my ($obj,$n)=@_; bless \$n}  
+$aa=new N 1;
+$aa=12345;
+print $aa;
+EXPECT
+12345
+########
+%@x=0;
+EXPECT
+Can't modify hash deref in repeat at - line 1, near "0;"
+Execution of - aborted due to compilation errors.
+########
+$_="foo";
+printf(STDOUT "%s\n", $_);
+EXPECT
+foo
+########
+push(@a, 1, 2, 3,)
+########
+quotemeta ""
+########
+for ("ABCDE") {
+ &sub;
+s/./&sub($&)/eg;
+print;}
+sub sub {local($_) = @_;
+$_ x 4;}
+EXPECT
+Modification of a read-only value attempted at - line 3.
+########
+package FOO;sub new {bless {FOO => BAR}};
+package main;
+use strict vars;   
+my $self = new FOO;
+print $$self{FOO};
+EXPECT
+BAR
+########
+$_="foo";
+s/.{1}//s;
+print;
+EXPECT
+oo
+########
+print scalar ("foo","bar")
+EXPECT
+bar
+########
+sub by_number { $a <=> $b; };# inline function for sort below
+$as_ary{0}="a0";
+@ordered_array=sort by_number keys(%as_ary);
+########
+sub NewShell
+{
+  local($Host) = @_;
+  my($m2) = $#Shells++;
+  $Shells[$m2]{HOST} = $Host;
+  return $m2;
+}
+ 
+sub ShowShell
+{
+  local($i) = @_;
+}
+ 
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+&ShowShell(&NewShell(beach,Work,"+0+0"));
+########
+   {
+       package FAKEARRAY;
+   
+       sub TIEARRAY
+       { print "TIEARRAY @_\n"; 
+         die "bomb out\n" unless $count ++ ;
+         bless ['foo'] 
+       }
+       sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
+       sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
+       sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
+   }
+   
+eval 'tie @h, FAKEARRAY, fred' ;
+tie @h, FAKEARRAY, fred ;
+EXPECT
+TIEARRAY FAKEARRAY fred
+TIEARRAY FAKEARRAY fred
+DESTROY 
+########
+BEGIN { die "phooey\n" }
+EXPECT
+phooey
+BEGIN failed--compilation aborted at - line 1.
+########
+BEGIN { 1/$zero }
+EXPECT
+Illegal division by zero at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+########
+BEGIN { undef = 0 }
+EXPECT
+Modification of a read-only value attempted at - line 1.
+BEGIN failed--compilation aborted at - line 1.
+########
+{
+    package foo;
+    sub PRINT {
+        shift;
+        print join(' ', reverse @_)."\n";
+    }
+    sub PRINTF {
+        shift;
+	  my $fmt = shift;
+        print sprintf($fmt, @_)."\n";
+    }
+    sub TIEHANDLE {
+        bless {}, shift;
+    }
+    sub READLINE {
+	"Out of inspiration";
+    }
+    sub DESTROY {
+	print "and destroyed as well\n";
+  }
+  sub READ {
+      shift;
+      print STDOUT "foo->can(READ)(@_)\n";
+      return 100; 
+  }
+  sub GETC {
+      shift;
+      print STDOUT "Don't GETC, Get Perl\n";
+      return "a"; 
+  }    
+}
+{
+    local(*FOO);
+    tie(*FOO,'foo');
+    print FOO "sentence.", "reversed", "a", "is", "This";
+    print "-- ", <FOO>, " --\n";
+    my($buf,$len,$offset);
+    $buf = "string";
+    $len = 10; $offset = 1;
+    read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed";
+    getc(FOO) eq "a" or die "foo->GETC failed";
+    printf "%s is number %d\n", "Perl", 1;
+}
+EXPECT
+This is a reversed sentence.
+-- Out of inspiration --
+foo->can(READ)(string 10 1)
+Don't GETC, Get Perl
+Perl is number 1
+and destroyed as well
+########
+my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
+EXPECT
+2 2 2
+########
+@a = ($a, $b, $c, $d) = (5, 6);
+print "ok\n"
+  if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]);
+EXPECT
+ok
+########
+print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000);
+EXPECT
+ok
+########
+print "ok\n" if ("\0" lt "\xFF");
+EXPECT
+ok
+########
+open(H,'op/misc.t'); # must be in the 't' directory
+stat(H);
+print "ok\n" if (-e _ and -f _ and -r _);
+EXPECT
+ok
+########
+sub thing { 0 || return qw(now is the time) }
+print thing(), "\n";
+EXPECT
+nowisthetime
+########
+$ren = 'joy';
+$stimpy = 'happy';
+{ local $main::{ren} = *stimpy; print $ren, ' ' }
+print $ren, "\n";
+EXPECT
+happy joy
+########
+$stimpy = 'happy';
+{ local $main::{ren} = *stimpy; print ${'ren'}, ' ' }
+print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n";
+EXPECT
+happy joy
+########
+package p;
+sub func { print 'really ' unless wantarray; 'p' }
+sub groovy { 'groovy' }
+package main;
+print p::func()->groovy(), "\n"
+EXPECT
+really groovy
+########
+@list = ([ 'one', 1 ], [ 'two', 2 ]);
+sub func { $num = shift; (grep $_->[1] == $num, @list)[0] }
+print scalar(map &func($_), 1 .. 3), " ",
+      scalar(map scalar &func($_), 1 .. 3), "\n";
+EXPECT
+2 3
+########
+($k, $s)  = qw(x 0);
+@{$h{$k}} = qw(1 2 4);
+for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
+print "bogus\n" unless $s == 7;
+########
+my $a = 'outer';
+eval q[ my $a = 'inner'; eval q[ print "$a " ] ];
+eval { my $x = 'peace'; eval q[ print "$x\n" ] }
+EXPECT
+inner peace
+########
+-w
+$| = 1;
+sub foo {
+    print "In foo1\n";
+    eval 'sub foo { print "In foo2\n" }';
+    print "Exiting foo1\n";
+}
+foo;
+foo;
+EXPECT
+In foo1
+Subroutine foo redefined at (eval 1) line 1.
+Exiting foo1
+In foo2
+########
+$s = 0;
+map {#this newline here tickles the bug
+$s += $_} (1,2,4);
+print "eat flaming death\n" unless ($s == 7);
+########
+sub foo { local $_ = shift; split; @_ }
+@x = foo(' x  y  z ');
+print "you die joe!\n" unless "@x" eq 'x y z';
+########
+/(?{"{"})/	# Check it outside of eval too
+EXPECT
+Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
+/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1.
+########
+/(?{"{"}})/	# Check it outside of eval too
+EXPECT
+Unmatched right bracket at (re_eval 1) line 1, at end of line
+syntax error at (re_eval 1) line 1, near ""{"}"
+Compilation failed in regexp at - line 1.
+########
+BEGIN { @ARGV = qw(a b c) }
+BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
+END { print "end <",shift,">\nargv <@ARGV>\n" }
+INIT { print "init <",shift,">\n" }
+EXPECT
+argv <a b c>
+begin <a>
+init <b>
+end <c>
+argv <>
+########
+-l
+# fdopen from a system descriptor to a system descriptor used to close
+# the former.
+open STDERR, '>&=STDOUT' or die $!;
+select STDOUT; $| = 1; print fileno STDOUT;
+select STDERR; $| = 1; print fileno STDERR;
+EXPECT
+1
+2
+########
+-w
+sub testme { my $a = "test"; { local $a = "new test"; print $a }}
+EXPECT
+Can't localize lexical variable $a at - line 2.
+########
+package X;
+sub ascalar { my $r; bless \$r }
+sub DESTROY { print "destroyed\n" };
+package main;
+*s = ascalar X;
+EXPECT
+destroyed
+########
+package X;
+sub anarray { bless [] }
+sub DESTROY { print "destroyed\n" };
+package main;
+*a = anarray X;
+EXPECT
+destroyed
+########
+package X;
+sub ahash { bless {} }
+sub DESTROY { print "destroyed\n" };
+package main;
+*h = ahash X;
+EXPECT
+destroyed
+########
+package X;
+sub aclosure { my $x; bless sub { ++$x } }
+sub DESTROY { print "destroyed\n" };
+package main;
+*c = aclosure X;
+EXPECT
+destroyed
+########
+package X;
+sub any { bless {} }
+my $f = "FH000"; # just to thwart any future optimisations
+sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
+sub DESTROY { print "destroyed\n" }
+package main;
+$x = any X; # to bump sv_objcount. IO objs aren't counted??
+*f = afh X;
+EXPECT
+destroyed
+destroyed
+########
diff --git a/contrib/perl5/t/op/mkdir.t b/contrib/perl5/t/op/mkdir.t
new file mode 100755
index 0000000..5ba0a0f
--- /dev/null
+++ b/contrib/perl5/t/op/mkdir.t
@@ -0,0 +1,18 @@
+#!./perl
+
+# $RCSfile: mkdir.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:06 $
+
+print "1..7\n";
+
+$^O eq 'MSWin32' ? `del /s /q blurfl 2>&1` : `rm -rf blurfl`;
+
+# tests 3 and 7 rather naughtily expect English error messages
+$ENV{'LC_ALL'} = 'C';
+
+print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
+print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
+print ($! =~ /exist|denied/ ? "ok 3\n" : "# $!\nnot ok 3\n");
+print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
+print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
+print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
+print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
diff --git a/contrib/perl5/t/op/my.t b/contrib/perl5/t/op/my.t
new file mode 100755
index 0000000..1777e88
--- /dev/null
+++ b/contrib/perl5/t/op/my.t
@@ -0,0 +1,94 @@
+#!./perl
+
+# $RCSfile: my.t,v $
+
+print "1..30\n";
+
+sub foo {
+    my($a, $b) = @_;
+    my $c;
+    my $d;
+    $c = "ok 3\n";
+    $d = "ok 4\n";
+    { my($a, undef, $c) = ("ok 9\n", "not ok 10\n", "ok 10\n");
+      ($x, $y) = ($a, $c); }
+    print $a, $b;
+    $c . $d;
+}
+
+$a = "ok 5\n";
+$b = "ok 6\n";
+$c = "ok 7\n";
+$d = "ok 8\n";
+
+print &foo("ok 1\n","ok 2\n");
+
+print $a,$b,$c,$d,$x,$y;
+
+# same thing, only with arrays and associative arrays
+
+sub foo2 {
+    my($a, @b) = @_;
+    my(@c, %d);
+    @c = "ok 13\n";
+    $d{''} = "ok 14\n";
+    { my($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
+    print $a, @b;
+    $c[0] . $d{''};
+}
+
+$a = "ok 15\n";
+@b = "ok 16\n";
+@c = "ok 17\n";
+$d{''} = "ok 18\n";
+
+print &foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
+
+my $i = "outer";
+
+if (my $i = "inner") {
+    print "not " if $i ne "inner";
+}
+print "ok 21\n";
+
+if ((my $i = 1) == 0) {
+    print "not ";
+}
+else {
+    print "not" if $i != 1;
+}
+print "ok 22\n";
+
+my $j = 5;
+while (my $i = --$j) {
+    print("not "), last unless $i > 0;
+}
+continue {
+    print("not "), last unless $i > 0;
+}
+print "ok 23\n";
+
+$j = 5;
+for (my $i = 0; (my $k = $i) < $j; ++$i) {
+    print("not "), last unless $i >= 0 && $i < $j && $i == $k;
+}
+print "ok 24\n";
+print "not " if defined $k;
+print "ok 25\n";
+
+foreach my $i (26, 27) {
+    print "ok $i\n";
+}
+
+print "not " if $i ne "outer";
+print "ok 28\n";
+
+# Ensure that C<my @y> (without parens) doesn't force scalar context.
+my @x;
+{ @x = my @y }
+print +(@x ? "not " : ""), "ok 29\n";
+{ @x = my %y }
+print +(@x ? "not " : ""), "ok 30\n";
+
diff --git a/contrib/perl5/t/op/nothread.t b/contrib/perl5/t/op/nothread.t
new file mode 100755
index 0000000..a0d444d
--- /dev/null
+++ b/contrib/perl5/t/op/nothread.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# NOTE: Please don't add tests to this file unless they *need* to be run in
+# separate executable and can't simply use eval.
+
+BEGIN
+ {
+  chdir 't' if -d 't';
+  @INC = "../lib";
+  require Config;
+  import Config;
+  if ($Config{'usethreads'})
+   {
+    print "1..0\n";
+    exit 0;
+   }
+ }
+
+
+$|=1;
+
+print "1..9\n";
+$t = 1;
+sub foo { local(@_) = ('p', 'q', 'r'); }
+sub bar { unshift @_, 'D'; @_ }
+sub baz { push @_, 'E'; return @_ }
+for (1..3) 
+ { 
+   print "not " unless join('',foo('a', 'b', 'c')) eq 'pqr';
+   print "ok ",$t++,"\n";
+   print "not" unless join('',bar('d')) eq 'Dd';
+   print "ok ",$t++,"\n";
+   print "not" unless join('',baz('e')) eq 'eE';
+   print "ok ",$t++,"\n";
+ } 
diff --git a/contrib/perl5/t/op/oct.t b/contrib/perl5/t/op/oct.t
new file mode 100755
index 0000000..24b5c43
--- /dev/null
+++ b/contrib/perl5/t/op/oct.t
@@ -0,0 +1,14 @@
+#!./perl
+
+# $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
+
+print "1..8\n";
+
+print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
+print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
+print +(hex('01234') == 0x1234) ? "ok" : "not ok", " 3\n";
+print +(oct('20000000000') == 020000000000) ? "ok" : "not ok", " 4\n";
+print +(oct('x80000000') == 0x80000000) ? "ok" : "not ok", " 5\n";
+print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
+print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
+print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
diff --git a/contrib/perl5/t/op/ord.t b/contrib/perl5/t/op/ord.t
new file mode 100755
index 0000000..ba943f4
--- /dev/null
+++ b/contrib/perl5/t/op/ord.t
@@ -0,0 +1,18 @@
+#!./perl
+
+# $RCSfile: ord.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:09 $
+
+print "1..3\n";
+
+# compile time evaluation
+
+# 65	ASCII
+# 193	EBCDIC
+if (ord('A') == 65 || ord('A') == 193) {print "ok 1\n";} else {print "not ok 1\n";}
+
+# run time evaluation
+
+$x = 'ABC';
+if (ord($x) == 65 || ord($x) == 193) {print "ok 2\n";} else {print "not ok 2\n";}
+
+if (chr 65 == 'A' || chr 193 == 'A') {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/contrib/perl5/t/op/pack.t b/contrib/perl5/t/op/pack.t
new file mode 100755
index 0000000..9b7bc35
--- /dev/null
+++ b/contrib/perl5/t/op/pack.t
@@ -0,0 +1,205 @@
+#!./perl
+
+# $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
+
+print "1..60\n";
+
+$format = "c2 x5 C C x s d i l a6";
+# Need the expression in here to force ary[5] to be numeric.  This avoids
+# test2 failing because ary2 goes str->numeric->str and ary doesn't.
+@ary = (1,-100,127,128,32767,987.654321098 / 100.0,12345,123456,"abcdef");
+$foo = pack($format,@ary);
+@ary2 = unpack($format,$foo);
+
+print ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n");
+
+$out1=join(':',@ary);
+$out2=join(':',@ary2);
+print ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n");
+
+print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n");
+
+# How about counting bits?
+
+print +($x = unpack("%32B*", "\001\002\004\010\020\040\100\200\377")) == 16
+	? "ok 4\n" : "not ok 4 $x\n";
+
+print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
+	? "ok 5\n" : "not ok 5 $x\n";
+
+print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
+	? "ok 6\n" : "not ok 6 $x\n";
+
+my $sum = 129; # ASCII
+$sum = 103 if ($^O eq 'os390'); # An EBCDIC variant.
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
+	? "ok 7\n" : "not ok 7 $x\n";
+
+open(BIN, "./perl") || open(BIN, "./perl.exe") 
+    || die "Can't open ../perl or ../perl.exe: $!\n";
+sysread BIN, $foo, 8192;
+close BIN;
+
+$sum = unpack("%32b*", $foo);
+$longway = unpack("b*", $foo);
+print $sum == $longway =~ tr/1/1/ ? "ok 8\n" : "not ok 8\n";
+
+print +($x = unpack("I",pack("I", 0xFFFFFFFF))) == 0xFFFFFFFF
+	? "ok 9\n" : "not ok 9 $x\n";
+
+# check 'w'
+my $test=10;
+my @x = (5,130,256,560,32000,3097152,268435455,1073741844,
+         '4503599627365785','23728385234614992549757750638446');
+my $x = pack('w*', @x);
+my $y = pack 'H*', '0581028200843081fa0081bd8440ffffff7f848080801487ffffffffffdb19caefe8e1eeeea0c2e1e3e8ede1ee6e';
+
+print $x eq $y ? "ok $test\n" : "not ok $test\n"; $test++;
+
+@y = unpack('w*', $y);
+my $a;
+while ($a = pop @x) {
+  my $b = pop @y;
+  print $a eq $b ? "ok $test\n" : "not ok $test\n$a\n$b\n"; $test++;
+}
+
+@y = unpack('w2', $x);
+
+print scalar(@y) == 2 ? "ok $test\n" : "not ok $test\n"; $test++;
+print $y[1] == 130 ? "ok $test\n" : "not ok $test\n"; $test++;
+
+# test exeptions
+eval { $x = unpack 'w', pack 'C*', 0xff, 0xff};
+print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
+
+eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff};
+print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
+
+eval { $x = unpack 'w', pack 'C*', 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};
+print $@ ne '' ? "ok $test\n" : "not ok $test\n"; $test++;
+
+#
+# test the "p" template
+
+# literals
+print((unpack("p",pack("p","foo")) eq "foo" ? "ok " : "not ok "),$test++,"\n");
+
+# scalars
+print((unpack("p",pack("p",$test)) == $test ? "ok " : "not ok "),$test++,"\n");
+
+# temps
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+{
+  local $^W = 1;
+  my $last = $test;
+  local $SIG{__WARN__} = sub {
+	print "ok ",$test++,"\n" if $_[0] =~ /temporary val/
+  };
+  my $junk = pack("p", &foo);
+  print "not ok ", $test++, "\n" if $last == $test;
+}
+
+# undef should give null pointer
+print((pack("p", undef) =~ /^\0+/ ? "ok " : "not ok "),$test++,"\n");
+
+# Check for optimizer bug (e.g.  Digital Unix GEM cc with -O4 on DU V4.0B gives
+#                                4294967295 instead of -1)
+#				 see #ifdef __osf__ in pp.c pp_unpack
+# Test 30:
+print( ((unpack("i",pack("i",-1))) == -1 ? "ok " : "not ok "),$test++,"\n");
+
+# 31..36: test the pack lengths of s S i I l L
+print "not " unless length(pack("s", 0)) == 2;
+print "ok ", $test++, "\n";
+ 
+print "not " unless length(pack("S", 0)) == 2;
+print "ok ", $test++, "\n";
+ 
+print "not " unless length(pack("i", 0)) >= 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("I", 0)) >= 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("l", 0)) == 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("L", 0)) == 4;
+print "ok ", $test++, "\n";
+
+# 37..40: test the pack lengths of n N v V
+
+print "not " unless length(pack("n", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("N", 0)) == 4;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("v", 0)) == 2;
+print "ok ", $test++, "\n";
+
+print "not " unless length(pack("V", 0)) == 4;
+print "ok ", $test++, "\n";
+
+# 41..56: test unpack-pack lengths
+
+my @templates = qw(c C i I s S l L n N v V f d);
+
+# quads not supported everywhere: if not, retest floats/doubles
+# to preserve the test count...
+eval { my $q = pack("q",0) };
+push @templates, $@ !~ /Invalid type in pack/ ? qw(q Q) : qw(f d);
+
+foreach my $t (@templates) {
+    my @t = unpack("$t*", pack("$t*", 12, 34));
+    print "not "
+      unless @t == 2 and (($t[0] == 12 and $t[1] == 34) or ($t =~ /[nv]/i));
+    print "ok ", $test++, "\n";
+}
+
+# 57..60: uuencode/decode
+
+$in = join "", map { chr } 0..255;
+
+# just to be anal, we do some random tr/`/ /
+$uu = <<'EOUU';
+M` $"`P0%!@<("0H+# T.#Q`1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLL
+M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9
+M6EM<75Y?8&%B8V1E9F=H:6IK;&UN;W!Q<G-T=79W>'EZ>WQ]?G^`@8*#A(6&
+MAXB)BHN,C8Z/D)&2DY25EI>8F9J;G)V>GZ"AHJ.DI::GJ*FJJZRMKJ^PL;*S
+MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@
+?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_P `
+EOUU
+
+$_ = $uu;
+tr/ /`/;
+print "not " unless pack('u', $in) eq $_;
+print "ok ", $test++, "\n";
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+$in = "\x1f\x8b\x08\x08\x58\xdc\xc4\x35\x02\x03\x4a\x41\x50\x55\x00\xf3\x2a\x2d\x2e\x51\x48\xcc\xcb\x2f\xc9\x48\x2d\x52\x08\x48\x2d\xca\x51\x28\x2d\x4d\xce\x4f\x49\x2d\xe2\x02\x00\x64\x66\x60\x5c\x1a\x00\x00\x00";
+$uu = <<'EOUU';
+M'XL("%C<Q#4"`TI!4%4`\RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>("`&1F
+&8%P:````
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# 60 identical to 59 except that backquotes have been changed to spaces
+
+$uu = <<'EOUU';
+M'XL("%C<Q#4" TI!4%4 \RHM+E%(S,LOR4@M4@A(+<I1*"U-SD])+>(" &1F
+&8%P:    
+EOUU
+
+print "not " unless unpack('u', $uu) eq $in;
+print "ok ", $test++, "\n";
+
+# Note that first uuencoding known 'text' data and then checking the
+# binary values of the uuencoded version would not be portable between
+# character sets.  Uuencoding is meant for encoding binary data, not
+# text data.
diff --git a/contrib/perl5/t/op/pat.t b/contrib/perl5/t/op/pat.t
new file mode 100755
index 0000000..7d4278f
--- /dev/null
+++ b/contrib/perl5/t/op/pat.t
@@ -0,0 +1,597 @@
+#!./perl
+#
+# This is a home for regular expression tests that don't fit into
+# the format supported by op/regexp.t.  If you want to add a test
+# that does fit that format, add it to op/re_tests, not here.
+
+print "1..141\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = "../lib" if -d "../lib";
+}
+eval 'use Config';          #  Defaults assumed if this fails
+
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+
+$x = "abc\ndef\n";
+
+if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$* = 1;
+if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
+$* = 0;
+
+$_ = '123';
+if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
+if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+
+if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+
+if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+
+if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+
+$_ = 'aaabbbccc';
+if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
+	print "ok 13\n";
+} else {
+	print "not ok 13\n";
+}
+if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
+	print "ok 14\n";
+} else {
+	print "not ok 14\n";
+}
+
+if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+
+$_ = 'aaabccc';
+if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
+if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+
+$_ = 'aaaccc';
+if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
+if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+
+$_ = 'abcdef';
+if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
+if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
+
+if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$* = 1;		# test 3 only tested the optimized version--this one is for real
+if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
+$* = 0;
+
+$XXX{123} = 123;
+$XXX{234} = 234;
+$XXX{345} = 345;
+
+@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
+while ($_ = shift(@XXX)) {
+    ?(.*)? && (print $1,"\n");
+    /not/ && reset;
+    /not ok 26/ && reset 'X';
+}
+
+while (($key,$val) = each(%XXX)) {
+    print "not ok 27\n";
+    exit;
+}
+
+print "ok 27\n";
+
+'cde' =~ /[^ab]*/;
+'xyz' =~ //;
+if ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
+
+$foo = '[^ab]*';
+'cde' =~ /$foo/;
+'xyz' =~ //;
+if ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
+
+$foo = '[^ab]*';
+'cde' =~ /$foo/;
+'xyz' =~ /$null/;
+if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
+
+$_ = 'abcdefghi';
+/def/;		# optimized up to cmd
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
+
+/cde/ + 0;	# optimized only to spat
+if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
+
+/[d][e][f]/;	# not optimized
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
+
+$_ = 'now is the {time for all} good men to come to.';
+/ {([^}]*)}/;
+if ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
+
+$_ = 'xxx {3,4}  yyy   zzz';
+print /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
+print $1 eq '   ' ? "ok 36\n" : "not ok 36\n";
+print /( {4,})/ ? "not ok 37\n" : "ok 37\n";
+print /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
+print $1 eq '  y' ? "ok 39\n" : "not ok 39\n";
+print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
+print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
+print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
+print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
+
+$_ = "now is the time for all good men to come to.";
+@words = /(\w+)/g;
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 44\n"
+    : "not ok 44\n";
+
+@words = ();
+while (/\w+/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "now:is:the:time:for:all:good:men:to:come:to"
+    ? "ok 45\n"
+    : "not ok 45\n";
+
+@words = ();
+pos = 0;
+while (/to/g) {
+    push(@words, $&);
+}
+print join(':',@words) eq "to:to"
+    ? "ok 46\n"
+    : "not ok 46 `@words'\n";
+
+pos $_ = 0;
+@words = /to/g;
+print join(':',@words) eq "to:to"
+    ? "ok 47\n"
+    : "not ok 47 `@words'\n";
+
+$_ = "abcdefghi";
+
+$pat1 = 'def';
+$pat2 = '^def';
+$pat3 = '.def.';
+$pat4 = 'abc';
+$pat5 = '^abc';
+$pat6 = 'abc$';
+$pat7 = 'ghi';
+$pat8 = '\w*ghi';
+$pat9 = 'ghi$';
+
+$t1=$t2=$t3=$t4=$t5=$t6=$t7=$t8=$t9=0;
+
+for $iter (1..5) {
+    $t1++ if /$pat1/o;
+    $t2++ if /$pat2/o;
+    $t3++ if /$pat3/o;
+    $t4++ if /$pat4/o;
+    $t5++ if /$pat5/o;
+    $t6++ if /$pat6/o;
+    $t7++ if /$pat7/o;
+    $t8++ if /$pat8/o;
+    $t9++ if /$pat9/o;
+}
+
+$x = "$t1$t2$t3$t4$t5$t6$t7$t8$t9";
+print $x eq '505550555' ? "ok 48\n" : "not ok 48 $x\n";
+
+$xyz = 'xyz';
+print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n";
+
+# perl 4.009 says "unmatched ()"
+eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"';
+print $@ eq "" ? "ok 50\n" : "not ok 50\n";
+print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n";
+
+
+$_="abcfooabcbar";
+$x=/abc/g;
+print $` eq "" ? "ok 52\n" : "not ok 52\n" if $x;
+$x=/abc/g;
+print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x;
+$x=/abc/g;
+print $x == 0 ? "ok 54\n" : "not ok 54\n";
+pos = 0;
+$x=/ABC/gi;
+print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x;
+$x=/ABC/gi;
+print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x;
+$x=/ABC/gi;
+print $x == 0 ? "ok 57\n" : "not ok 57\n";
+pos = 0;
+$x=/abc/g;
+print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x;
+$x=/abc/g;
+print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x;
+$_ .= '';
+@x=/abc/g;
+print scalar @x == 2 ? "ok 60\n" : "not ok 60\n";
+
+$_ = "abdc";
+pos $_ = 2;
+/\Gc/gc;
+print "not " if (pos $_) != 2;
+print "ok 61\n";
+/\Gc/g;
+print "not " if defined pos $_;
+print "ok 62\n";
+
+$out = 1;
+'abc' =~ m'a(?{ $out = 2 })b';
+print "not " if $out != 2;
+print "ok 63\n";
+
+$out = 1;
+'abc' =~ m'a(?{ $out = 3 })c';
+print "not " if $out != 1;
+print "ok 64\n";
+
+$_ = 'foobar1 bar2 foobar3 barfoobar5 foobar6';
+@out = /(?<!foo)bar./g;
+print "not " if "@out" ne 'bar2 barf';
+print "ok 65\n";
+
+# Tests which depend on REG_INFTY
+$reg_infty = defined $Config{reg_infty} ? $Config{reg_infty} : 32767;
+$reg_infty_m = $reg_infty - 1; $reg_infty_p = $reg_infty + 1;
+
+# As well as failing if the pattern matches do unexpected things, the
+# next three tests will fail if you should have picked up a lower-than-
+# default value for $reg_infty from Config.pm, but have not.
+
+undef $@;
+print "not " if eval q(('aaa' =~ /(a{1,$reg_infty_m})/)[0] ne 'aaa') || $@;
+print "ok 66\n";
+
+undef $@;
+print "not " if eval q(('a' x $reg_infty_m) !~ /a{$reg_infty_m}/) || $@;
+print "ok 67\n";
+
+undef $@;
+print "not " if eval q(('a' x ($reg_infty_m - 1)) =~ /a{$reg_infty_m}/) || $@;
+print "ok 68\n";
+
+undef $@;
+eval "'aaa' =~ /a{1,$reg_infty}/";
+print "not " if $@ !~ m%^\Q/a{1,$reg_infty}/: Quantifier in {,} bigger than%;
+print "ok 69\n";
+
+eval "'aaa' =~ /a{1,$reg_infty_p}/";
+print "not "
+	if $@ !~ m%^\Q/a{1,$reg_infty_p}/: Quantifier in {,} bigger than%;
+print "ok 70\n";
+undef $@;
+
+# Poke a couple more parse failures
+
+$context = 'x' x 256;
+eval qq("${context}y" =~ /(?<=$context)y/);
+print "not " if $@ !~ m%^\Q/(?<=\Ex+/: lookbehind longer than 255 not%;
+print "ok 71\n";
+
+# This one will fail when POSIX character classes do get implemented
+{
+	my $w;
+	local $^W = 1;
+	local $SIG{__WARN__} = sub{$w = shift};
+	eval q('a' =~ /[[:alpha:]]/);
+	print "not " if $w !~ /^\QCharacter class syntax [: :] is reserved/;
+}
+print "ok 72\n";
+
+# Long Monsters
+$test = 73;
+for $l (125, 140, 250, 270, 300000, 30) { # Ordered to free memory
+  $a = 'a' x $l;
+  print "# length=$l\nnot " unless "ba$a=" =~ /a$a=/;
+  print "ok $test\n";
+  $test++;
+  
+  print "not " if "b$a=" =~ /a$a=/;
+  print "ok $test\n";
+  $test++;
+}
+
+# 20000 nodes, each taking 3 words per string, and 1 per branch
+$long_constant_len = join '|', 12120 .. 32645;
+$long_var_len = join '|', 8120 .. 28645;
+%ans = ( 'ax13876y25677lbc' => 1,
+	 'ax13876y25677mcb' => 0, # not b.
+	 'ax13876y35677nbc' => 0, # Num too big
+	 'ax13876y25677y21378obc' => 1,
+	 'ax13876y25677y21378zbc' => 0,	# Not followed by [k-o]
+	 'ax13876y25677y21378y21378kbc' => 1,
+	 'ax13876y25677y21378y21378kcb' => 0, # Not b.
+	 'ax13876y25677y21378y21378y21378kbc' => 0, # 5 runs
+       );
+
+for ( keys %ans ) {
+  print "# const-len `$_' not =>  $ans{$_}\nnot " 
+    if $ans{$_} xor /a(?=([yx]($long_constant_len)){2,4}[k-o]).*b./o;
+  print "ok $test\n";
+  $test++;
+  print "# var-len   `$_' not =>  $ans{$_}\nnot " 
+    if $ans{$_} xor /a(?=([yx]($long_var_len)){2,4}[k-o]).*b./o;
+  print "ok $test\n";
+  $test++;
+}
+
+$_ = " a (bla()) and x(y b((l)u((e))) and b(l(e)e)e";
+$expect = "(bla()) ((l)u((e))) (l(e)e)";
+
+sub matchit { 
+  m/
+     (
+       \( 
+       (?{ $c = 1 })		# Initialize
+       (?:
+	 (?(?{ $c == 0 })       # PREVIOUS iteration was OK, stop the loop
+	   (?!
+	   )			# Fail: will unwind one iteration back
+	 )	    
+	 (?:
+	   [^()]+		# Match a big chunk
+	   (?=
+	     [()]
+	   )			# Do not try to match subchunks
+	 |
+	   \( 
+	   (?{ ++$c })
+	 |
+	   \) 
+	   (?{ --$c })
+	 )
+       )+			# This may not match with different subblocks
+     )
+     (?(?{ $c != 0 })
+       (?!
+       )			# Fail
+     )				# Otherwise the chunk 1 may succeed with $c>0
+   /xg;
+}
+
+push @ans, $res while $res = matchit;
+
+print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne "1 1 1";
+print "ok $test\n";
+$test++;
+
+@ans = matchit;
+
+print "# ans='@ans'\n# expect='$expect'\nnot " if "@ans" ne $expect;
+print "ok $test\n";
+$test++;
+
+@ans = ('a/b' =~ m%(.*/)?(.*)%);	# Stack may be bad
+print "not " if "@ans" ne 'a/ b';
+print "ok $test\n";
+$test++;
+
+$code = '{$blah = 45}';
+$blah = 12;
+eval { /(?$code)/ };
+print "not " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;
+print "ok $test\n";
+$test++;
+
+for $code ('{$blah = 45}','=xx') {
+  $blah = 12;
+  $res = eval { "xx" =~ /(?$code)/o };
+  if ($code eq '=xx') {
+    print "#'$@','$res','$blah'\nnot " unless not $@ and $res;
+  } else {
+    print "#'$@','$res','$blah'\nnot " unless $@ and $@ =~ /not allowed at runtime/ and $blah == 12;    
+  }
+  print "ok $test\n";
+  $test++;
+}
+
+$code = '{$blah = 45}';
+$blah = 12;
+eval "/(?$code)/";			
+print "not " if $blah != 45;
+print "ok $test\n";
+$test++;
+
+$blah = 12;
+/(?{$blah = 45})/;			
+print "not " if $blah != 45;
+print "ok $test\n";
+$test++;
+
+$x = 'banana';
+$x =~ /.a/g;
+print "not " unless pos($x) == 2;
+print "ok $test\n";
+$test++;
+
+$x =~ /.z/gc;
+print "not " unless pos($x) == 2;
+print "ok $test\n";
+$test++;
+
+sub f {
+    my $p = $_[0];
+    return $p;
+}
+
+$x =~ /.a/g;
+print "not " unless f(pos($x)) == 4;
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{$x = 12; 75})[t]/;
+print "not " unless $^R eq '75';
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{$x = 12; 75})[xy]/;
+print "not " unless $^R eq '67' and $x eq '12';
+print "ok $test\n";
+$test++;
+
+$x = $^R = 67;
+'foot' =~ /foo(?{ $^R + 12 })((?{ $x = 12; $^R + 17 })[xy])?/;
+print "not " unless $^R eq '79' and $x eq '12';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/i eq '(?i-xsm:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/s eq '(?s-xim:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/m eq '(?m-xis:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/x eq '(?x-ism:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/xism eq '(?msix:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/ eq '(?-xism:\bv$)';
+print "ok $test\n";
+$test++;
+
+$_ = 'xabcx';
+foreach $ans ('', 'c') {
+  /(?<=(?=a)..)((?=c)|.)/g;
+  print "not " unless $1 eq $ans;
+  print "ok $test\n";
+  $test++;
+}
+
+$_ = 'a';
+foreach $ans ('', 'a', '') {
+  /^|a|$/g;
+  print "not " unless $& eq $ans;
+  print "ok $test\n";
+  $test++;
+}
+
+sub prefixify {
+  my($v,$a,$b,$res) = @_; 
+  $v =~ s/\Q$a\E/$b/; 
+  print "not " unless $res eq $v; 
+  print "ok $test\n";
+  $test++;
+}
+prefixify('/a/b/lib/arch', "/a/b/lib", 'X/lib', 'X/lib/arch');
+prefixify('/a/b/man/arch', "/a/b/man", 'X/man', 'X/man/arch');
+
+$_ = 'var="foo"';
+/(\")/;
+print "not " unless $1 and /$1/;
+print "ok $test\n";
+$test++;
+
+$a=qr/(?{++$b})/; 
+$b = 7;
+/$a$a/; 
+print "not " unless $b eq '9'; 
+print "ok $test\n";
+$test++;
+
+$c="$a"; 
+/$a$a/; 
+print "not " unless $b eq '11'; 
+print "ok $test\n";
+$test++;
+
+{
+  use re "eval"; 
+  /$a$c$a/; 
+  print "not " unless $b eq '14'; 
+  print "ok $test\n";
+  $test++;
+
+  no re "eval"; 
+  $match = eval { /$a$c$a/ };
+  print "not " 
+    unless $b eq '14' and $@ =~ /Eval-group not allowed/ and not $match;
+  print "ok $test\n";
+  $test++;
+}
+
+{
+  package aa;
+  $c = 2;
+  $::c = 3;
+  '' =~ /(?{ $c = 4 })/;
+  print "not " unless $c == 4;
+}
+print "ok $test\n";
+$test++;
+print "not " unless $c == 3;
+print "ok $test\n";
+$test++;  
+  
+sub must_warn_pat {
+    my $warn_pat = shift;
+    return sub { print "not " unless $_[0] =~ /$warn_pat/ }
+}
+
+sub must_warn {
+    my ($warn_pat, $code) = @_;
+    local $^W; local %SIG;
+    eval 'BEGIN { $^W = 1; $SIG{__WARN__} = $warn_pat };' . $code;
+    print "ok $test\n";
+    $test++;
+}
+
+
+sub make_must_warn {
+    my $warn_pat = shift;
+    return sub { must_warn(must_warn_pat($warn_pat)) }
+}
+
+my $for_future = make_must_warn('reserved for future extensions');
+
+&$for_future('q(a:[b]:) =~ /[x[:foo:]]/');
+&$for_future('q(a=[b]=) =~ /[x[=foo=]]/');
+&$for_future('q(a.[b].) =~ /[x[.foo.]]/');
+
+# test if failure of patterns returns empty list
+$_ = 'aaa';
+@_ = /bbb/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /bbb/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
diff --git a/contrib/perl5/t/op/pos.t b/contrib/perl5/t/op/pos.t
new file mode 100755
index 0000000..46811b7
--- /dev/null
+++ b/contrib/perl5/t/op/pos.t
@@ -0,0 +1,16 @@
+#!./perl
+
+print "1..3\n";
+
+$x='banana';
+$x=~/.a/g;
+if (pos($x)==2) {print "ok 1\n"} else {print "not ok 1\n";}
+
+$x=~/.z/gc;
+if (pos($x)==2) {print "ok 2\n"} else {print "not ok 2\n";}
+
+sub f { my $p=$_[0]; return $p }
+
+$x=~/.a/g;
+if (f(pos($x))==4) {print "ok 3\n"} else {print "not ok 3\n";}
+
diff --git a/contrib/perl5/t/op/push.t b/contrib/perl5/t/op/push.t
new file mode 100755
index 0000000..a67caed
--- /dev/null
+++ b/contrib/perl5/t/op/push.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $RCSfile: push.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:13 $
+
+@tests = split(/\n/, <<EOF);
+0 3,			0 1 2,		3 4 5 6 7
+0 0 a b c,		,		a b c 0 1 2 3 4 5 6 7
+8 0 a b c,		,		0 1 2 3 4 5 6 7 a b c
+7 0 6.5,		,		0 1 2 3 4 5 6 6.5 7
+1 0 a b c d e f g h i j,,		0 a b c d e f g h i j 1 2 3 4 5 6 7
+0 1 a,			0,		a 1 2 3 4 5 6 7
+1 6 x y z,		1 2 3 4 5 6,	0 x y z 7
+0 7 x y z,		0 1 2 3 4 5 6,	x y z 7
+1 7 x y z,		1 2 3 4 5 6 7,	0 x y z
+4,			4 5 6 7,	0 1 2 3
+-4,			4 5 6 7,	0 1 2 3
+EOF
+
+print "1..", 4 + @tests, "\n";
+die "blech" unless @tests;
+
+@x = (1,2,3);
+push(@x,@x);
+if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
+push(@x,4);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+
+# test for push/pop intuiting @ on array
+push(x,3);
+if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";}
+pop(x);
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$test = 5;
+foreach $line (@tests) {
+    ($list,$get,$leave) = split(/,\t*/,$line);
+    ($pos, $len, @list) = split(' ',$list);
+    @get = split(' ',$get);
+    @leave = split(' ',$leave);
+    @x = (0,1,2,3,4,5,6,7);
+    if (defined $len) {
+	@got = splice(@x, $pos, $len, @list);
+    }
+    else {
+	@got = splice(@x, $pos);
+    }
+    if (join(':',@got) eq join(':',@get) &&
+	join(':',@x) eq join(':',@leave)) {
+	print "ok ",$test++,"\n";
+    }
+    else {
+	print "not ok ",$test++," got: @got == @get left: @x == @leave\n";
+    }
+}
+
+1;  # this file is require'd by lib/tie-stdpush.t
diff --git a/contrib/perl5/t/op/quotemeta.t b/contrib/perl5/t/op/quotemeta.t
new file mode 100755
index 0000000..913e07c
--- /dev/null
+++ b/contrib/perl5/t/op/quotemeta.t
@@ -0,0 +1,38 @@
+#!./perl
+
+print "1..15\n";
+
+if ($^O eq 'os390') { # An EBCDIC variant.
+    $_=join "", map chr($_), 129..233;
+
+    # 105 characters - 52 letters = 53 backslashes
+    # 105 characters + 53 backslashes = 158 characters
+    $_=quotemeta $_;
+    if ( length == 158 ){print "ok 1\n"} else {print "not ok 1\n"}
+    # 104 non-backslash characters
+    if (tr/\\//cd == 104){print "ok 2\n"} else {print "not ok 2\n"}
+} else { # some ASCII descendant, then.
+    $_=join "", map chr($_), 32..127;
+
+    # 96 characters - 52 letters - 10 digits - 1 underscore = 33 backslashes
+    # 96 characters + 33 backslashes = 129 characters
+    $_=quotemeta $_;
+    if ( length == 129 ){print "ok 1\n"} else {print "not ok 1\n"}
+    # 95 non-backslash characters
+    if (tr/\\//cd == 95){print "ok 2\n"} else {print "not ok 2\n"}
+}
+
+if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"}
+
+print "aA\UbB\LcC\EdD" eq "aABBccdD" ? "ok 4\n" : "not ok 4 \n";
+print "aA\LbB\UcC\EdD" eq "aAbbCCdD" ? "ok 5\n" : "not ok 5 \n";
+print "\L\upERL" eq "Perl" ? "ok 6\n" : "not ok 6 \n";
+print "\u\LpERL" eq "Perl" ? "ok 7\n" : "not ok 7 \n";
+print "\U\lPerl" eq "pERL" ? "ok 8\n" : "not ok 8 \n";
+print "\l\UPerl" eq "pERL" ? "ok 9\n" : "not ok 9 \n";
+print "\u\LpE\Q#X#\ER\EL" eq "Pe\\#x\\#rL" ? "ok 10\n" : "not ok 10 \n";
+print "\l\UPe\Q!x!\Er\El" eq "pE\\!X\\!Rl" ? "ok 11\n" : "not ok 11 \n";
+print "\Q\u\LpE.X.R\EL\E." eq "Pe\\.x\\.rL." ? "ok 12\n" : "not ok 12 \n";
+print "\Q\l\UPe*x*r\El\E*" eq "pE\\*X\\*Rl*" ? "ok 13\n" : "not ok 13 \n";
+print "\U\lPerl\E\E\E\E" eq "pERL" ? "ok 14\n" : "not ok 14 \n";
+print "\l\UPerl\E\E\E\E" eq "pERL" ? "ok 15\n" : "not ok 15 \n";
diff --git a/contrib/perl5/t/op/rand.t b/contrib/perl5/t/op/rand.t
new file mode 100755
index 0000000..c779f9d
--- /dev/null
+++ b/contrib/perl5/t/op/rand.t
@@ -0,0 +1,348 @@
+#!./perl
+
+# From Tom Phoenix <rootbeer@teleport.com> 22 Feb 1997
+# Based upon a test script by kgb@ast.cam.ac.uk (Karl Glazebrook)
+
+# Looking for the hints? You're in the right place. 
+# The hints are near each test, so search for "TEST #", where
+# the pound sign is replaced by the number of the test.
+
+# I'd like to include some more robust tests, but anything
+# too subtle to be detected here would require a time-consuming
+# test. Also, of course, we're here to detect only flaws in Perl;
+# if there are flaws in the underlying system rand, that's not
+# our responsibility. But if you want better tests, see
+# The Art of Computer Programming, Donald E. Knuth, volume 2,
+# chapter 3. ISBN 0-201-03822-6 (v. 2)
+
+BEGIN {
+    chdir "t" if -d "t";
+    @INC = "../lib" if -d "../lib";
+}
+
+use strict;
+use Config;
+
+print "1..11\n";
+
+srand;			# Shouldn't need this with 5.004...
+			# But I'll include it now and test for
+			# whether we needed it later.
+
+my $reps = 1000;	# How many times to try rand each time.
+			# May be changed, but should be over 500.
+			# The more the better! (But slower.)
+
+sub bits ($) {
+    # Takes a small integer and returns the number of one-bits in it.
+    my $total;
+    my $bits = sprintf "%o", $_[0];
+    while (length $bits) {
+	$total += (0,1,1,2,1,2,2,3)[chop $bits];	# Oct to bits
+    }
+    $total;
+}
+
+# First, let's see whether randbits is set right
+{
+    my($max, $min, $sum);	# Characteristics of rand
+    my($off, $shouldbe);	# Problems with randbits
+    my($dev, $bits);		# Number of one bits
+    my $randbits = $Config{randbits};
+    $max = $min = rand(1);
+    for (1..$reps) {
+	my $n = rand(1);
+	$sum += $n;
+	$bits += bits($n * 256);	# Don't be greedy; 8 is enough
+		    # It's too many if randbits is less than 8!
+		    # But that should never be the case... I hope.
+		    # Note: If you change this, you must adapt the
+		    # formula for absolute standard deviation, below.
+	$max = $n if $n > $max;
+	$min = $n if $n < $min;
+    }
+
+
+    # Hints for TEST 1
+    #
+    # This test checks for one of Perl's most frequent
+    # mis-configurations. Your system's documentation
+    # for rand(2) should tell you what value you need
+    # for randbits. Usually the diagnostic message
+    # has the right value as well. Just fix it and
+    # recompile, and you'll usually be fine. (The main 
+    # reason that the diagnostic message might get the
+    # wrong value is that Config.pm is incorrect.)
+    #
+    if ($max <= 0 or $max >= (1 << $randbits)) {	# Just in case...
+	print "not ok 1\n";
+	print "# This perl was compiled with randbits=$randbits\n";
+	print "# which is _way_ off. Or maybe your system rand is broken,\n";
+	print "# or your C compiler can't multiply, or maybe Martians\n";
+	print "# have taken over your computer. For starters, see about\n";
+	print "# trying a better value for randbits, probably smaller.\n";
+	# If that isn't the problem, we'll have
+	# to put d_martians into Config.pm 
+	print "# Skipping remaining tests until randbits is fixed.\n";
+	exit;
+    }
+
+    $off = log($max) / log(2);			# log2
+    $off = int($off) + ($off > 0);		# Next more positive int
+    if ($off) {
+	$shouldbe = $Config{randbits} + $off;
+	print "not ok 1\n";
+	print "# This perl was compiled with randbits=$randbits on $^O.\n";
+	print "# Consider using randbits=$shouldbe instead.\n";
+	# And skip the remaining tests; they would be pointless now.
+	print "# Skipping remaining tests until randbits is fixed.\n";
+	exit;
+    } else {
+	print "ok 1\n";
+    }
+
+    # Hints for TEST 2
+    #
+    # This should always be true: 0 <= rand(1) < 1
+    # If this test is failing, something is seriously wrong,
+    # either in perl or your system's rand function.
+    #
+    if ($min < 0 or $max >= 1) {	# Slightly redundant...
+	print "not ok 2\n";
+	print "# min too low\n" if $min < 0;
+	print "# max too high\n" if $max >= 1;
+    } else {
+	print "ok 2\n";
+    }
+
+    # Hints for TEST 3
+    #
+    # This is just a crude test. The average number produced
+    # by rand should be about one-half. But once in a while
+    # it will be relatively far away. Note: This test will
+    # occasionally fail on a perfectly good system!
+    # See the hints for test 4 to see why.
+    #
+    $sum /= $reps;
+    if ($sum < 0.4 or $sum > 0.6) {
+	print "not ok 3\n# Average random number is far from 0.5\n";
+    } else {
+	print "ok 3\n";
+    }
+
+    # Hints for TEST 4
+    #
+    #   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+    # This test will fail .1% of the time on a normal system.
+    #				also
+    # This test asks you to see these hints 100% of the time!
+    #   NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
+    #
+    # There is probably no reason to be alarmed that
+    # something is wrong with your rand function. But,
+    # if you're curious or if you can't help being 
+    # alarmed, keep reading.
+    #
+    # This is a less-crude test than test 3. But it has
+    # the same basic flaw: Unusually distributed random
+    # values should occasionally appear in every good
+    # random number sequence. (If you flip a fair coin
+    # twenty times every day, you'll see it land all
+    # heads about one time in a million days, on the
+    # average. That might alarm you if you saw it happen
+    # on the first day!)
+    #
+    # So, if this test failed on you once, run it a dozen
+    # times. If it keeps failing, it's likely that your
+    # rand is bogus. If it keeps passing, it's likely
+    # that the one failure was bogus. If it's a mix,
+    # read on to see about how to interpret the tests.
+    #
+    # The number printed in square brackets is the
+    # standard deviation, a statistical measure
+    # of how unusual rand's behavior seemed. It should
+    # fall in these ranges with these *approximate*
+    # probabilities:
+    #
+    #		under 1		68.26% of the time
+    #		1-2		27.18% of the time
+    #		2-3		 4.30% of the time
+    #		over 3		 0.26% of the time
+    #
+    # If the numbers you see are not scattered approximately
+    # (not exactly!) like that table, check with your vendor
+    # to find out what's wrong with your rand. Or with this
+    # algorithm. :-)
+    #
+    # Calculating absoulute standard deviation for number of bits set
+    # (eight bits per rep)
+    $dev = abs ($bits - $reps * 4) / sqrt($reps * 2);
+
+    if ($dev < 1.96) {
+	print "ok 4\n";		# 95% of the time.
+	print "# Your rand seems fine. If this test failed\n";
+	print "# previously, you may want to run it again.\n";
+    } elsif ($dev < 2.575) {
+	print "ok 4\n# In here about 4% of the time. Hmmm...\n";
+	print "# This is ok, but suspicious. But it will happen\n";
+	print "# one time out of 25, more or less.\n";
+	print "# You should run this test again to be sure.\n";
+    } elsif ($dev < 3.3) {
+	print "ok 4\n# In this range about 1% of the time.\n";
+	print "# This is very suspicious. It will happen only\n";
+	print "# about one time out of 100, more or less.\n";
+	print "# You should run this test again to be sure.\n";
+    } elsif ($dev < 3.9) {
+	print "not ok 4\n# In this range very rarely.\n";
+	print "# This is VERY suspicious. It will happen only\n";
+	print "# about one time out of 1000, more or less.\n";
+	print "# You should run this test again to be sure.\n";
+    } else {
+	print "not ok 4\n# Seriously whacked.\n";
+	print "# This is VERY VERY suspicious.\n";
+	print "# Your rand seems to be bogus.\n";
+    }
+    print "#\n# If you are having random number troubles,\n";
+    print "# see the hints within the test script for more\n";
+    printf "# information on why this might fail. [ %.3f ]\n", $dev;
+}
+
+{
+    srand;		# These three lines are for test 7
+    my $time = time;	# It's just faster to do them here.
+    my $rand = join ", ", rand, rand, rand;
+
+    # Hints for TEST 5
+    # 
+    # This test checks that the argument to srand actually 
+    # sets the seed for generating random numbers. 
+    #
+    srand(3.14159);
+    my $r = rand;
+    srand(3.14159);
+    if (rand != $r) {
+	print "not ok 5\n";
+	print "# srand is not consistent.\n";
+    } else {
+	print "ok 5\n";
+    }
+
+    # Hints for TEST 6
+    # 
+    # This test just checks that the previous one didn't 
+    # give us false confidence!
+    #
+    if (rand == $r) {
+	print "not ok 6\n";
+	print "# rand is now unchanging!\n";
+    } else {
+	print "ok 6\n";
+    }
+
+    # Hints for TEST 7
+    #
+    # This checks that srand without arguments gives
+    # different sequences each time. Note: You shouldn't
+    # be calling srand more than once unless you know
+    # what you're doing! But if this fails on your 
+    # system, run perlbug and let the developers know
+    # what other sources of randomness srand should
+    # tap into.
+    #
+    while ($time == time) { }	# Wait for new second, just in case.
+    srand;
+    if ((join ", ", rand, rand, rand) eq $rand) {
+	print "not ok 7\n";
+	print "# srand without args isn't varying.\n";
+    } else {
+	print "ok 7\n";
+    }
+}
+
+# Now, let's see whether rand accepts its argument
+{
+    my($max, $min);
+    $max = $min = rand(100);
+    for (1..$reps) {
+	my $n = rand(100);
+	$max = $n if $n > $max;
+	$min = $n if $n < $min;
+    }
+
+    # Hints for TEST 8
+    #
+    # This test checks to see that rand(100) really falls 
+    # within the range 0 - 100, and that the numbers produced
+    # have a reasonably-large range among them.
+    #
+    if ($min < 0 or $max >= 100 or ($max - $min) < 65) {
+	print "not ok 8\n";
+	print "# min too low\n" if $min < 0;
+	print "# max too high\n" if $max >= 100;
+	print "# range too narrow\n" if ($max - $min) < 65;
+    } else {
+	print "ok 8\n";
+    }
+
+    # Hints for TEST 9
+    #
+    # This test checks that rand without an argument
+    # is equivalent to rand(1).
+    #
+    $_ = 12345;		# Just for fun.
+    srand 12345;
+    my $r = rand;
+    srand 12345;
+    if (rand(1) == $r) {
+	print "ok 9\n";
+    } else {
+	print "not ok 9\n";
+	print "# rand without arguments isn't rand(1)!\n";
+    }
+
+    # Hints for TEST 10
+    #
+    # This checks that rand without an argument is not
+    # rand($_). (In case somebody got overzealous.)
+    # 
+    if ($r >= 1) {
+	print "not ok 10\n";
+	print "# rand without arguments isn't under 1!\n";
+    } else {
+	print "ok 10\n";
+    }
+}
+
+# Hints for TEST 11
+#
+# This test checks whether Perl called srand for you. This should
+# be the case in version 5.004 and later. Note: You must still
+# call srand if your code might ever be run on a pre-5.004 system!
+#
+AUTOSRAND:
+{
+    unless ($Config{d_fork}) {
+	# Skip this test. It's not likely to be system-specific, anyway.
+	print "ok 11\n# Skipping this test on this platform.\n";
+	last;
+    }
+
+    my($pid, $first);
+    for (1..5) {
+	my $PERL = (($^O eq 'VMS') ? "MCR $^X"
+		    : ($^O eq 'MSWin32') ? '.\perl'
+		    : './perl');
+	$pid = open PERL, qq[$PERL -e "print rand"|];
+	die "Couldn't pipe from perl: $!" unless defined $pid;
+	if (defined $first) {
+	    if ($first ne <PERL>) {
+		print "ok 11\n";
+		last AUTOSRAND;
+	    }
+	} else {
+	    $first = <PERL>;
+	}
+	close PERL or die "perl returned error code $?";
+    }
+    print "not ok 11\n# srand isn't being autocalled.\n";
+}
diff --git a/contrib/perl5/t/op/range.t b/contrib/perl5/t/op/range.t
new file mode 100755
index 0000000..7999b86
--- /dev/null
+++ b/contrib/perl5/t/op/range.t
@@ -0,0 +1,48 @@
+#!./perl
+
+print "1..10\n";
+
+print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
+
+@foo = (1,2,3,4,5,6,7,8,9);
+@foo[2..4] = ('c','d','e');
+
+print join(':',@foo[$foo[0]..5]) eq '2:c:d:e:6' ? "ok 2\n" : "not ok 2\n";
+
+@bar[2..4] = ('c','d','e');
+print join(':',@bar[1..5]) eq ':c:d:e:' ? "ok 3\n" : "not ok 3\n";
+
+($a,@bcd[0..2],$e) = ('a','b','c','d','e');
+print join(':',$a,@bcd[0..2],$e) eq 'a:b:c:d:e' ? "ok 4\n" : "not ok 4\n";
+
+$x = 0;
+for (1..100) {
+    $x += $_;
+}
+print $x == 5050 ? "ok 5\n" : "not ok 5 $x\n";
+
+$x = 0;
+for ((100,2..99,1)) {
+    $x += $_;
+}
+print $x == 5050 ? "ok 6\n" : "not ok 6 $x\n";
+
+$x = join('','a'..'z');
+print $x eq 'abcdefghijklmnopqrstuvwxyz' ? "ok 7\n" : "not ok 7 $x\n";
+
+@x = 'A'..'ZZ';
+print @x == 27 * 26 ? "ok 8\n" : "not ok 8\n";
+
+@x = '09' .. '08';  # should produce '09', '10',... '99' (strange but true)
+print "not " unless join(",", @x) eq
+                    join(",", map {sprintf "%02d",$_} 9..99);
+print "ok 9\n";
+
+# same test with foreach (which is a separate implementation)
+@y = ();
+foreach ('09'..'08') {
+    push(@y, $_);
+}
+print "not " unless join(",", @y) eq join(",", @x);
+print "ok 10\n";
+
diff --git a/contrib/perl5/t/op/re_tests b/contrib/perl5/t/op/re_tests
new file mode 100644
index 0000000..a5295f5
--- /dev/null
+++ b/contrib/perl5/t/op/re_tests
@@ -0,0 +1,485 @@
+abc	abc	y	$&	abc
+abc	xbc	n	-	-
+abc	axc	n	-	-
+abc	abx	n	-	-
+abc	xabcy	y	$&	abc
+abc	ababc	y	$&	abc
+ab*c	abc	y	$&	abc
+ab*bc	abc	y	$&	abc
+ab*bc	abbc	y	$&	abbc
+ab*bc	abbbbc	y	$&	abbbbc
+.{1}	abbbbc	y	$&	a
+.{3,4}	abbbbc	y	$&	abbb
+ab{0,}bc	abbbbc	y	$&	abbbbc
+ab+bc	abbc	y	$&	abbc
+ab+bc	abc	n	-	-
+ab+bc	abq	n	-	-
+ab{1,}bc	abq	n	-	-
+ab+bc	abbbbc	y	$&	abbbbc
+ab{1,}bc	abbbbc	y	$&	abbbbc
+ab{1,3}bc	abbbbc	y	$&	abbbbc
+ab{3,4}bc	abbbbc	y	$&	abbbbc
+ab{4,5}bc	abbbbc	n	-	-
+ab?bc	abbc	y	$&	abbc
+ab?bc	abc	y	$&	abc
+ab{0,1}bc	abc	y	$&	abc
+ab?bc	abbbbc	n	-	-
+ab?c	abc	y	$&	abc
+ab{0,1}c	abc	y	$&	abc
+^abc$	abc	y	$&	abc
+^abc$	abcc	n	-	-
+^abc	abcc	y	$&	abc
+^abc$	aabc	n	-	-
+abc$	aabc	y	$&	abc
+abc$	aabcd	n	-	-
+^	abc	y	$&	
+$	abc	y	$&	
+a.c	abc	y	$&	abc
+a.c	axc	y	$&	axc
+a.*c	axyzc	y	$&	axyzc
+a.*c	axyzd	n	-	-
+a[bc]d	abc	n	-	-
+a[bc]d	abd	y	$&	abd
+a[b-d]e	abd	n	-	-
+a[b-d]e	ace	y	$&	ace
+a[b-d]	aac	y	$&	ac
+a[-b]	a-	y	$&	a-
+a[b-]	a-	y	$&	a-
+a[b-a]	-	c	-	/a[b-a]/: invalid [] range in regexp
+a[]b	-	c	-	/a[]b/: unmatched [] in regexp
+a[	-	c	-	/a[/: unmatched [] in regexp
+a]	a]	y	$&	a]
+a[]]b	a]b	y	$&	a]b
+a[^bc]d	aed	y	$&	aed
+a[^bc]d	abd	n	-	-
+a[^-b]c	adc	y	$&	adc
+a[^-b]c	a-c	n	-	-
+a[^]b]c	a]c	n	-	-
+a[^]b]c	adc	y	$&	adc
+\ba\b	a-	y	-	-
+\ba\b	-a	y	-	-
+\ba\b	-a-	y	-	-
+\by\b	xy	n	-	-
+\by\b	yz	n	-	-
+\by\b	xyz	n	-	-
+\Ba\B	a-	n	-	-
+\Ba\B	-a	n	-	-
+\Ba\B	-a-	n	-	-
+\By\b	xy	y	-	-
+\by\B	yz	y	-	-
+\By\B	xyz	y	-	-
+\w	a	y	-	-
+\w	-	n	-	-
+\W	a	n	-	-
+\W	-	y	-	-
+a\sb	a b	y	-	-
+a\sb	a-b	n	-	-
+a\Sb	a b	n	-	-
+a\Sb	a-b	y	-	-
+\d	1	y	-	-
+\d	-	n	-	-
+\D	1	n	-	-
+\D	-	y	-	-
+[\w]	a	y	-	-
+[\w]	-	n	-	-
+[\W]	a	n	-	-
+[\W]	-	y	-	-
+a[\s]b	a b	y	-	-
+a[\s]b	a-b	n	-	-
+a[\S]b	a b	n	-	-
+a[\S]b	a-b	y	-	-
+[\d]	1	y	-	-
+[\d]	-	n	-	-
+[\D]	1	n	-	-
+[\D]	-	y	-	-
+ab|cd	abc	y	$&	ab
+ab|cd	abcd	y	$&	ab
+()ef	def	y	$&-$1	ef-
+*a	-	c	-	/*a/: ?+*{} follows nothing in regexp
+(*)b	-	c	-	/(*)b/: ?+*{} follows nothing in regexp
+$b	b	n	-	-
+a\	-	c	-	Search pattern not terminated
+a\(b	a(b	y	$&-$1	a(b-
+a\(*b	ab	y	$&	ab
+a\(*b	a((b	y	$&	a((b
+a\\b	a\b	y	$&	a\b
+abc)	-	c	-	/abc)/: unmatched () in regexp
+(abc	-	c	-	/(abc/: unmatched () in regexp
+((a))	abc	y	$&-$1-$2	a-a-a
+(a)b(c)	abc	y	$&-$1-$2	abc-a-c
+a+b+c	aabbabc	y	$&	abc
+a{1,}b{1,}c	aabbabc	y	$&	abc
+a**	-	c	-	/a**/: nested *?+ in regexp
+a.+?c	abcabc	y	$&	abc
+(a+|b)*	ab	y	$&-$1	ab-b
+(a+|b){0,}	ab	y	$&-$1	ab-b
+(a+|b)+	ab	y	$&-$1	ab-b
+(a+|b){1,}	ab	y	$&-$1	ab-b
+(a+|b)?	ab	y	$&-$1	a-a
+(a+|b){0,1}	ab	y	$&-$1	a-a
+)(	-	c	-	/)(/: unmatched () in regexp
+[^ab]*	cde	y	$&	cde
+abc		n	-	-
+a*		y	$&	
+([abc])*d	abbbcd	y	$&-$1	abbbcd-c
+([abc])*bcd	abcd	y	$&-$1	abcd-a
+a|b|c|d|e	e	y	$&	e
+(a|b|c|d|e)f	ef	y	$&-$1	ef-e
+abcd*efg	abcdefg	y	$&	abcdefg
+ab*	xabyabbbz	y	$&	ab
+ab*	xayabbbz	y	$&	a
+(ab|cd)e	abcde	y	$&-$1	cde-cd
+[abhgefdc]ij	hij	y	$&	hij
+^(ab|cd)e	abcde	n	x$1y	xy
+(abc|)ef	abcdef	y	$&-$1	ef-
+(a|b)c*d	abcd	y	$&-$1	bcd-b
+(ab|ab*)bc	abc	y	$&-$1	abc-a
+a([bc]*)c*	abc	y	$&-$1	abc-bc
+a([bc]*)(c*d)	abcd	y	$&-$1-$2	abcd-bc-d
+a([bc]+)(c*d)	abcd	y	$&-$1-$2	abcd-bc-d
+a([bc]*)(c+d)	abcd	y	$&-$1-$2	abcd-b-cd
+a[bcd]*dcdcde	adcdcde	y	$&	adcdcde
+a[bcd]+dcdcde	adcdcde	n	-	-
+(ab|a)b*c	abc	y	$&-$1	abc-ab
+((a)(b)c)(d)	abcd	y	$1-$2-$3-$4	abc-a-b-d
+[a-zA-Z_][a-zA-Z0-9_]*	alpha	y	$&	alpha
+^a(bc+|b[eh])g|.h$	abh	y	$&-$1	bh-
+(bc+d$|ef*g.|h?i(j|k))	effgz	y	$&-$1-$2	effgz-effgz-
+(bc+d$|ef*g.|h?i(j|k))	ij	y	$&-$1-$2	ij-ij-j
+(bc+d$|ef*g.|h?i(j|k))	effg	n	-	-
+(bc+d$|ef*g.|h?i(j|k))	bcdd	n	-	-
+(bc+d$|ef*g.|h?i(j|k))	reffgz	y	$&-$1-$2	effgz-effgz-
+((((((((((a))))))))))	a	y	$10	a
+((((((((((a))))))))))\10	aa	y	$&	aa
+((((((((((a))))))))))${bang}	aa	n	-	-
+((((((((((a))))))))))${bang}	a!	y	$&	a!
+(((((((((a)))))))))	a	y	$&	a
+multiple words of text	uh-uh	n	-	-
+multiple words	multiple words, yeah	y	$&	multiple words
+(.*)c(.*)	abcde	y	$&-$1-$2	abcde-ab-de
+\((.*), (.*)\)	(a, b)	y	($2, $1)	(b, a)
+[k]	ab	n	-	-
+abcd	abcd	y	$&-\$&-\\$&	abcd-$&-\abcd
+a(bc)d	abcd	y	$1-\$1-\\$1	bc-$1-\bc
+a[-]?c	ac	y	$&	ac
+(abc)\1	abcabc	y	$1	abc
+([a-c]*)\1	abcabc	y	$1	abc
+\1	-	c	-	/\1/: reference to nonexistent group
+\2	-	c	-	/\2/: reference to nonexistent group
+(a)|\1	a	y	-	-
+(a)|\1	x	n	-	-
+(a)|\2	-	c	-	/(a)|\2/: reference to nonexistent group
+(([a-c])b*?\2)*	ababbbcbc	y	$&-$1-$2	ababb-bb-b
+(([a-c])b*?\2){3}	ababbbcbc	y	$&-$1-$2	ababbbcbc-cbc-c
+((\3|b)\2(a)x)+	aaxabxbaxbbx	n	-	-
+((\3|b)\2(a)x)+	aaaxabaxbaaxbbax	y	$&-$1-$2-$3	bbax-bbax-b-a
+((\3|b)\2(a)){2,}	bbaababbabaaaaabbaaaabba	y	$&-$1-$2-$3	bbaaaabba-bba-b-a
+'abc'i	ABC	y	$&	ABC
+'abc'i	XBC	n	-	-
+'abc'i	AXC	n	-	-
+'abc'i	ABX	n	-	-
+'abc'i	XABCY	y	$&	ABC
+'abc'i	ABABC	y	$&	ABC
+'ab*c'i	ABC	y	$&	ABC
+'ab*bc'i	ABC	y	$&	ABC
+'ab*bc'i	ABBC	y	$&	ABBC
+'ab*?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{0,}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab+?bc'i	ABBC	y	$&	ABBC
+'ab+bc'i	ABC	n	-	-
+'ab+bc'i	ABQ	n	-	-
+'ab{1,}bc'i	ABQ	n	-	-
+'ab+bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{1,3}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{3,4}?bc'i	ABBBBC	y	$&	ABBBBC
+'ab{4,5}?bc'i	ABBBBC	n	-	-
+'ab??bc'i	ABBC	y	$&	ABBC
+'ab??bc'i	ABC	y	$&	ABC
+'ab{0,1}?bc'i	ABC	y	$&	ABC
+'ab??bc'i	ABBBBC	n	-	-
+'ab??c'i	ABC	y	$&	ABC
+'ab{0,1}?c'i	ABC	y	$&	ABC
+'^abc$'i	ABC	y	$&	ABC
+'^abc$'i	ABCC	n	-	-
+'^abc'i	ABCC	y	$&	ABC
+'^abc$'i	AABC	n	-	-
+'abc$'i	AABC	y	$&	ABC
+'^'i	ABC	y	$&	
+'$'i	ABC	y	$&	
+'a.c'i	ABC	y	$&	ABC
+'a.c'i	AXC	y	$&	AXC
+'a.*?c'i	AXYZC	y	$&	AXYZC
+'a.*c'i	AXYZD	n	-	-
+'a[bc]d'i	ABC	n	-	-
+'a[bc]d'i	ABD	y	$&	ABD
+'a[b-d]e'i	ABD	n	-	-
+'a[b-d]e'i	ACE	y	$&	ACE
+'a[b-d]'i	AAC	y	$&	AC
+'a[-b]'i	A-	y	$&	A-
+'a[b-]'i	A-	y	$&	A-
+'a[b-a]'i	-	c	-	/a[b-a]/: invalid [] range in regexp
+'a[]b'i	-	c	-	/a[]b/: unmatched [] in regexp
+'a['i	-	c	-	/a[/: unmatched [] in regexp
+'a]'i	A]	y	$&	A]
+'a[]]b'i	A]B	y	$&	A]B
+'a[^bc]d'i	AED	y	$&	AED
+'a[^bc]d'i	ABD	n	-	-
+'a[^-b]c'i	ADC	y	$&	ADC
+'a[^-b]c'i	A-C	n	-	-
+'a[^]b]c'i	A]C	n	-	-
+'a[^]b]c'i	ADC	y	$&	ADC
+'ab|cd'i	ABC	y	$&	AB
+'ab|cd'i	ABCD	y	$&	AB
+'()ef'i	DEF	y	$&-$1	EF-
+'*a'i	-	c	-	/*a/: ?+*{} follows nothing in regexp
+'(*)b'i	-	c	-	/(*)b/: ?+*{} follows nothing in regexp
+'$b'i	B	n	-	-
+'a\'i	-	c	-	Search pattern not terminated
+'a\(b'i	A(B	y	$&-$1	A(B-
+'a\(*b'i	AB	y	$&	AB
+'a\(*b'i	A((B	y	$&	A((B
+'a\\b'i	A\B	y	$&	A\B
+'abc)'i	-	c	-	/abc)/: unmatched () in regexp
+'(abc'i	-	c	-	/(abc/: unmatched () in regexp
+'((a))'i	ABC	y	$&-$1-$2	A-A-A
+'(a)b(c)'i	ABC	y	$&-$1-$2	ABC-A-C
+'a+b+c'i	AABBABC	y	$&	ABC
+'a{1,}b{1,}c'i	AABBABC	y	$&	ABC
+'a**'i	-	c	-	/a**/: nested *?+ in regexp
+'a.+?c'i	ABCABC	y	$&	ABC
+'a.*?c'i	ABCABC	y	$&	ABC
+'a.{0,5}?c'i	ABCABC	y	$&	ABC
+'(a+|b)*'i	AB	y	$&-$1	AB-B
+'(a+|b){0,}'i	AB	y	$&-$1	AB-B
+'(a+|b)+'i	AB	y	$&-$1	AB-B
+'(a+|b){1,}'i	AB	y	$&-$1	AB-B
+'(a+|b)?'i	AB	y	$&-$1	A-A
+'(a+|b){0,1}'i	AB	y	$&-$1	A-A
+'(a+|b){0,1}?'i	AB	y	$&-$1	-
+')('i	-	c	-	/)(/: unmatched () in regexp
+'[^ab]*'i	CDE	y	$&	CDE
+'abc'i		n	-	-
+'a*'i		y	$&	
+'([abc])*d'i	ABBBCD	y	$&-$1	ABBBCD-C
+'([abc])*bcd'i	ABCD	y	$&-$1	ABCD-A
+'a|b|c|d|e'i	E	y	$&	E
+'(a|b|c|d|e)f'i	EF	y	$&-$1	EF-E
+'abcd*efg'i	ABCDEFG	y	$&	ABCDEFG
+'ab*'i	XABYABBBZ	y	$&	AB
+'ab*'i	XAYABBBZ	y	$&	A
+'(ab|cd)e'i	ABCDE	y	$&-$1	CDE-CD
+'[abhgefdc]ij'i	HIJ	y	$&	HIJ
+'^(ab|cd)e'i	ABCDE	n	x$1y	XY
+'(abc|)ef'i	ABCDEF	y	$&-$1	EF-
+'(a|b)c*d'i	ABCD	y	$&-$1	BCD-B
+'(ab|ab*)bc'i	ABC	y	$&-$1	ABC-A
+'a([bc]*)c*'i	ABC	y	$&-$1	ABC-BC
+'a([bc]*)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]+)(c*d)'i	ABCD	y	$&-$1-$2	ABCD-BC-D
+'a([bc]*)(c+d)'i	ABCD	y	$&-$1-$2	ABCD-B-CD
+'a[bcd]*dcdcde'i	ADCDCDE	y	$&	ADCDCDE
+'a[bcd]+dcdcde'i	ADCDCDE	n	-	-
+'(ab|a)b*c'i	ABC	y	$&-$1	ABC-AB
+'((a)(b)c)(d)'i	ABCD	y	$1-$2-$3-$4	ABC-A-B-D
+'[a-zA-Z_][a-zA-Z0-9_]*'i	ALPHA	y	$&	ALPHA
+'^a(bc+|b[eh])g|.h$'i	ABH	y	$&-$1	BH-
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'(bc+d$|ef*g.|h?i(j|k))'i	IJ	y	$&-$1-$2	IJ-IJ-J
+'(bc+d$|ef*g.|h?i(j|k))'i	EFFG	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	BCDD	n	-	-
+'(bc+d$|ef*g.|h?i(j|k))'i	REFFGZ	y	$&-$1-$2	EFFGZ-EFFGZ-
+'((((((((((a))))))))))'i	A	y	$10	A
+'((((((((((a))))))))))\10'i	AA	y	$&	AA
+'((((((((((a))))))))))${bang}'i	AA	n	-	-
+'((((((((((a))))))))))${bang}'i	A!	y	$&	A!
+'(((((((((a)))))))))'i	A	y	$&	A
+'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i	A	y	$1	A
+'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i	C	y	$1	C
+'multiple words of text'i	UH-UH	n	-	-
+'multiple words'i	MULTIPLE WORDS, YEAH	y	$&	MULTIPLE WORDS
+'(.*)c(.*)'i	ABCDE	y	$&-$1-$2	ABCDE-AB-DE
+'\((.*), (.*)\)'i	(A, B)	y	($2, $1)	(B, A)
+'[k]'i	AB	n	-	-
+'abcd'i	ABCD	y	$&-\$&-\\$&	ABCD-$&-\ABCD
+'a(bc)d'i	ABCD	y	$1-\$1-\\$1	BC-$1-\BC
+'a[-]?c'i	AC	y	$&	AC
+'(abc)\1'i	ABCABC	y	$1	ABC
+'([a-c]*)\1'i	ABCABC	y	$1	ABC
+a(?!b).	abad	y	$&	ad
+a(?=d).	abad	y	$&	ad
+a(?=c|d).	abad	y	$&	ad
+a(?:b|c|d)(.)	ace	y	$1	e
+a(?:b|c|d)*(.)	ace	y	$1	e
+a(?:b|c|d)+?(.)	ace	y	$1	e
+a(?:b|c|d)+?(.)	acdbcdbe	y	$1	d
+a(?:b|c|d)+(.)	acdbcdbe	y	$1	e
+a(?:b|c|d){2}(.)	acdbcdbe	y	$1	b
+a(?:b|c|d){4,5}(.)	acdbcdbe	y	$1	b
+a(?:b|c|d){4,5}?(.)	acdbcdbe	y	$1	d
+((foo)|(bar))*	foobar	y	$1-$2-$3	bar-foo-bar
+:(?:	-	c	-	/(?/: Sequence (? incomplete
+a(?:b|c|d){6,7}(.)	acdbcdbe	y	$1	e
+a(?:b|c|d){6,7}?(.)	acdbcdbe	y	$1	e
+a(?:b|c|d){5,6}(.)	acdbcdbe	y	$1	e
+a(?:b|c|d){5,6}?(.)	acdbcdbe	y	$1	b
+a(?:b|c|d){5,7}(.)	acdbcdbe	y	$1	e
+a(?:b|c|d){5,7}?(.)	acdbcdbe	y	$1	b
+a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
+^(.+)?B	AB	y	$1	A
+^([^a-z])|(\^)$	.	y	$1	.
+^[<>]&	<&OUT	y	$&	<&
+^(a\1?){4}$	aaaaaaaaaa	y	$1	aaaa
+^(a\1?){4}$	aaaaaaaaa	n	-	-
+^(a\1?){4}$	aaaaaaaaaaa	n	-	-
+^(a(?(1)\1)){4}$	aaaaaaaaaa	y	$1	aaaa
+^(a(?(1)\1)){4}$	aaaaaaaaa	n	-	-
+^(a(?(1)\1)){4}$	aaaaaaaaaaa	n	-	-
+(?:(f)(o)(o)|(b)(a)(r))*	foobar	y	$1:$2:$3:$4:$5:$6	f:o:o:b:a:r
+(?<=a)b	ab	y	$&	b
+(?<=a)b	cb	n	-	-
+(?<=a)b	b	n	-	-
+(?<!c)b	ab	y	$&	b
+(?<!c)b	cb	n	-	-
+(?<!c)b	b	y	-	-
+(?<!c)b	b	y	$&	b
+(?<%)b	-	c	-	/(?<%)b/: Sequence (?%...) not recognized
+(?:..)*a	aba	y	$&	aba
+(?:..)*?a	aba	y	$&	a
+^(?:b|a(?=(.)))*\1	abc	y	$&	ab
+^(){3,5}	abc	y	a$1	a
+^(a+)*ax	aax	y	$1	a
+^((a|b)+)*ax	aax	y	$1	a
+^((a|bc)+)*ax	aax	y	$1	a
+(a|x)*ab	cab	y	y$1	y
+(a)*ab	cab	y	y$1	y
+(?:(?i)a)b	ab	y	$&	ab
+((?i)a)b	ab	y	$&:$1	ab:a
+(?:(?i)a)b	Ab	y	$&	Ab
+((?i)a)b	Ab	y	$&:$1	Ab:A
+(?:(?i)a)b	aB	n	-	-
+((?i)a)b	aB	n	-	-
+(?i:a)b	ab	y	$&	ab
+((?i:a))b	ab	y	$&:$1	ab:a
+(?i:a)b	Ab	y	$&	Ab
+((?i:a))b	Ab	y	$&:$1	Ab:A
+(?i:a)b	aB	n	-	-
+((?i:a))b	aB	n	-	-
+'(?:(?-i)a)b'i	ab	y	$&	ab
+'((?-i)a)b'i	ab	y	$&:$1	ab:a
+'(?:(?-i)a)b'i	aB	y	$&	aB
+'((?-i)a)b'i	aB	y	$&:$1	aB:a
+'(?:(?-i)a)b'i	Ab	n	-	-
+'((?-i)a)b'i	Ab	n	-	-
+'(?:(?-i)a)b'i	aB	y	$&	aB
+'((?-i)a)b'i	aB	y	$1	a
+'(?:(?-i)a)b'i	AB	n	-	-
+'((?-i)a)b'i	AB	n	-	-
+'(?-i:a)b'i	ab	y	$&	ab
+'((?-i:a))b'i	ab	y	$&:$1	ab:a
+'(?-i:a)b'i	aB	y	$&	aB
+'((?-i:a))b'i	aB	y	$&:$1	aB:a
+'(?-i:a)b'i	Ab	n	-	-
+'((?-i:a))b'i	Ab	n	-	-
+'(?-i:a)b'i	aB	y	$&	aB
+'((?-i:a))b'i	aB	y	$1	a
+'(?-i:a)b'i	AB	n	-	-
+'((?-i:a))b'i	AB	n	-	-
+'((?-i:a.))b'i	a\nB	n	-	-
+'((?s-i:a.))b'i	a\nB	y	$1	a\n
+'((?s-i:a.))b'i	B\nB	n	-	-
+(?:c|d)(?:)(?:a(?:)(?:b)(?:b(?:))(?:b(?:)(?:b)))	cabbbb	y	$&	cabbbb
+(?:c|d)(?:)(?:aaaaaaaa(?:)(?:bbbbbbbb)(?:bbbbbbbb(?:))(?:bbbbbbbb(?:)(?:bbbbbbbb)))	caaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb	y	$&	caaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
+'(ab)\d\1'i	Ab4ab	y	$1	Ab
+'(ab)\d\1'i	ab4Ab	y	$1	ab
+foo\w*\d{4}baz	foobar1234baz	y	$&	foobar1234baz
+a(?{})b	cabd	y	$&	ab
+a(?{)b	-	c	-	/a(?{)b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{{})b	-	c	-	/a(?{{})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{}})b	-	c	-	/a(?{}})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{"{"})b	-	c	-	/a(?{"{"})b/: Sequence (?{...}) not terminated or not {}-balanced
+a(?{"\{"})b	cabd	y	$&	ab
+a(?{"{"}})b	-	c	-	Unmatched right bracket
+a(?{$bl="\{"}).b	caxbd	y	$bl	{
+x(~~)*(?:(?:F)?)?	x~~	y	-	-
+^a(?#xxx){3}c	aaac	y	$&	aaac
+'^a (?#xxx) (?#yyy) {3}c'x	aaac	y	$&	aaac
+(?<![cd])b	dbcb	n	-	-
+(?<![cd])[ab]	dbaacb	y	$&	a
+(?<!(c|d))b	dbcb	n	-	-
+(?<!(c|d))[ab]	dbaacb	y	$&	a
+(?<!cd)[ab]	cdaccb	y	$&	b
+^(?:a?b?)*$	a--	n	-	-
+((?s)^a(.))((?m)^b$)	a\nb\nc\n	y	$1;$2;$3	a\n;\n;b
+((?m)^b$)	a\nb\nc\n	y	$1	b
+(?m)^b	a\nb\n	y	$&	b
+(?m)^(b)	a\nb\n	y	$1	b
+((?m)^b)	a\nb\n	y	$1	b
+\n((?m)^b)	a\nb\n	y	$1	b
+((?s).)c(?!.)	a\nb\nc\n	y	$1	\n
+((?s).)c(?!.)	a\nb\nc\n	y	$1:$&	\n:\nc
+((?s)b.)c(?!.)	a\nb\nc\n	y	$1	b\n
+((?s)b.)c(?!.)	a\nb\nc\n	y	$1:$&	b\n:b\nc
+^b	a\nb\nc\n	n	-	-
+()^b	a\nb\nc\n	n	-	-
+((?m)^b)	a\nb\nc\n	y	$1	b
+(?(1)a|b)	a	n	-	-
+(?(1)b|a)	a	y	$&	a
+(x)?(?(1)a|b)	a	n	-	-
+(x)?(?(1)b|a)	a	y	$&	a
+()?(?(1)b|a)	a	y	$&	a
+()(?(1)b|a)	a	n	-	-
+()?(?(1)a|b)	a	y	$&	a
+^(\()?blah(?(1)(\)))$	(blah)	y	$2	)
+^(\()?blah(?(1)(\)))$	blah	y	($2)	()
+^(\()?blah(?(1)(\)))$	blah)	n	-	-
+^(\()?blah(?(1)(\)))$	(blah	n	-	-
+^(\(+)?blah(?(1)(\)))$	(blah)	y	$2	)
+^(\(+)?blah(?(1)(\)))$	blah	y	($2)	()
+^(\(+)?blah(?(1)(\)))$	blah)	n	-	-
+^(\(+)?blah(?(1)(\)))$	(blah	n	-	-
+(?(1?)a|b)	a	c	-	/(?(1?)a|b)/: Switch (?(number? not recognized
+(?(1)a|b|c)	a	c	-	/(?(1)a|b|c)/: Switch (?(condition)... contains too many branches
+(?(?{0})a|b)	a	n	-	-
+(?(?{0})b|a)	a	y	$&	a
+(?(?{1})b|a)	a	n	-	-
+(?(?{1})a|b)	a	y	$&	a
+(?(?!a)a|b)	a	n	-	-
+(?(?!a)b|a)	a	y	$&	a
+(?(?=a)b|a)	a	n	-	-
+(?(?=a)a|b)	a	y	$&	a
+(?=(a+?))(\1ab)	aaab	y	$2	aab
+^(?=(a+?))\1ab	aaab	n	-	-
+(\w+:)+	one:	y	$1	one:
+$(?<=^(a))	a	y	$1	a
+(?=(a+?))(\1ab)	aaab	y	$2	aab
+^(?=(a+?))\1ab	aaab	n	-	-
+([\w:]+::)?(\w+)$	abcd:	n	-	-
+([\w:]+::)?(\w+)$	abcd	y	$1-$2	-abcd
+([\w:]+::)?(\w+)$	xy:z:::abcd	y	$1-$2	xy:z:::-abcd
+^[^bcd]*(c+)	aexycd	y	$1	c
+(a*)b+	caab	y	$1	aa
+([\w:]+::)?(\w+)$	abcd:	n	-	-
+([\w:]+::)?(\w+)$	abcd	y	$1-$2	-abcd
+([\w:]+::)?(\w+)$	xy:z:::abcd	y	$1-$2	xy:z:::-abcd
+^[^bcd]*(c+)	aexycd	y	$1	c
+(?{$a=2})a*aa(?{local$a=$a+1})k*c(?{$b=$a})	yaaxxaaaacd	y	$b	3
+(?{$a=2})(a(?{local$a=$a+1}))*aak*c(?{$b=$a})	yaaxxaaaacd	y	$b	4
+(>a+)ab	aaab	n	-	-
+(?>a+)b	aaab	y	-	-
+([[:]+)	a:[b]:	y	$1	:[
+([[=]+)	a=[b]=	y	$1	=[
+([[.]+)	a.[b].	y	$1	.[
+[a[:xyz:	-	c	-	/[a[:xyz:/: unmatched [] in regexp
+[a[:xyz:]	-	c	-	/[a[:xyz:]/: unmatched [] in regexp
+([a[:xyz:]b]+)	pbaq	y	$1	ba
+((?>a+)b)	aaab	y	$1	aaab
+(?>(a+))b	aaab	y	$1	aaa
+((?>[^()]+)|\([^()]*\))+	((abc(ade)ufh()()x	y	$&	abc(ade)ufh()()x
+(?<=x+)y	-	c	-	/(?<=x+)y/: variable length lookbehind not implemented
+a{37,17}	-	c	-	/a{37,17}/: Can't do {n,m} with n > m
+a\Z	a\nb\n	n	-	-
+b\Z	a\nb\n	y	-	-
+b\z	a\nb\n	n	-	-
+b\Z	a\nb	y	-	-
+b\z	a\nb	y	-	-
diff --git a/contrib/perl5/t/op/read.t b/contrib/perl5/t/op/read.t
new file mode 100755
index 0000000..2746970
--- /dev/null
+++ b/contrib/perl5/t/op/read.t
@@ -0,0 +1,19 @@
+#!./perl
+
+# $RCSfile: read.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:17 $
+
+print "1..4\n";
+
+
+open(FOO,'op/read.t') || open(FOO,'t/op/read.t') || die "Can't open op.read";
+seek(FOO,4,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 4 ? "ok 1\n" : "not ok 1\n");
+print ($buf eq "perl" ? "ok 2\n" : "not ok 2 :$buf:\n");
+
+seek (FOO,0,2) || seek(FOO,20000,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 0 ? "ok 3\n" : "not ok 3\n");
+print ($buf eq "" ? "ok 4\n" : "not ok 4\n");
diff --git a/contrib/perl5/t/op/readdir.t b/contrib/perl5/t/op/readdir.t
new file mode 100755
index 0000000..ca19ebc
--- /dev/null
+++ b/contrib/perl5/t/op/readdir.t
@@ -0,0 +1,25 @@
+#!./perl
+
+eval 'opendir(NOSUCH, "no/such/directory");';
+if ($@) { print "1..0\n"; exit; }
+
+print "1..3\n";
+
+if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; }
+@D = grep(/^[^\.].*\.t$/i, readdir(OP));
+closedir(OP);
+
+if (@D > 20 && @D < 100) { print "ok 2\n"; } else { print "not ok 2\n"; }
+
+@R = sort @D;
+@G = sort <op/*.t>;
+if ($G[0] =~ m#.*\](\w+\.t)#i) {
+    # grep is to convert filespecs returned from glob under VMS to format
+    # identical to that returned by readdir
+    @G = grep(s#.*\](\w+\.t).*#op/$1#i,<op/*.t>);
+}
+while (@R && @G && "op/".$R[0] eq $G[0]) {
+	shift(@R);
+	shift(@G);
+}
+if (@R == 0 && @G == 0) { print "ok 3\n"; } else { print "not ok 3\n"; }
diff --git a/contrib/perl5/t/op/recurse.t b/contrib/perl5/t/op/recurse.t
new file mode 100755
index 0000000..6594940
--- /dev/null
+++ b/contrib/perl5/t/op/recurse.t
@@ -0,0 +1,86 @@
+#!./perl
+
+#
+# test recursive functions.
+#
+
+print "1..23\n";
+
+sub gcd ($$) {
+    return gcd($_[0] - $_[1], $_[1]) if ($_[0] > $_[1]);
+    return gcd($_[0], $_[1] - $_[0]) if ($_[0] < $_[1]);
+    $_[0];
+}
+
+sub factorial ($) {
+    $_[0] < 2 ? 1 : $_[0] * factorial($_[0] - 1);
+}
+
+sub fibonacci ($) {
+    $_[0] < 2 ? 1 : fibonacci($_[0] - 2) + fibonacci($_[0] - 1);
+}
+
+# Highly recursive, highly aggressive.
+# Kids, don't try this at home.
+#
+# For example ackermann(4,1) will take quite a long time.
+# It will simply eat away your memory. Trust me.
+
+sub ackermann ($$) {
+    return $_[1] + 1               if ($_[0] == 0);
+    return ackermann($_[0] - 1, 1) if ($_[1] == 0);
+    ackermann($_[0] - 1, ackermann($_[0], $_[1] - 1));
+}
+
+# Highly recursive, highly boring.
+
+sub takeuchi ($$$) {
+    $_[1] < $_[0] ?
+	takeuchi(takeuchi($_[0] - 1, $_[1], $_[2]),
+		 takeuchi($_[1] - 1, $_[2], $_[0]),
+		 takeuchi($_[2] - 1, $_[0], $_[1]))
+	    : $_[2];
+}
+
+print 'not ' unless (($d = gcd(1147, 1271)) == 31);
+print "ok 1\n";
+print "# gcd(1147, 1271) = $d\n";
+
+print 'not ' unless (($d = gcd(1908, 2016)) == 36);
+print "ok 2\n";
+print "# gcd(1908, 2016) = $d\n";
+
+print 'not ' unless (($f = factorial(10)) == 3628800);
+print "ok 3\n";
+print "# factorial(10) = $f\n";
+
+print 'not ' unless (($f = factorial(factorial(3))) == 720);
+print "ok 4\n";
+print "# factorial(factorial(3)) = $f\n";
+
+print 'not ' unless (($f = fibonacci(10)) == 89);
+print "ok 5\n";
+print "# fibonacci(10) = $f\n";
+
+print 'not ' unless (($f = fibonacci(fibonacci(7))) == 17711);
+print "ok 6\n";
+print "# fibonacci(fibonacci(7)) = $f\n";
+
+$i = 7;
+
+@ack = qw(1 2 3 4 2 3 4 5 3 5 7 9 5 13 29 61);
+
+for $x (0..3) { 
+    for $y (0..3) {
+	$a = ackermann($x, $y);
+	print 'not ' unless ($a == shift(@ack));
+	print "ok ", $i++, "\n";
+	print "# ackermann($x, $y) = $a\n";
+    }
+}
+
+($x, $y, $z) = (18, 12, 6);
+
+print 'not ' unless (($t = takeuchi($x, $y, $z)) == $z + 1);
+print "ok ", $i++, "\n";
+print "# takeuchi($x, $y, $z) = $t\n";
diff --git a/contrib/perl5/t/op/ref.t b/contrib/perl5/t/op/ref.t
new file mode 100755
index 0000000..1d70f9f
--- /dev/null
+++ b/contrib/perl5/t/op/ref.t
@@ -0,0 +1,287 @@
+#!./perl
+
+print "1..55\n";
+
+# Test glob operations.
+
+$bar = "ok 1\n";
+$foo = "ok 2\n";
+{
+    local(*foo) = *bar;
+    print $foo;
+}
+print $foo;
+
+$baz = "ok 3\n";
+$foo = "ok 4\n";
+{
+    local(*foo) = 'baz';
+    print $foo;
+}
+print $foo;
+
+$foo = "ok 6\n";
+{
+    local(*foo);
+    print $foo;
+    $foo = "ok 5\n";
+    print $foo;
+}
+print $foo;
+
+# Test fake references.
+
+$baz = "ok 7\n";
+$bar = 'baz';
+$foo = 'bar';
+print $$$foo;
+
+# Test real references.
+
+$FOO = \$BAR;
+$BAR = \$BAZ;
+$BAZ = "ok 8\n";
+print $$$FOO;
+
+# Test references to real arrays.
+
+@ary = (9,10,11,12);
+$ref[0] = \@a;
+$ref[1] = \@b;
+$ref[2] = \@c;
+$ref[3] = \@d;
+for $i (3,1,2,0) {
+    push(@{$ref[$i]}, "ok $ary[$i]\n");
+}
+print @a;
+print ${$ref[1]}[0];
+print @{$ref[2]}[0];
+print @{'d'};
+
+# Test references to references.
+
+$refref = \\$x;
+$x = "ok 13\n";
+print $$$refref;
+
+# Test nested anonymous lists.
+
+$ref = [[],2,[3,4,5,]];
+print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n";
+print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n";
+print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
+print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";
+
+print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
+print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 19\n";
+
+# Test references to hashes of references.
+
+$refref = \%whatever;
+$refref->{"key"} = $ref;
+print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n";
+
+# Test to see if anonymous subarrays spring into existence.
+
+$spring[5]->[0] = 123;
+$spring[5]->[1] = 456;
+push(@{$spring[5]}, 789);
+print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n";
+
+# Test to see if anonymous subhashes spring into existence.
+
+@{$spring2{"foo"}} = (1,2,3);
+$spring2{"foo"}->[3] = 4;
+print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n";
+
+# Test references to subroutines.
+
+sub mysub { print "ok 23\n" }
+$subref = \&mysub;
+&$subref;
+
+$subrefref = \\&mysub2;
+$$subrefref->("ok 24\n");
+sub mysub2 { print shift }
+
+# Test the ref operator.
+
+print ref $subref	eq CODE  ? "ok 25\n" : "not ok 25\n";
+print ref $ref		eq ARRAY ? "ok 26\n" : "not ok 26\n";
+print ref $refref	eq HASH  ? "ok 27\n" : "not ok 27\n";
+
+# Test anonymous hash syntax.
+
+$anonhash = {};
+print ref $anonhash	eq HASH  ? "ok 28\n" : "not ok 28\n";
+$anonhash2 = {FOO => BAR, ABC => XYZ,};
+print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n";
+
+# Test bless operator.
+
+package MYHASH;
+
+$object = bless $main'anonhash2;
+print ref $object	eq MYHASH  ? "ok 30\n" : "not ok 30\n";
+print $object->{ABC}	eq XYZ     ? "ok 31\n" : "not ok 31\n";
+
+$object2 = bless {};
+print ref $object2	eq MYHASH  ? "ok 32\n" : "not ok 32\n";
+
+# Test ordinary call on object method.
+
+&mymethod($object,33);
+
+sub mymethod {
+    local($THIS, @ARGS) = @_;
+    die 'Got a "' . ref($THIS). '" instead of a MYHASH'
+	unless ref $THIS eq MYHASH;
+    print $THIS->{FOO} eq BAR  ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n";
+}
+
+# Test automatic destructor call.
+
+$string = "not ok 34\n";
+$object = "foo";
+$string = "ok 34\n";
+$main'anonhash2 = "foo";
+$string = "";
+
+DESTROY {
+    return unless $string;
+    print $string;
+
+    # Test that the object has not already been "cursed".
+    print ref shift ne HASH ? "ok 35\n" : "not ok 35\n";
+}
+
+# Now test inheritance of methods.
+
+package OBJ;
+
+@ISA = (BASEOBJ);
+
+$main'object = bless {FOO => foo, BAR => bar};
+
+package main;
+
+# Test arrow-style method invocation.
+
+print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n";
+
+# Test indirect-object-style method invocation.
+
+$foo = doit $object "FOO";
+print $foo eq foo ? "ok 37\n" : "not ok 37\n";
+
+sub BASEOBJ'doit {
+    local $ref = shift;
+    die "Not an OBJ" unless ref $ref eq OBJ;
+    $ref->{shift()};
+}
+
+package UNIVERSAL;
+@ISA = 'LASTCHANCE';
+
+package LASTCHANCE;
+sub foo { print $_[1] }
+
+package WHATEVER;
+foo WHATEVER "ok 38\n";
+
+#
+# test the \(@foo) construct
+#
+package main;
+@foo = (1,2,3);
+@bar = \(@foo);
+@baz = \(1,@foo,@bar);
+print @bar == 3 ? "ok 39\n" : "not ok 39\n";
+print grep(ref($_), @bar) == 3 ? "ok 40\n" : "not ok 40\n";
+print @baz == 3 ? "ok 41\n" : "not ok 41\n";
+
+my(@fuu) = (1,2,3);
+my(@baa) = \(@fuu);
+my(@bzz) = \(1,@fuu,@baa);
+print @baa == 3 ? "ok 42\n" : "not ok 42\n";
+print grep(ref($_), @baa) == 3 ? "ok 43\n" : "not ok 43\n";
+print @bzz == 3 ? "ok 44\n" : "not ok 44\n";
+
+# test for proper destruction of lexical objects
+
+sub larry::DESTROY { print "# larry\nok 45\n"; }
+sub curly::DESTROY { print "# curly\nok 46\n"; }
+sub moe::DESTROY   { print "# moe\nok 47\n"; }
+
+{
+    my ($joe, @curly, %larry);
+    my $moe = bless \$joe, 'moe';
+    my $curly = bless \@curly, 'curly';
+    my $larry = bless \%larry, 'larry';
+    print "# leaving block\n";
+}
+
+print "# left block\n";
+
+# another glob test
+
+$foo = "not ok 48";
+{ local(*bar) = "foo" }
+$bar = "ok 48";
+local(*bar) = *bar;
+print "$bar\n";
+
+$var = "ok 49";
+$_   = \$var;
+print $$_,"\n";
+
+# test if reblessing during destruction results in more destruction
+
+{
+    package A;
+    sub new { bless {}, shift }
+    DESTROY { print "# destroying 'A'\nok 51\n" }
+    package B;
+    sub new { bless {}, shift }
+    DESTROY { print "# destroying 'B'\nok 50\n"; bless shift, 'A' }
+    package main;
+    my $b = B->new;
+}
+
+# test if $_[0] is properly protected in DESTROY()
+
+{
+    my $i = 0;
+    local $SIG{'__DIE__'} = sub {
+	my $m = shift;
+	if ($i++ > 4) {
+	    print "# infinite recursion, bailing\nnot ok 52\n";
+	    exit 1;
+        }
+	print "# $m";
+	if ($m =~ /^Modification of a read-only/) { print "ok 52\n" }
+    };
+    package C;
+    sub new { bless {}, shift }
+    DESTROY { $_[0] = 'foo' }
+    {
+	print "# should generate an error...\n";
+	my $c = C->new;
+    }
+    print "# good, didn't recurse\n";
+}
+
+# test global destruction
+
+package FINALE;
+
+{
+    $ref3 = bless ["ok 55\n"];		# package destruction
+    my $ref2 = bless ["ok 54\n"];	# lexical destruction
+    local $ref1 = bless ["ok 53\n"];	# dynamic destruction
+    1;					# flush any temp values on stack
+}
+
+DESTROY {
+    print $_[0][0];
+}
diff --git a/contrib/perl5/t/op/regexp.t b/contrib/perl5/t/op/regexp.t
new file mode 100755
index 0000000..11b3ee3
--- /dev/null
+++ b/contrib/perl5/t/op/regexp.t
@@ -0,0 +1,97 @@
+#!./perl
+
+# XXX known to leak scalars
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+
+# The tests are in a separate file 't/op/re_tests'.
+# Each line in that file is a separate test.
+# There are five columns, separated by tabs.
+#
+# Column 1 contains the pattern, optionally enclosed in C<''>.
+# Modifiers can be put after the closing C<'>.
+#
+# Column 2 contains the string to be matched.
+#
+# Column 3 contains the expected result:
+# 	y	expect a match
+# 	n	expect no match
+# 	c	expect an error
+#
+# Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
+#
+# Column 4 contains a string, usually C<$&>.
+#
+# Column 5 contains the expected result of double-quote
+# interpolating that string after the match, or start of error message.
+#
+# \n in the tests are interpolated, as are variables of the form ${\w+}.
+#
+# If you want to add a regular expression test that can't be expressed
+# in this format, don't add it here: put it in op/pat.t instead.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+$iters = shift || 1;		# Poor man performance suite, 10000 is OK.
+
+open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') ||
+	die "Can't open re_tests";
+
+while (<TESTS>) { }
+$numtests = $.;
+seek(TESTS,0,0);
+$. = 0;
+
+$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
+
+$| = 1;
+print "1..$numtests\n# $iters iterations\n";
+TEST:
+while (<TESTS>) {
+    chomp;
+    s/\\n/\n/g;
+    ($pat, $subject, $result, $repl, $expect) = split(/\t/,$_);
+    $input = join(':',$pat,$subject,$result,$repl,$expect);
+    infty_subst(\$pat);
+    infty_subst(\$expect);
+    $pat = "'$pat'" unless $pat =~ /^[:']/;
+    $pat =~ s/\\n/\n/g;
+    $pat =~ s/(\$\{\w+\})/$1/eeg;
+    $subject =~ s/\\n/\n/g;
+    $expect =~ s/\\n/\n/g;
+    $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
+    for $study ("", "study \$subject") {
+ 	$c = $iters;
+ 	eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+	chomp( $err = $@ );
+	if ($result eq 'c') {
+	    if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
+	    last;  # no need to study a syntax error
+	}
+	elsif ($@) {
+	    print "not ok $. $input => error `$err'\n"; next TEST;
+	}
+	elsif ($result eq 'n') {
+	    if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST }
+	}
+	else {
+	    if (!$match || $got ne $expect) {
+ 		print "not ok $. ($study) $input => `$got', match=$match\n";
+		next TEST;
+	    }
+	}
+    }
+    print "ok $.\n";
+}
+
+close(TESTS);
+
+sub infty_subst                             # Special-case substitution
+{                                           #  of $reg_infty and friends
+    my $tp = shift;
+    $$tp =~ s/,\$reg_infty_m}/,$reg_infty_m}/o;
+    $$tp =~ s/,\$reg_infty_p}/,$reg_infty_p}/o;
+    $$tp =~ s/,\$reg_infty}/,$reg_infty}/o;
+}
diff --git a/contrib/perl5/t/op/regexp_noamp.t b/contrib/perl5/t/op/regexp_noamp.t
new file mode 100755
index 0000000..03c19e9
--- /dev/null
+++ b/contrib/perl5/t/op/regexp_noamp.t
@@ -0,0 +1,10 @@
+#!./perl
+
+$skip_amp = 1;
+for $file ('op/regexp.t', 't/op/regexp.t') {
+  if (-r $file) {
+    do $file;
+    exit;
+  }
+}
+die "Cannot find op/regexp.t or t/op/regexp.t\n";
diff --git a/contrib/perl5/t/op/repeat.t b/contrib/perl5/t/op/repeat.t
new file mode 100755
index 0000000..54fa590
--- /dev/null
+++ b/contrib/perl5/t/op/repeat.t
@@ -0,0 +1,42 @@
+#!./perl
+
+# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
+
+print "1..19\n";
+
+# compile time
+
+if ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";}
+if ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";}
+if ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";}
+
+if ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";}
+
+# run time
+
+$a = '-';
+if ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";}
+if ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";}
+if ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";}
+
+$a = 'ab';
+if ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";}
+
+$a = 'xyz';
+$a x= 2;
+if ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";}
+$a x= 1;
+if ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";}
+$a x= 0;
+if ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";}
+
+@x = (1,2,3);
+
+print join('', @x x 4) eq '3333' ? "ok 12\n" : "not ok 12\n";
+print join('', (@x) x 4) eq '123123123123' ? "ok 13\n" : "not ok 13\n";
+print join('', (@x,()) x 4) eq '123123123123' ? "ok 14\n" : "not ok 14\n";
+print join('', (@x,1) x 4) eq '1231123112311231' ? "ok 15\n" : "not ok 15\n";
+print join(':', () x 4) eq '' ? "ok 16\n" : "not ok 16\n";
+print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n";
+print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n";
+print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n";
diff --git a/contrib/perl5/t/op/runlevel.t b/contrib/perl5/t/op/runlevel.t
new file mode 100755
index 0000000..307e2a0
--- /dev/null
+++ b/contrib/perl5/t/op/runlevel.t
@@ -0,0 +1,317 @@
+#!./perl
+
+##
+## Many of these tests are originally from Michael Schroeder
+## <Michael.Schroeder@informatik.uni-erlangen.de>
+## Adapted and expanded by Gurusamy Sarathy <gsar@umich.edu>
+##
+
+chdir 't' if -d 't';
+@INC = "../lib";
+$Is_VMS = $^O eq 'VMS';
+$Is_MSWin32 = $^O eq 'MSWin32';
+$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
+
+$|=1;
+
+undef $/;
+@prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+$tmpfile = "runltmp000";
+1 while -f ++$tmpfile;
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+
+for (@prgs){
+    my $switch = "";
+    if (s/^\s*(-\w+)//){
+       $switch = $1;
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    open TEST, ">$tmpfile";
+    print TEST "$prog\n";
+    close TEST;
+    my $results = $Is_VMS ?
+		  `MCR $^X "-I[-.lib]" $switch $tmpfile` :
+		      $Is_MSWin32 ?  
+			  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+			      `sh -c './perl $switch $tmpfile' 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/runltmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+    $expected =~ s/\n+$//;
+    if ($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";
+}
+
+__END__
+@a = (1, 2, 3);
+{
+  @a = sort { last ; } @a;
+}
+EXPECT
+Can't "last" outside a block at - line 3.
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  eval 'die("test")';
+  print "still in fetch\n";
+  return ">$@<";
+}
+package main;
+ 
+tie $bar, TEST;
+print "- $bar\n";
+EXPECT
+still in fetch
+- >test at (eval 1) line 1.
+<
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  eval('die("foo\n")');
+  print "after eval\n";
+  return bless \$foo;
+}
+sub FETCH {
+  return "ZZZ";
+}
+ 
+package main;
+ 
+tie $bar, TEST;
+print "- $bar\n";
+print "OK\n";
+EXPECT
+after eval
+- ZZZ
+OK
+########
+package TEST;
+ 
+sub TIEHANDLE {
+  my $foo;
+  return bless \$foo;
+}
+sub PRINT {
+print STDERR "PRINT CALLED\n";
+(split(/./, 'x'x10000))[0];
+eval('die("test\n")');
+}
+ 
+package main;
+ 
+open FH, ">&STDOUT";
+tie *FH, TEST;
+print FH "OK\n";
+print STDERR "DONE\n";
+EXPECT
+PRINT CALLED
+DONE
+########
+sub warnhook {
+  print "WARNHOOK\n";
+  eval('die("foooo\n")');
+}
+$SIG{'__WARN__'} = 'warnhook';
+warn("dfsds\n");
+print "END\n";
+EXPECT
+WARNHOOK
+END
+########
+package TEST;
+ 
+use overload
+     "\"\""   =>  \&str
+;
+ 
+sub str {
+  eval('die("test\n")');
+  return "STR";
+}
+ 
+package main;
+ 
+$bar = bless {}, TEST;
+print "$bar\n";
+print "OK\n";
+EXPECT
+STR
+OK
+########
+sub foo {
+  $a <=> $b unless eval('$a == 0 ? bless undef : ($a <=> $b)');
+}
+@a = (3, 2, 0, 1);
+@a = sort foo @a;
+print join(', ', @a)."\n";
+EXPECT
+0, 1, 2, 3
+########
+sub foo {
+  goto bar if $a == 0 || $b == 0;
+  $a <=> $b;
+}
+@a = (3, 2, 0, 1);
+@a = sort foo @a;
+print join(', ', @a)."\n";
+exit;
+bar:
+print "bar reached\n";
+EXPECT
+Can't "goto" outside a block at - line 2.
+########
+sub sortfn {
+  (split(/./, 'x'x10000))[0];
+  my (@y) = ( 4, 6, 5);
+  @y = sort { $a <=> $b } @y;
+  print "sortfn ".join(', ', @y)."\n";
+  return $_[0] <=> $_[1];
+}
+@x = ( 3, 2, 1 );
+@x = sort { &sortfn($a, $b) } @x;
+print "---- ".join(', ', @x)."\n";
+EXPECT
+sortfn 4, 5, 6
+sortfn 4, 5, 6
+sortfn 4, 5, 6
+---- 1, 2, 3
+########
+@a = (3, 2, 1);
+@a = sort { eval('die("no way")') ,  $a <=> $b} @a;
+print join(", ", @a)."\n";
+EXPECT
+1, 2, 3
+########
+@a = (1, 2, 3);
+foo:
+{
+  @a = sort { last foo; } @a;
+}
+EXPECT
+Label not found for "last foo" at - line 2.
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  next;
+  return "ZZZ";
+}
+sub STORE {
+}
+ 
+package main;
+ 
+tie $bar, TEST;
+{
+  print "- $bar\n";
+}
+print "OK\n";
+EXPECT
+Can't "next" outside a block at - line 8.
+########
+package TEST;
+ 
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  goto bbb;
+  return "ZZZ";
+}
+ 
+package main;
+ 
+tie $bar, TEST;
+print "- $bar\n";
+exit;
+bbb:
+print "bbb\n";
+EXPECT
+Can't find label bbb at - line 8.
+########
+sub foo {
+  $a <=> $b unless eval('$a == 0 ? die("foo\n") : ($a <=> $b)');
+}
+@a = (3, 2, 0, 1);
+@a = sort foo @a;
+print join(', ', @a)."\n";
+EXPECT
+0, 1, 2, 3
+########
+package TEST;
+sub TIESCALAR {
+  my $foo;
+  return bless \$foo;
+}
+sub FETCH {
+  return "fetch";
+}
+sub STORE {
+(split(/./, 'x'x10000))[0];
+}
+package main;
+tie $bar, TEST;
+$bar = "x";
+########
+package TEST;
+sub TIESCALAR {
+  my $foo;
+  next;
+  return bless \$foo;
+}
+package main;
+{
+tie $bar, TEST;
+}
+EXPECT
+Can't "next" outside a block at - line 4.
+########
+@a = (1, 2, 3);
+foo:
+{
+  @a = sort { exit(0) } @a;
+}
+END { print "foobar\n" }
+EXPECT
+foobar
+########
+$SIG{__DIE__} = sub {
+    print "In DIE\n";
+    $i = 0;
+    while (($p,$f,$l,$s) = caller(++$i)) {
+        print "$p|$f|$l|$s\n";
+    }
+};
+eval { die };
+&{sub { eval 'die' }}();
+sub foo { eval { die } } foo();
+EXPECT
+In DIE
+main|-|8|(eval)
+In DIE
+main|-|9|(eval)
+main|-|9|main::__ANON__
+In DIE
+main|-|10|(eval)
+main|-|10|main::foo
diff --git a/contrib/perl5/t/op/sleep.t b/contrib/perl5/t/op/sleep.t
new file mode 100755
index 0000000..5f6c4c0
--- /dev/null
+++ b/contrib/perl5/t/op/sleep.t
@@ -0,0 +1,8 @@
+#!./perl
+
+# $RCSfile: sleep.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:23 $
+
+print "1..1\n";
+
+$x = sleep 3;
+if ($x >= 2 && $x <= 10) {print "ok 1\n";} else {print "not ok 1 $x\n";}
diff --git a/contrib/perl5/t/op/sort.t b/contrib/perl5/t/op/sort.t
new file mode 100755
index 0000000..70341b9
--- /dev/null
+++ b/contrib/perl5/t/op/sort.t
@@ -0,0 +1,127 @@
+#!./perl
+
+# $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
+
+print "1..21\n";
+
+sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
+
+my $upperfirst = 'A' lt 'a';
+
+# Beware: in future this may become hairier because of possible
+# collation complications: qw(A a B c) can be sorted at least as
+# any of the following
+#
+#	A a B b
+#	A B a b
+#	a b A B
+#	a A b B
+#
+# All the above orders make sense.
+#
+# That said, EBCDIC sorts all small letters first, as opposed
+# to ASCII which sorts all big letters first.
+
+@harry = ('dog','cat','x','Cain','Abel');
+@george = ('gone','chased','yz','punished','Axed');
+
+$x = join('', sort @harry);
+$expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain';
+print "# 1: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 1\n" : "not ok 1\n");
+
+$x = join('', sort( backwards @harry));
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 2: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ? "ok 2\n" : "not ok 2\n");
+
+$x = join('', sort @george, 'to', @harry);
+$expected = $upperfirst ?
+    'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
+    'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
+print "# 3: x = '$x', expected = '$expected'\n";
+print ($x eq $expected ?"ok 3\n":"not ok 3\n");
+
+@a = ();
+@b = reverse @a;
+print ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n");
+
+@a = (1);
+@b = reverse @a;
+print ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n");
+
+@a = (1,2);
+@b = reverse @a;
+print ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n");
+
+@a = (1,2,3);
+@b = reverse @a;
+print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n");
+
+@a = (1,2,3,4);
+@b = reverse @a;
+print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n");
+
+@a = (10,2,3,4);
+@b = sort {$a <=> $b;} @a;
+print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n");
+
+$sub = 'backwards';
+$x = join('', sort $sub @harry);
+$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat';
+print "# 10: x = $x, expected = '$expected'\n";
+print ($x eq $expected ? "ok 10\n" : "not ok 10\n");
+
+# literals, combinations
+
+@b = sort (4,1,3,2);
+print ("@b" eq '1 2 3 4' ? "ok 11\n" : "not ok 11\n");
+print "# x = '@b'\n";
+
+@b = sort grep { $_ } (4,1,3,2);
+print ("@b" eq '1 2 3 4' ? "ok 12\n" : "not ok 12\n");
+print "# x = '@b'\n";
+
+@b = sort map { $_ } (4,1,3,2);
+print ("@b" eq '1 2 3 4' ? "ok 13\n" : "not ok 13\n");
+print "# x = '@b'\n";
+
+@b = sort reverse (4,1,3,2);
+print ("@b" eq '1 2 3 4' ? "ok 14\n" : "not ok 14\n");
+print "# x = '@b'\n";
+
+$^W = 0;
+# redefining sort sub inside the sort sub should fail
+sub twoface { *twoface = sub { $a <=> $b }; &twoface }
+eval { @b = sort twoface 4,1,3,2 };
+print ($@ =~ /redefine active sort/ ? "ok 15\n" : "not ok 15\n");
+
+# redefining sort subs outside the sort should not fail
+eval { *twoface = sub { &backwards } };
+print $@ ? "not ok 16\n" : "ok 16\n";
+
+eval { @b = sort twoface 4,1,3,2 };
+print ("@b" eq '4 3 2 1' ? "ok 17\n" : "not ok 17 |@b|\n");
+
+*twoface = sub { *twoface = *backwards; $a <=> $b };
+eval { @b = sort twoface 4,1 };
+print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n");
+
+*twoface = sub {
+                 eval 'sub twoface { $a <=> $b }';
+		 die($@ =~ /redefine active sort/ ? "ok 19\n" : "not ok 19\n");
+		 $a <=> $b;
+	       };
+eval { @b = sort twoface 4,1 };
+print $@ ? "$@" : "not ok 19\n";
+
+eval <<'CODE';
+    my @result = sort main'backwards 'one', 'two';
+CODE
+print $@ ? "not ok 20\n# $@" : "ok 20\n";
+
+eval <<'CODE';
+    # "sort 'one', 'two'" should not try to parse "'one" as a sort sub
+    my @result = sort 'one', 'two';
+CODE
+print $@ ? "not ok 21\n# $@" : "ok 21\n";
diff --git a/contrib/perl5/t/op/splice.t b/contrib/perl5/t/op/splice.t
new file mode 100755
index 0000000..06e3509
--- /dev/null
+++ b/contrib/perl5/t/op/splice.t
@@ -0,0 +1,34 @@
+#!./perl
+
+print "1..9\n";
+
+@a = (1..10);
+
+sub j { join(":",@_) }
+
+print "not " unless j(splice(@a,@a,0,11,12)) eq "" && j(@a) eq j(1..12);
+print "ok 1\n";
+
+print "not " unless j(splice(@a,-1)) eq "12" && j(@a) eq j(1..11);
+print "ok 2\n";
+
+print "not " unless j(splice(@a,0,1)) eq "1" && j(@a) eq j(2..11);
+print "ok 3\n";
+
+print "not " unless j(splice(@a,0,0,0,1)) eq "" && j(@a) eq j(0..11);
+print "ok 4\n";
+
+print "not " unless j(splice(@a,5,1,5)) eq "5" && j(@a) eq j(0..11);
+print "ok 5\n";
+
+print "not " unless j(splice(@a, 20, 0, 12, 13)) eq "" && j(@a) eq j(0..13);
+print "ok 6\n";
+
+print "not " unless j(splice(@a, -@a, @a, 1, 2, 3)) eq j(0..13) && j(@a) eq j(1..3);
+print "ok 7\n";
+
+print "not " unless j(splice(@a, 1, -1, 7, 7)) eq "2" && j(@a) eq j(1,7,7,3);
+print "ok 8\n";
+
+print "not " unless j(splice(@a,-3,-2,2)) eq j(7) && j(@a) eq j(1,2,7,3);
+print "ok 9\n";
diff --git a/contrib/perl5/t/op/split.t b/contrib/perl5/t/op/split.t
new file mode 100755
index 0000000..7f0acce
--- /dev/null
+++ b/contrib/perl5/t/op/split.t
@@ -0,0 +1,113 @@
+#!./perl
+
+# $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
+
+print "1..25\n";
+
+$FS = ':';
+
+$_ = 'a:b:c';
+
+($a,$b,$c) = split($FS,$_);
+
+if (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
+
+@ary = split(/:b:/);
+if (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = "abc\n";
+@xyz = (@ary = split(//));
+if (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
+
+$_ = "a:b:c::::";
+@ary = split(/:/);
+if (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
+
+$_ = join(':',split(' ',"    a b\tc \t d "));
+if ($_ eq 'a:b:c:d') {print "ok 5\n";} else {print "not ok 5 #$_#\n";}
+
+$_ = join(':',split(/ */,"foo  bar bie\tdoll"));
+if ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
+	{print "ok 6\n";} else {print "not ok 6\n";}
+
+$_ = join(':', 'foo', split(/ /,'a b  c'), 'bar');
+if ($_ eq "foo:a:b::c:bar") {print "ok 7\n";} else {print "not ok 7 $_\n";}
+
+# Can we say how many fields to split to?
+$_ = join(':', split(' ','1 2 3 4 5 6', 3));
+print $_ eq '1:2:3 4 5 6' ? "ok 8\n" : "not ok 8 $_\n";
+
+# Can we do it as a variable?
+$x = 4;
+$_ = join(':', split(' ','1 2 3 4 5 6', $x));
+print $_ eq '1:2:3:4 5 6' ? "ok 9\n" : "not ok 9 $_\n";
+
+# Does the 999 suppress null field chopping?
+$_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
+print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
+
+# Does assignment to a list imply split to one more field than that?
+if ($^O eq 'MSWin32') { $foo = `.\\perl -D1024 -e "(\$a,\$b) = split;" 2>&1` }
+else                  { $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1` }
+if ($foo =~ /DCL-W-NOCOMD/) {
+  $foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`;
+}
+print $foo =~ /DEBUGGING/ || $foo =~ /SV = IV\(3\)/ ? "ok 11\n" : "not ok 11\n";
+
+# Can we say how many fields to split to when assigning to a list?
+($a,$b) = split(' ','1 2 3 4 5 6', 2);
+$_ = join(':',$a,$b);
+print $_ eq '1:2 3 4 5 6' ? "ok 12\n" : "not ok 12 $_\n";
+
+# do subpatterns generate additional fields (without trailing nulls)?
+$_ = join '|', split(/,|(-)/, "1-10,20,,,");
+print $_ eq "1|-|10||20" ? "ok 13\n" : "not ok 13\n";
+
+# do subpatterns generate additional fields (with a limit)?
+$_ = join '|', split(/,|(-)/, "1-10,20,,,", 10);
+print $_ eq "1|-|10||20||||||" ? "ok 14\n" : "not ok 14\n";
+
+# is the 'two undefs' bug fixed?
+(undef, $a, undef, $b) = qw(1 2 3 4);
+print "$a|$b" eq "2|4" ? "ok 15\n" : "not ok 15\n";
+
+# .. even for locals?
+{
+  local(undef, $a, undef, $b) = qw(1 2 3 4);
+  print "$a|$b" eq "2|4" ? "ok 16\n" : "not ok 16\n";
+}
+
+# check splitting of null string
+$_ = join('|', split(/x/,   '',-1), 'Z');
+print $_ eq "Z" ? "ok 17\n" : "#$_\nnot ok 17\n";
+
+$_ = join('|', split(/x/,   '', 1), 'Z');
+print $_ eq "Z" ? "ok 18\n" : "#$_\nnot ok 18\n";
+
+$_ = join('|', split(/(p+)/,'',-1), 'Z');
+print $_ eq "Z" ? "ok 19\n" : "#$_\nnot ok 19\n";
+
+$_ = join('|', split(/.?/,  '',-1), 'Z');
+print $_ eq "Z" ? "ok 20\n" : "#$_\nnot ok 20\n";
+
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^a/m, "a b a\na d a", 20);
+print $_ eq "| b a\n| d a" ? "ok 21\n" : "not ok 21\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/a$/m, "a b a\na d a", 20);
+print $_ eq "a b |\na d |" ? "ok 22\n" : "not ok 22\n# `$_'\n";
+
+# Are /^/m patterns scanned?
+$_ = join '|', split(/^aa/m, "aa b aa\naa d aa", 20);
+print $_ eq "| b aa\n| d aa" ? "ok 23\n" : "not ok 23\n# `$_'\n";
+
+# Are /$/m patterns scanned?
+$_ = join '|', split(/aa$/m, "aa b aa\naa d aa", 20);
+print $_ eq "aa b |\naa d |" ? "ok 24\n" : "not ok 24\n# `$_'\n";
+
+# Greedyness:
+$_ = "a : b :c: d";
+@ary = split(/\s*:\s*/);
+if (($res = join(".",@ary)) eq "a.b.c.d") {print "ok 25\n";} else {print "not ok 25\n# res=`$res' != `a.b.c.d'\n";}
diff --git a/contrib/perl5/t/op/sprintf.t b/contrib/perl5/t/op/sprintf.t
new file mode 100755
index 0000000..b9b4751
--- /dev/null
+++ b/contrib/perl5/t/op/sprintf.t
@@ -0,0 +1,33 @@
+#!./perl
+
+# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $
+
+print "1..4\n";
+
+$^W = 1;
+$SIG{__WARN__} = sub {
+    if ($_[0] =~ /^Invalid conversion/) {
+	$w++;
+    } else {
+	warn @_;
+    }
+};
+
+$w = 0;
+$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f","hi",123,0,456,0,ord('A'),3.0999);
+if ($x eq ' hi 123 %foo   456 0A3.1' && $w == 0) {
+    print "ok 1\n";
+} else {
+    print "not ok 1 '$x'\n";
+}
+
+for $i (2 .. 4) {
+    $f = ('%6 .6s', '%6. 6s', '%6.6 s')[$i - 2];
+    $w = 0;
+    $x = sprintf($f, '');
+    if ($x eq $f && $w == 1) {
+	print "ok $i\n";
+    } else {
+	print "not ok $i '$x' '$f' '$w'\n";
+    }
+}
diff --git a/contrib/perl5/t/op/stat.t b/contrib/perl5/t/op/stat.t
new file mode 100755
index 0000000..2207b40
--- /dev/null
+++ b/contrib/perl5/t/op/stat.t
@@ -0,0 +1,252 @@
+#!./perl
+
+# $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Config;
+
+print "1..58\n";
+
+$Is_MSWin32 = $^O eq 'MSWin32';
+$Is_Dos = $^O eq 'dos';
+$Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32;
+chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`));
+
+$DEV = `ls -l /dev` unless $Is_Dosish;
+
+unlink "Op.stat.tmp";
+open(FOO, ">Op.stat.tmp");
+
+# hack to make Apollo update link count:
+$junk = `ls Op.stat.tmp` unless ($Is_MSWin32 || $Is_Dos);
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat(FOO);
+if ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($Is_MSWin32 || ($mtime && $mtime == $ctime)) {print "ok 2\n";}
+else {print "# |$mtime| vs |$ctime|\nnot ok 2\n";}
+
+print FOO "Now is the time for all good men to come to.\n";
+close(FOO);
+
+sleep 2;
+
+if ($Is_Dosish) { unlink "Op.stat.tmp2" }
+else {
+    `rm -f Op.stat.tmp2;ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
+}
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+    $blksize,$blocks) = stat('Op.stat.tmp');
+
+if ($Is_Dosish || $Config{dont_use_nlink})
+    {print "ok 3 # skipped: no link count\n";} 
+elsif ($nlink == 2)
+    {print "ok 3\n";} 
+else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
+
+if (   $Is_Dosish
+	|| ($cwd =~ m#^/tmp# and $mtime && $mtime==$ctime) # Solaris tmpfs bug
+	|| $cwd =~ m#/afs/#
+	|| $^O eq 'amigaos') {
+    print "ok 4 # skipped: different semantic of mtime/ctime\n";
+}
+elsif (   ($mtime && $mtime != $ctime)  ) {
+    print "ok 4\n";
+}
+else {
+    print "not ok 4\n";
+    print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
+    print "#4 of some sort.  Building in /tmp sometimes has this problem.\n";
+}
+print "#4	:$mtime: should != :$ctime:\n";
+
+unlink "Op.stat.tmp";
+if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
+else             { `touch Op.stat.tmp` }
+
+if (-z 'Op.stat.tmp') {print "ok 5\n";} else {print "not ok 5\n";}
+if (! -s 'Op.stat.tmp') {print "ok 6\n";} else {print "not ok 6\n";}
+
+$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
+if (! -z 'Op.stat.tmp') {print "ok 7\n";} else {print "not ok 7\n";}
+if (-s 'Op.stat.tmp') {print "ok 8\n";} else {print "not ok 8\n";}
+
+unlink 'Op.stat.tmp';
+$olduid = $>;		# can't test -r if uid == 0
+$Is_MSWin32 ? `cmd /c echo hi > Op.stat.tmp` : `echo hi >Op.stat.tmp`;
+chmod 0,'Op.stat.tmp';
+eval '$> = 1;';		# so switch uid (may not be implemented)
+if (!$> || $Is_Dos || ! -r 'Op.stat.tmp') {print "ok 9\n";} else {print "not ok 9\n";}
+if (!$> || ! -w 'Op.stat.tmp') {print "ok 10\n";} else {print "not ok 10\n";}
+eval '$> = $olduid;';		# switch uid back (may not be implemented)
+print "# olduid=$olduid, newuid=$>\n" unless ($> == $olduid);
+
+if (! -x 'Op.stat.tmp') {print "ok 11\n";}
+else                    {print "not ok 11\n";}
+
+foreach ((12,13,14,15,16,17)) {
+    print "ok $_\n";		#deleted tests
+}
+
+chmod 0700,'Op.stat.tmp';
+if (-r 'Op.stat.tmp') {print "ok 18\n";} else {print "not ok 18\n";}
+if (-w 'Op.stat.tmp') {print "ok 19\n";} else {print "not ok 19\n";}
+if ($Is_Dosish) {print "ok 20 # skipped: -x by extension\n";} 
+elsif (-x 'Op.stat.tmp') {print "ok 20\n";} 
+else {print "not ok 20\n";}
+
+if (-f 'Op.stat.tmp') {print "ok 21\n";} else {print "not ok 21\n";}
+if (! -d 'Op.stat.tmp') {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
+if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
+
+if (!$Is_Dosish and `ls -l perl` =~ /^l.*->/) {
+    if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
+}
+else {
+    print "ok 25\n";
+}
+
+if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
+
+if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
+unlink 'Op.stat.tmp2';
+if (! -e 'Op.stat.tmp2') {print "ok 28\n";} else {print "not ok 28\n";}
+
+if ($Is_MSWin32 || $Is_Dos)
+    {print "ok 29\n";}
+elsif ($DEV !~ /\nc.* (\S+)\n/)
+    {print "ok 29\n";}
+elsif (-c "/dev/$1")
+    {print "ok 29\n";}
+else
+    {print "not ok 29\n";}
+if (! -c '.') {print "ok 30\n";} else {print "not ok 30\n";}
+
+if ($Is_MSWin32 || $Is_Dos)
+    {print "ok 31\n";}
+elsif ($DEV !~ /\ns.* (\S+)\n/)
+    {print "ok 31\n";}
+elsif (-S "/dev/$1")
+    {print "ok 31\n";}
+else
+    {print "not ok 31\n";}
+if (! -S '.') {print "ok 32\n";} else {print "not ok 32\n";}
+
+if ($Is_MSWin32 || $Is_Dos)
+    {print "ok 33\n";}
+elsif ($DEV !~ /\nb.* (\S+)\n/)
+    {print "ok 33\n";}
+elsif (-b "/dev/$1")
+    {print "ok 33\n";}
+else
+    {print "not ok 33\n";}
+if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";}
+
+if ($^O eq 'amigaos' or $Is_Dosish) {
+  print "ok 35 # skipped: no -u\n"; goto tty_test;
+}
+
+$cnt = $uid = 0;
+
+die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
+($bin) = grep {-d} ($^O eq 'machten' ? qw(/usr/bin /bin) : qw(/bin /usr/bin))
+    or print ("not ok 35\n"), goto tty_test;
+opendir BIN, $bin or die "Can't opendir $bin: $!";
+while (defined($_ = readdir BIN)) {
+    $_ = "$bin/$_";
+    $cnt++;
+    $uid++ if -u;
+    last if $uid && $uid < $cnt;
+}
+closedir BIN;
+
+# I suppose this is going to fail somewhere...
+if ($uid > 0 && $uid < $cnt)
+    {print "ok 35\n";}
+else
+    {print "not ok 35 \n# ($uid $cnt)\n";}
+
+tty_test:
+
+# To assist in automated testing when a controlling terminal (/dev/tty)
+# may not be available (at, cron  rsh etc), the PERL_SKIP_TTY_TEST env var
+# can be set to skip the tests that need a tty.
+unless($ENV{PERL_SKIP_TTY_TEST}) {
+    if ($Is_MSWin32) {
+	print "ok 36\n";
+	print "ok 37\n";
+    }
+    else {
+	unless (open(tty,"/dev/tty")) {
+	    print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
+	}
+	if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
+	if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
+	close(tty);
+    }
+    if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
+    if (-t)       {print "ok 39\n";} else {print "not ok 39\n";}
+}
+else {
+    print "ok 36\n";
+    print "ok 37\n";
+    print "ok 38\n";
+    print "ok 39\n";
+}
+open(null,"/dev/null");
+if (! -t null || -e '/xenix' || $^O eq 'machten' || $Is_MSWin32)
+	{print "ok 40\n";} else {print "not ok 40\n";}
+close(null);
+
+# These aren't strictly "stat" calls, but so what?
+
+if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
+if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
+
+if (-B './perl' || -B './perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
+if (! -T './perl' && ! -T './perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
+
+open(FOO,'op/stat.t');
+eval { -T FOO; };
+if ($@ =~ /not implemented/) {
+    print "# $@";
+    for (45 .. 54) {
+	print "ok $_\n";
+    }
+}
+else {
+    if (-T FOO) {print "ok 45\n";} else {print "not ok 45\n";}
+    if (! -B FOO) {print "ok 46\n";} else {print "not ok 46\n";}
+    $_ = <FOO>;
+    if (/perl/) {print "ok 47\n";} else {print "not ok 47\n";}
+    if (-T FOO) {print "ok 48\n";} else {print "not ok 48\n";}
+    if (! -B FOO) {print "ok 49\n";} else {print "not ok 49\n";}
+    close(FOO);
+
+    open(FOO,'op/stat.t');
+    $_ = <FOO>;
+    if (/perl/) {print "ok 50\n";} else {print "not ok 50\n";}
+    if (-T FOO) {print "ok 51\n";} else {print "not ok 51\n";}
+    if (! -B FOO) {print "ok 52\n";} else {print "not ok 52\n";}
+    seek(FOO,0,0);
+    if (-T FOO) {print "ok 53\n";} else {print "not ok 53\n";}
+    if (! -B FOO) {print "ok 54\n";} else {print "not ok 54\n";}
+}
+close(FOO);
+
+if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
+if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
+
+# and now, a few parsing tests:
+$_ = 'Op.stat.tmp';
+if (-f) {print "ok 57\n";} else {print "not ok 57\n";}
+if (-f()) {print "ok 58\n";} else {print "not ok 58\n";}
+
+unlink 'Op.stat.tmp';
diff --git a/contrib/perl5/t/op/study.t b/contrib/perl5/t/op/study.t
new file mode 100755
index 0000000..ea3b366
--- /dev/null
+++ b/contrib/perl5/t/op/study.t
@@ -0,0 +1,69 @@
+#!./perl
+
+# $RCSfile: study.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:30 $
+
+print "1..24\n";
+
+$x = "abc\ndef\n";
+study($x);
+
+if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
+if ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
+
+$* = 1;
+if ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
+$* = 0;
+
+$_ = '123';
+study;
+if (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
+
+if ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
+if ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
+
+if ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
+if ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
+
+study($x);
+if ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
+if ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
+
+if ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
+if ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
+
+$_ = 'aaabbbccc';
+study;
+if (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
+	print "ok 13\n";
+} else {
+	print "not ok 13\n";
+}
+if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
+	print "ok 14\n";
+} else {
+	print "not ok 14\n";
+}
+
+if (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
+
+$_ = 'aaabccc';
+study;
+if (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
+if (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
+
+$_ = 'aaaccc';
+study;
+if (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
+if (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
+
+$_ = 'abcdef';
+study;
+if (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
+if (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
+
+if (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
+
+if (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
+
+$* = 1;		# test 3 only tested the optimized version--this one is for real
+if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
diff --git a/contrib/perl5/t/op/subst.t b/contrib/perl5/t/op/subst.t
new file mode 100755
index 0000000..afa06ab
--- /dev/null
+++ b/contrib/perl5/t/op/subst.t
@@ -0,0 +1,310 @@
+#!./perl
+
+print "1..71\n";
+
+$x = 'foo';
+$_ = "x";
+s/x/\$x/;
+print "#1\t:$_: eq :\$x:\n";
+if ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$_ = "x";
+s/x/$x/;
+print "#2\t:$_: eq :foo:\n";
+if ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
+
+$_ = "x";
+s/x/\$x $x/;
+print "#3\t:$_: eq :\$x foo:\n";
+if ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
+
+$b = 'cd';
+($a = 'abcdef') =~ s<(b${b}e)>'\n$1';
+print "#4\t:$1: eq :bcde:\n";
+print "#4\t:$a: eq :a\\n\$1f:\n";
+if ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$a = 'abacada';
+if (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
+    {print "ok 5\n";} else {print "not ok 5\n";}
+
+if (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
+    {print "ok 6\n";} else {print "not ok 6 $a\n";}
+
+if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
+    {print "ok 7\n";} else {print "not ok 7 $a\n";}
+
+$_ = 'ABACADA';
+if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
+
+$_ = '\\' x 4;
+if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
+s/\\/\\\\/g;
+if ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10 $_\n";}
+
+$_ = '\/' x 4;
+if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
+s/\//\/\//g;
+if ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
+if (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
+
+$_ = 'aaaXXXXbbb';
+s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
+
+$_ = 'aaaXXXXbbb';
+s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
+
+$_ = 'aaaXXXXbbb';
+s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
+
+$_ = 'aaaXXXXbbb';
+s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
+
+$_ = 'aaaXXXXbbb';
+s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
+
+$_ = 'aaaXXXXbbb';
+s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
+
+$_ = 'aaaXXXXbbb';
+s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
+
+$_ = 'aaaXXXXbbb';
+s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
+
+$_ = 'aaaXXXXbbb';
+s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
+
+# now for some unoptimized versions of the same.
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
+
+$_ = 'abc123xyz';
+s/(\d+)/$1*2/e;              # yields 'abc246xyz'
+print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
+s/(\d+)/sprintf("%5d",$1)/e; # yields 'abc  246xyz'
+print $_ eq 'abc  246xyz' ? "ok 41\n" : "not ok 41\n";
+s/(\w)/$1 x 2/eg;            # yields 'aabbcc  224466xxyyzz'
+print $_ eq 'aabbcc  224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
+
+$_ = "aaaaa";
+print y/a/b/ == 5 ? "ok 43\n" : "not ok 43\n";
+print y/a/b/ == 0 ? "ok 44\n" : "not ok 44\n";
+print y/b// == 5 ? "ok 45\n" : "not ok 45\n";
+print y/b/c/s == 5 ? "ok 46\n" : "not ok 46\n";
+print y/c// == 1 ? "ok 47\n" : "not ok 47\n";
+print y/c//d == 1 ? "ok 48\n" : "not ok 48\n";
+print $_ eq "" ? "ok 49\n" : "not ok 49\n";
+
+$_ = "Now is the %#*! time for all good men...";
+print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n");
+print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n";
+
+$_ = 'abcdefghijklmnopqrstuvwxyz0123456789';
+tr/a-z/A-Z/;
+
+print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
+
+# same as tr/A-Z/a-z/;
+if ($^O eq 'os390') {	# An EBCDIC variant.
+    y[\301-\351][\201-\251];
+} else {		# Ye Olde ASCII.  Or something like it.
+    y[\101-\132][\141-\172];
+}
+
+print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
+
+if (ord("+") == ord(",") - 1 && ord(",") == ord("-") - 1 &&
+    ord("a") == ord("b") - 1 && ord("b") == ord("c") - 1) {
+  $_ = '+,-';
+  tr/+--/a-c/;
+  print "not " unless $_ eq 'abc';
+}
+print "ok 54\n";
+
+$_ = '+,-';
+tr/+\--/a\/c/;
+print $_ eq 'a,/' ? "ok 55\n" : "not ok 55\n";
+
+$_ = '+,-';
+tr/-+,/ab\-/;
+print $_ eq 'b-a' ? "ok 56\n" : "not ok 56\n";
+
+
+# test recursive substitutions
+# code based on the recursive expansion of makefile variables
+
+my %MK = (
+    AAAAA => '$(B)', B=>'$(C)', C => 'D',			# long->short
+    E     => '$(F)', F=>'p $(G) q', G => 'HHHHH',	# short->long
+    DIR => '$(UNDEFINEDNAME)/xxx',
+);
+sub var { 
+    my($var,$level) = @_;
+    return "\$($var)" unless exists $MK{$var};
+    return exp_vars($MK{$var}, $level+1); # can recurse
+}
+sub exp_vars { 
+    my($str,$level) = @_;
+    $str =~ s/\$\((\w+)\)/var($1, $level+1)/ge; # can recurse
+    #warn "exp_vars $level = '$str'\n";
+    $str;
+}
+
+print exp_vars('$(AAAAA)',0)           eq 'D'
+	? "ok 57\n" : "not ok 57\n";
+print exp_vars('$(E)',0)               eq 'p HHHHH q'
+	? "ok 58\n" : "not ok 58\n";
+print exp_vars('$(DIR)',0)             eq '$(UNDEFINEDNAME)/xxx'
+	? "ok 59\n" : "not ok 59\n";
+print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar'
+	? "ok 60\n" : "not ok 60\n";
+
+# a match nested in the RHS of a substitution:
+
+$_ = "abcd";
+s/(..)/$x = $1, m#.#/eg;
+print $x eq "cd" ? "ok 61\n" : "not ok 61\n";
+
+# Subst and lookbehind
+
+$_="ccccc";
+s/(?<!x)c/x/g;
+print $_ eq "xxxxx" ? "ok 62\n" : "not ok 62 # `$_' ne `xxxxx'\n";
+
+$_="ccccc";
+s/(?<!x)(c)/x/g;
+print $_ eq "xxxxx" ? "ok 63\n" : "not ok 63 # `$_' ne `xxxxx'\n";
+
+$_="foobbarfoobbar";
+s/(?<!r)foobbar/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 64\n" : "not ok 64 # `$_' ne `foobarfoobbar'\n";
+
+$_="foobbarfoobbar";
+s/(?<!ar)(foobbar)/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 65\n" : "not ok 65 # `$_' ne `foobarfoobbar'\n";
+
+$_="foobbarfoobbar";
+s/(?<!ar)foobbar/foobar/g;
+print $_ eq "foobarfoobbar" ? "ok 66\n" : "not ok 66 # `$_' ne `foobarfoobbar'\n";
+
+# check parsing of split subst with comment
+eval 's{foo} # this is a comment, not a delimiter
+       {bar};';
+print @? ? "not ok 67\n" : "ok 67\n";
+
+# check if squashing works at the end of string
+$_="baacbaa";
+tr/a/b/s;
+print $_ eq "bbcbb" ? "ok 68\n" : "not ok 68 # `$_' ne `bbcbb'\n";
+
+# XXX TODO: Most tests above don't test return values of the ops. They should.
+$_ = "ab";
+print (s/a/b/ == 1 ? "ok 69\n" : "not ok 69\n");
+
+$_ = <<'EOL';
+     $url = new URI::URL "http://www/";   die if $url eq "xXx";
+EOL
+$^R = 'junk';
+
+$foo = ' $@%#lowercase $@%# lowercase UPPERCASE$@%#UPPERCASE' .
+  ' $@%#lowercase$@%#lowercase$@%# lowercase lowercase $@%#lowercase' .
+  ' lowercase $@%#MiXeD$@%# ';
+
+s{  \d+          \b [,.;]? (?{ 'digits' })
+   |
+    [a-z]+       \b [,.;]? (?{ 'lowercase' })
+   |
+    [A-Z]+       \b [,.;]? (?{ 'UPPERCASE' })
+   |
+    [A-Z] [a-z]+ \b [,.;]? (?{ 'Capitalized' })
+   |
+    [A-Za-z]+    \b [,.;]? (?{ 'MiXeD' })
+   |
+    [A-Za-z0-9]+ \b [,.;]? (?{ 'alphanumeric' })
+   |
+    \s+                    (?{ ' ' })
+   |
+    [^A-Za-z0-9\s]+          (?{ '$@%#' })
+}{$^R}xg;
+print ($_ eq $foo ? "ok 70\n" : "not ok 70\n#'$_'\n#'$foo'\n");
+
+$_ = 'x' x 20; 
+s/\d*|x/<$&>/g; 
+$foo = '<>' . ('<x><>' x 20) ;
+print ($_ eq $foo ? "ok 71\n" : "not ok 71\n#'$_'\n#'$foo'\n");
diff --git a/contrib/perl5/t/op/substr.t b/contrib/perl5/t/op/substr.t
new file mode 100755
index 0000000..87efcb4
--- /dev/null
+++ b/contrib/perl5/t/op/substr.t
@@ -0,0 +1,211 @@
+#!./perl
+
+print "1..106\n";
+
+#P = start of string  Q = start of substr  R = end of substr  S = end of string
+
+$a = 'abcdefxyz';
+BEGIN { $^W = 1 };
+
+$SIG{__WARN__} = sub {
+     if ($_[0] =~ /^substr outside of string/) {
+          $w++;
+     } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
+          $w += 2;
+     } elsif ($_[0] =~ /^Use of uninitialized value/) {
+          $w += 3;
+     } else {
+          warn $_[0];
+     }
+};
+
+sub fail { !defined(shift) && $w-- };
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");   # P=Q R S
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");   # P Q R S
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 4\n" : "not ok 4\n");  # P R Q S
+print (substr($a,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n");  # P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");    # P Q R S
+
+$[ = 1;
+
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");   # P=Q R S
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");   # P Q R S
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n"); # P Q S R
+print (fail(substr($a,999,999)) ? "ok 10\n" : "not ok 10\n");# P R Q S
+print (substr($a,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n");# P=Q R S
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");  # P Q R S
+
+$[ = 0;
+
+substr($a,3,3) = 'XYZ';
+print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+substr($a,0,2) = '';
+print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+substr($a,0,0) = 'ab';
+print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+substr($a,0,0) = '12345678';
+print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+substr($a,-3,3) = 'def';
+print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+substr($a,-3,3) = '<';
+print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+substr($a,-1,1) = '12345678';
+print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,6) eq 'xyz' ? "ok 20\n" : "not ok 20\n");   # P Q R=S
+print (substr($a,-3) eq 'xyz' ? "ok 21\n" : "not ok 21\n");  # P Q R=S
+print (fail(substr($a,999)) ? "ok 22\n" : "not ok 22\n");    # P R=S Q
+print (substr($a,0) eq 'abcdefxyz' ? "ok 23\n" : "not ok 23\n");# P=Q R=S
+print (substr($a,9) eq '' ? "ok 24\n" : "not ok 24\n");      # P Q=R=S
+print (substr($a,-11) eq 'abcdefxyz' ? "ok 25\n" : "not ok 25\n");# Q P R=S
+print (substr($a,-9) eq 'abcdefxyz' ? "ok 26\n" : "not ok 26\n");  # P=Q R=S
+
+$a = '54321';
+
+print (fail(substr($a,-7, 1)) ? "ok 27\n" : "not ok 27\n");  # Q R P S
+print (fail(substr($a,-7,-6)) ? "ok 28\n" : "not ok 28\n");  # Q R P S
+print (substr($a,-5,-7) eq '' ? "ok 29\n" : "not ok 29\n");  # R P=Q S
+print (substr($a, 2,-7) eq '' ? "ok 30\n" : "not ok 30\n");  # R P Q S
+print (substr($a,-3,-7) eq '' ? "ok 31\n" : "not ok 31\n");  # R P Q S
+print (substr($a, 2,-5) eq '' ? "ok 32\n" : "not ok 32\n");  # P=R Q S
+print (substr($a,-3,-5) eq '' ? "ok 33\n" : "not ok 33\n");  # P=R Q S
+print (substr($a, 2,-4) eq '' ? "ok 34\n" : "not ok 34\n");  # P R Q S
+print (substr($a,-3,-4) eq '' ? "ok 35\n" : "not ok 35\n");  # P R Q S
+print (substr($a, 5,-6) eq '' ? "ok 36\n" : "not ok 36\n");  # R P Q=S
+print (substr($a, 5,-5) eq '' ? "ok 37\n" : "not ok 37\n");  # P=R Q S
+print (substr($a, 5,-3) eq '' ? "ok 38\n" : "not ok 38\n");  # P R Q=S
+print (fail(substr($a, 7,-7)) ? "ok 39\n" : "not ok 39\n");  # R P S Q
+print (fail(substr($a, 7,-5)) ? "ok 40\n" : "not ok 40\n");  # P=R S Q
+print (fail(substr($a, 7,-3)) ? "ok 41\n" : "not ok 41\n");  # P R S Q
+print (fail(substr($a, 7, 0)) ? "ok 42\n" : "not ok 42\n");  # P S Q=R
+
+print (substr($a,-7,2) eq '' ? "ok 43\n" : "not ok 43\n");   # Q P=R S
+print (substr($a,-7,4) eq '54' ? "ok 44\n" : "not ok 44\n"); # Q P R S
+print (substr($a,-7,7) eq '54321' ? "ok 45\n" : "not ok 45\n");# Q P R=S
+print (substr($a,-7,9) eq '54321' ? "ok 46\n" : "not ok 46\n");# Q P S R
+print (substr($a,-5,0) eq '' ? "ok 47\n" : "not ok 47\n");   # P=Q=R S
+print (substr($a,-5,3) eq '543' ? "ok 48\n" : "not ok 48\n");# P=Q R S
+print (substr($a,-5,5) eq '54321' ? "ok 49\n" : "not ok 49\n");# P=Q R=S
+print (substr($a,-5,7) eq '54321' ? "ok 50\n" : "not ok 50\n");# P=Q S R
+print (substr($a,-3,0) eq '' ? "ok 51\n" : "not ok 51\n");   # P Q=R S
+print (substr($a,-3,3) eq '321' ? "ok 52\n" : "not ok 52\n");# P Q R=S
+print (substr($a,-2,3) eq '21' ? "ok 53\n" : "not ok 53\n"); # P Q S R
+print (substr($a,0,-5) eq '' ? "ok 54\n" : "not ok 54\n");   # P=Q=R S
+print (substr($a,2,-3) eq '' ? "ok 55\n" : "not ok 55\n");   # P Q=R S
+print (substr($a,0,0) eq '' ? "ok 56\n" : "not ok 56\n");    # P=Q=R S
+print (substr($a,0,5) eq '54321' ? "ok 57\n" : "not ok 57\n");# P=Q R=S
+print (substr($a,0,7) eq '54321' ? "ok 58\n" : "not ok 58\n");# P=Q S R
+print (substr($a,2,0) eq '' ? "ok 59\n" : "not ok 59\n");    # P Q=R S
+print (substr($a,2,3) eq '321' ? "ok 60\n" : "not ok 60\n"); # P Q R=S
+print (substr($a,5,0) eq '' ? "ok 61\n" : "not ok 61\n");    # P Q=R=S
+print (substr($a,5,2) eq '' ? "ok 62\n" : "not ok 62\n");    # P Q=S R
+print (substr($a,-7,-5) eq '' ? "ok 63\n" : "not ok 63\n");  # Q P=R S
+print (substr($a,-7,-2) eq '543' ? "ok 64\n" : "not ok 64\n");# Q P R S
+print (substr($a,-5,-5) eq '' ? "ok 65\n" : "not ok 65\n");  # P=Q=R S
+print (substr($a,-5,-2) eq '543' ? "ok 66\n" : "not ok 66\n");# P=Q R S
+print (substr($a,-3,-3) eq '' ? "ok 67\n" : "not ok 67\n");  # P Q=R S
+print (substr($a,-3,-1) eq '32' ? "ok 68\n" : "not ok 68\n");# P Q R S
+
+$a = '';
+
+print (substr($a,-2,2) eq '' ? "ok 69\n" : "not ok 69\n");   # Q P=R=S
+print (substr($a,0,0) eq '' ? "ok 70\n" : "not ok 70\n");    # P=Q=R=S
+print (substr($a,0,1) eq '' ? "ok 71\n" : "not ok 71\n");    # P=Q=S R
+print (substr($a,-2,3) eq '' ? "ok 72\n" : "not ok 72\n");   # Q P=S R
+print (substr($a,-2) eq '' ? "ok 73\n" : "not ok 73\n");     # Q P=R=S
+print (substr($a,0) eq '' ? "ok 74\n" : "not ok 74\n");      # P=Q=R=S
+
+
+print (substr($a,0,-1) eq '' ? "ok 75\n" : "not ok 75\n");   # R P=Q=S
+print (fail(substr($a,-2,0)) ? "ok 76\n" : "not ok 76\n");   # Q=R P=S
+print (fail(substr($a,-2,1)) ? "ok 77\n" : "not ok 77\n");   # Q R P=S
+print (fail(substr($a,-2,-1)) ? "ok 78\n" : "not ok 78\n");  # Q R P=S
+print (fail(substr($a,-2,-2)) ? "ok 79\n" : "not ok 79\n");  # Q=R P=S
+print (fail(substr($a,1,-2)) ? "ok 80\n" : "not ok 81\n");   # R P=S Q
+print (fail(substr($a,1,1)) ? "ok 81\n" : "not ok 81\n");    # P=S Q R
+print (fail(substr($a,1,0)) ? "ok 82\n" : "not ok 82\n");    # P=S Q=R
+print (fail(substr($a,1)) ? "ok 83\n" : "not ok 83\n");      # P=R=S Q
+
+
+my $a = 'zxcvbnm';
+substr($a,2,0) = '';
+print $a eq 'zxcvbnm' ? "ok 84\n" : "not ok 84\n";
+substr($a,7,0) = '';
+print $a eq 'zxcvbnm' ? "ok 85\n" : "not ok 85\n";
+substr($a,5,0) = '';
+print $a eq 'zxcvbnm' ? "ok 86\n" : "not ok 86\n";
+substr($a,0,2) = 'pq';
+print $a eq 'pqcvbnm' ? "ok 87\n" : "not ok 87\n";
+substr($a,2,0) = 'r';
+print $a eq 'pqrcvbnm' ? "ok 88\n" : "not ok 88\n";
+substr($a,8,0) = 'asd';
+print $a eq 'pqrcvbnmasd' ? "ok 89\n" : "not ok 89\n";
+substr($a,0,2) = 'iop';
+print $a eq 'ioprcvbnmasd' ? "ok 90\n" : "not ok 90\n";
+substr($a,0,5) = 'fgh';
+print $a eq 'fghvbnmasd' ? "ok 91\n" : "not ok 91\n";
+substr($a,3,5) = 'jkl';
+print $a eq 'fghjklsd' ? "ok 92\n" : "not ok 92\n";
+substr($a,3,2) = '1234';
+print $a eq 'fgh1234lsd' ? "ok 93\n" : "not ok 93\n";
+
+
+# with lexicals (and in re-entered scopes)
+for (0,1) {
+  my $txt;
+  unless ($_) {
+    $txt = "Foo";
+    substr($txt, -1) = "X";
+    print $txt eq "FoX" ? "ok 94\n" : "not ok 94\n";
+  }
+  else {
+    local $^W = 0;    # because of (spurious?) "uninitialised value"
+    substr($txt, 0, 1) = "X";
+    print $txt eq "X" ? "ok 95\n" : "not ok 95\n";
+  }
+}
+
+# coercion of references
+{
+  my $s = [];
+  substr($s, 0, 1) = 'Foo';
+  print substr($s,0,7) eq "FooRRAY" && !($w-=2) ? "ok 96\n" : "not ok 96\n";
+}
+
+# check no spurious warnings
+print $w ? "not ok 97\n" : "ok 97\n";
+
+# check new 4 arg replacement syntax
+$a = "abcxyz";
+$w = 0;
+print "not " unless substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
+print "ok 98\n";
+print "not " unless substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
+print "ok 99\n";
+print "not " unless substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
+print "ok 100\n";
+
+print "not " unless substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
+                 && $w == 3;
+print "ok 101\n";
+$w = 0;
+
+print "not " unless substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
+print "ok 102\n";
+print "not " unless fail(substr($a, -99, 0, ""));
+print "ok 103\n";
+print "not " unless fail(substr($a, 99, 3, ""));
+print "ok 104\n";
+
+substr($a, 0, length($a), "foo");
+print "not " unless $a eq "foo" && !$w;
+print "ok 105\n";
+
+# using 4 arg substr as lvalue is a compile time error
+eval 'substr($a,0,0,"") = "abc"';
+print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
+print "ok 106\n";
diff --git a/contrib/perl5/t/op/sysio.t b/contrib/perl5/t/op/sysio.t
new file mode 100755
index 0000000..826cf38
--- /dev/null
+++ b/contrib/perl5/t/op/sysio.t
@@ -0,0 +1,194 @@
+#!./perl
+
+print "1..36\n";
+
+chdir('op') || die "sysio.t: cannot look for myself: $!";
+
+open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
+
+$reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos');
+
+$x = 'abc';
+
+# should not be able to do negative lengths
+eval { sysread(I, $x, -1) };
+print 'not ' unless ($@ =~ /^Negative length /);
+print "ok 1\n";
+
+# $x should be intact
+print 'not ' unless ($x eq 'abc');
+print "ok 2\n";
+
+# should not be able to read before the buffer
+eval { sysread(I, $x, 1, -4) };
+print 'not ' unless ($x eq 'abc');
+print "ok 3\n";
+
+# $x should be intact
+print 'not ' unless ($x eq 'abc');
+print "ok 4\n";
+
+$a ='0123456789';
+
+# default offset 0
+print 'not ' unless(sysread(I, $a, 3) == 3);
+print "ok 5\n";
+
+# $a should be as follows
+print 'not ' unless ($a eq '#!.');
+print "ok 6\n";
+
+# reading past the buffer should zero pad
+print 'not ' unless(sysread(I, $a, 2, 5) == 2);
+print "ok 7\n";
+
+# the zero pad should be seen now
+print 'not ' unless ($a eq "#!.\0\0/p");
+print "ok 8\n";
+
+# try changing the last two characters of $a
+print 'not ' unless(sysread(I, $a, 3, -2) == 3);
+print "ok 9\n";
+
+# the last two characters of $a should have changed (into three)
+print 'not ' unless ($a eq "#!.\0\0erl");
+print "ok 10\n";
+
+$outfile = 'sysio.out';
+
+open(O, ">$outfile") || die "sysio.t: cannot write $outfile: $!";
+
+select(O); $|=1; select(STDOUT);
+
+# cannot write negative lengths
+eval { syswrite(O, $x, -1) };
+print 'not ' unless ($@ =~ /^Negative length /);
+print "ok 11\n";
+
+# $x still intact
+print 'not ' unless ($x eq 'abc');
+print "ok 12\n";
+
+# $outfile still intact
+print 'not ' if (-s $outfile);
+print "ok 13\n";
+
+# should not be able to write from after the buffer
+eval { syswrite(O, $x, 1, 3) };
+print 'not ' unless ($@ =~ /^Offset outside string /);
+print "ok 14\n";
+
+# $x still intact
+print 'not ' unless ($x eq 'abc');
+print "ok 15\n";
+
+# $outfile still intact
+if ($reopen) {  # must close file to update EOF marker for stat
+  close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' if (-s $outfile);
+print "ok 16\n";
+
+# should not be able to write from before the buffer
+
+eval { syswrite(O, $x, 1, -4) };
+print 'not ' unless ($@ =~ /^Offset outside string /);
+print "ok 17\n";
+
+# $x still intact
+print 'not ' unless ($x eq 'abc');
+print "ok 18\n";
+
+# $outfile still intact
+if ($reopen) {  # must close file to update EOF marker for stat
+  close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' if (-s $outfile);
+print "ok 19\n";
+
+# default offset 0
+print 'not ' unless (syswrite(O, $a, 2) == 2);
+print "ok 20\n";
+
+# $a still intact
+print 'not ' unless ($a eq "#!.\0\0erl");
+print "ok 21\n";
+
+# $outfile should have grown now
+if ($reopen) {  # must close file to update EOF marker for stat
+  close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' unless (-s $outfile == 2);
+print "ok 22\n";
+
+# with offset
+print 'not ' unless (syswrite(O, $a, 2, 5) == 2);
+print "ok 23\n";
+
+# $a still intact
+print 'not ' unless ($a eq "#!.\0\0erl");
+print "ok 24\n";
+
+# $outfile should have grown now
+if ($reopen) {  # must close file to update EOF marker for stat
+  close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' unless (-s $outfile == 4);
+print "ok 25\n";
+
+# with negative offset and a bit too much length
+print 'not ' unless (syswrite(O, $a, 5, -3) == 3);
+print "ok 26\n";
+
+# $a still intact
+print 'not ' unless ($a eq "#!.\0\0erl");
+print "ok 27\n";
+
+# $outfile should have grown now
+if ($reopen) {  # must close file to update EOF marker for stat
+  close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+}
+print 'not ' unless (-s $outfile == 7);
+print "ok 28\n";
+
+close(O);
+
+open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
+
+$b = 'xyz';
+
+# reading too much only return as much as available
+print 'not ' unless (sysread(I, $b, 100) == 7);
+print "ok 29\n";
+# this we should have
+print 'not ' unless ($b eq '#!ererl');
+print "ok 30\n";
+
+# test sysseek
+
+print 'not ' unless sysseek(I, 2, 0) == 2;
+print "ok 31\n";
+sysread(I, $b, 3);
+print 'not ' unless $b eq 'ere';
+print "ok 32\n";
+
+print 'not ' unless sysseek(I, -2, 1) == 3;
+print "ok 33\n";
+sysread(I, $b, 4);
+print 'not ' unless $b eq 'rerl';
+print "ok 34\n";
+
+print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
+print "ok 35\n";
+print 'not ' if defined sysseek(I, -1, 1);
+print "ok 36\n";
+
+close(I);
+
+unlink $outfile;
+
+chdir('..'); 
+
+1;
+
+# eof
diff --git a/contrib/perl5/t/op/taint.t b/contrib/perl5/t/op/taint.t
new file mode 100755
index 0000000..d2cae8e
--- /dev/null
+++ b/contrib/perl5/t/op/taint.t
@@ -0,0 +1,596 @@
+#!./perl -T
+#
+# Taint tests by Tom Phoenix <rootbeer@teleport.com>.
+#
+# I don't claim to know all about tainting. If anyone sees
+# tests that I've missed here, please add them. But this is
+# better than having no tests at all, right?
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+use strict;
+use Config;
+
+# We do not want the whole taint.t to fail
+# just because Errno possibly failing.
+eval { require Errno; import Errno };
+
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_Dos = $^O eq 'dos';
+my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' :
+                  $Is_MSWin32 ? '.\perl' : './perl';
+my @MoreEnv = qw/IFS CDPATH ENV BASH_ENV/;
+
+if ($Is_VMS) {
+    my (%old, $x);
+    for $x ('DCL$PATH', @MoreEnv) {
+	($old{$x}) = $ENV{$x} =~ /^(.*)$/ if exists $ENV{$x};
+    }
+    eval <<EndOfCleanup;
+	END {
+	    \$ENV{PATH} = '';
+	    warn "# Note: logical name 'PATH' may have been deleted\n";
+	    @ENV{keys %old} = values %old;
+	}
+EndOfCleanup
+}
+
+# Sources of taint:
+#   The empty tainted value, for tainting strings
+my $TAINT = substr($^X, 0, 0);
+#   A tainted zero, useful for tainting numbers
+my $TAINT0 = 0 + $TAINT;
+
+# This taints each argument passed. All must be lvalues.
+# Side effect: It also stringifies them. :-(
+sub taint_these (@) {
+    for (@_) { $_ .= $TAINT }
+}
+
+# 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;
+}
+
+sub test ($$;$) {
+    my($serial, $boolean, $diag) = @_;
+    if ($boolean) {
+	print "ok $serial\n";
+    } else {
+	print "not ok $serial\n";
+	for (split m/^/m, $diag) {
+	    print "# $_";
+	}
+	print "\n" unless
+	    $diag eq ''
+	    or substr($diag, -1) eq "\n";
+    }
+}
+
+# We need an external program to call.
+my $ECHO = ($Is_MSWin32 ? ".\\echo$$" : "./echo$$");
+END { unlink $ECHO }
+open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
+print PROG 'print "@ARGV\n"', "\n";
+close PROG;
+my $echo = "$Invoke_Perl $ECHO";
+
+print "1..149\n";
+
+# First, let's make sure that Perl is checking the dangerous
+# environment variables. Maybe they aren't set yet, so we'll
+# taint them ourselves.
+{
+    $ENV{'DCL$PATH'} = '' if $Is_VMS;
+
+    $ENV{PATH} = '';
+    delete @ENV{@MoreEnv};
+    $ENV{TERM} = 'dumb';
+
+    test 1, eval { `$echo 1` } eq "1\n";
+
+    if ($Is_MSWin32 || $Is_VMS || $Is_Dos) {
+	print "# Environment tainting tests skipped\n";
+	for (2..5) { print "ok $_\n" }
+    }
+    else {
+	my @vars = ('PATH', @MoreEnv);
+	while (my $v = $vars[0]) {
+	    local $ENV{$v} = $TAINT;
+	    last if eval { `$echo 1` };
+	    last unless $@ =~ /^Insecure \$ENV{$v}/;
+	    shift @vars;
+	}
+	test 2, !@vars, "\$$vars[0]";
+
+	# tainted $TERM is unsafe only if it contains metachars
+	local $ENV{TERM};
+	$ENV{TERM} = 'e=mc2';
+	test 3, eval { `$echo 1` } eq "1\n";
+	$ENV{TERM} = 'e=mc2' . $TAINT;
+	test 4, eval { `$echo 1` } eq '';
+	test 5, $@ =~ /^Insecure \$ENV{TERM}/, $@;
+    }
+
+    my $tmp;
+    if ($^O eq 'os2' || $^O eq 'amigaos' || $Is_MSWin32 || $Is_Dos) {
+	print "# all directories are writeable\n";
+    }
+    else {
+	$tmp = (grep { defined and -d and (stat _)[2] & 2 }
+		     qw(/tmp /var/tmp /usr/tmp /sys$scratch),
+		     @ENV{qw(TMP TEMP)})[0]
+	    or print "# can't find world-writeable directory to test PATH\n";
+    }
+
+    if ($tmp) {
+	local $ENV{PATH} = $tmp;
+	test 6, eval { `$echo 1` } eq '';
+	test 7, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@;
+    }
+    else {
+	for (6..7) { print "ok $_ # Skipped: all directories are writeable\n" }
+    }
+
+    if ($Is_VMS) {
+	$ENV{'DCL$PATH'} = $TAINT;
+	test 8,  eval { `$echo 1` } eq '';
+	test 9, $@ =~ /^Insecure \$ENV{DCL\$PATH}/, $@;
+	if ($tmp) {
+	    $ENV{'DCL$PATH'} = $tmp;
+	    test 10, eval { `$echo 1` } eq '';
+	    test 11, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@;
+	}
+	else {
+	    for (10..11) { print "ok $_ # Skipped: can't find world-writeable directory to test DCL\$PATH\n" }
+	}
+	$ENV{'DCL$PATH'} = '';
+    }
+    else {
+	for (8..11) { print "ok $_ # Skipped: This is not VMS\n"; }
+    }
+}
+
+# Let's see that we can taint and untaint as needed.
+{
+    my $foo = $TAINT;
+    test 12, tainted $foo;
+
+    # That was a sanity check. If it failed, stop the insanity!
+    die "Taint checks don't seem to be enabled" unless tainted $foo;
+
+    $foo = "foo";
+    test 13, not tainted $foo;
+
+    taint_these($foo);
+    test 14, tainted $foo;
+
+    my @list = 1..10;
+    test 15, not any_tainted @list;
+    taint_these @list[1,3,5,7,9];
+    test 16, any_tainted @list;
+    test 17, all_tainted @list[1,3,5,7,9];
+    test 18, not any_tainted @list[0,2,4,6,8];
+
+    ($foo) = $foo =~ /(.+)/;
+    test 19, not tainted $foo;
+
+    $foo = $1 if ('bar' . $TAINT) =~ /(.+)/;
+    test 20, not tainted $foo;
+    test 21, $foo eq 'bar';
+
+    {
+      use re 'taint';
+
+      ($foo) = ('bar' . $TAINT) =~ /(.+)/;
+      test 22, tainted $foo;
+      test 23, $foo eq 'bar';
+
+      $foo = $1 if ('bar' . $TAINT) =~ /(.+)/;
+      test 24, tainted $foo;
+      test 25, $foo eq 'bar';
+    }
+
+    $foo = $1 if 'bar' =~ /(.+)$TAINT/;
+    test 26, tainted $foo;
+    test 27, $foo eq 'bar';
+
+    my $pi = 4 * atan2(1,1) + $TAINT0;
+    test 28, tainted $pi;
+
+    ($pi) = $pi =~ /(\d+\.\d+)/;
+    test 29, not tainted $pi;
+    test 30, sprintf("%.5f", $pi) eq '3.14159';
+}
+
+# How about command-line arguments? The problem is that we don't
+# always get some, so we'll run another process with some.
+{
+    my $arg = "./arg$$";
+    open PROG, "> $arg" or die "Can't create $arg: $!";
+    print PROG q{
+	eval { join('', @ARGV), kill 0 };
+	exit 0 if $@ =~ /^Insecure dependency/;
+	print "# Oops: \$@ was [$@]\n";
+	exit 1;
+    };
+    close PROG;
+    print `$Invoke_Perl "-T" $arg and some suspect arguments`;
+    test 31, !$?, "Exited with status $?";
+    unlink $arg;
+}
+
+# Reading from a file should be tainted
+{
+    my $file = './TEST';
+    test 32, open(FILE, $file), "Couldn't open '$file': $!";
+
+    my $block;
+    sysread(FILE, $block, 100);
+    my $line = <FILE>;
+    close FILE;
+    test 33, tainted $block;
+    test 34, tainted $line;
+}
+
+# Globs should be forbidden, except under VMS,
+#   which doesn't spawn an external program.
+if ($Is_VMS) {
+    for (35..36) { print "ok $_\n"; }
+}
+else {
+    my @globs = eval { <*> };
+    test 35, @globs == 0 && $@ =~ /^Insecure dependency/;
+
+    @globs = eval { glob '*' };
+    test 36, @globs == 0 && $@ =~ /^Insecure dependency/;
+}
+
+# Output of commands should be tainted
+{
+    my $foo = `$echo abc`;
+    test 37, tainted $foo;
+}
+
+# Certain system variables should be tainted
+{
+    test 38, all_tainted $^X, $0;
+}
+
+# Results of matching should all be untainted
+{
+    my $foo = "abcdefghi" . $TAINT;
+    test 39, tainted $foo;
+
+    $foo =~ /def/;
+    test 40, not any_tainted $`, $&, $';
+
+    $foo =~ /(...)(...)(...)/;
+    test 41, not any_tainted $1, $2, $3, $+;
+
+    my @bar = $foo =~ /(...)(...)(...)/;
+    test 42, not any_tainted @bar;
+
+    test 43, tainted $foo;	# $foo should still be tainted!
+    test 44, $foo eq "abcdefghi";
+}
+
+# Operations which affect files can't use tainted data.
+{
+    test 45, eval { chmod 0, $TAINT } eq '', 'chmod';
+    test 46, $@ =~ /^Insecure dependency/, $@;
+
+    # There is no feature test in $Config{} for truncate,
+    #   so we allow for the possibility that it's missing.
+    test 47, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
+    test 48, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
+
+    test 49, eval { rename '', $TAINT } eq '', 'rename';
+    test 50, $@ =~ /^Insecure dependency/, $@;
+
+    test 51, eval { unlink $TAINT } eq '', 'unlink';
+    test 52, $@ =~ /^Insecure dependency/, $@;
+
+    test 53, eval { utime $TAINT } eq '', 'utime';
+    test 54, $@ =~ /^Insecure dependency/, $@;
+
+    if ($Config{d_chown}) {
+	test 55, eval { chown -1, -1, $TAINT } eq '', 'chown';
+	test 56, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (55..56) { print "ok $_ # Skipped: chown() is not available\n" }
+    }
+
+    if ($Config{d_link}) {
+	test 57, eval { link $TAINT, '' } eq '', 'link';
+	test 58, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (57..58) { print "ok $_ # Skipped: link() is not available\n" }
+    }
+
+    if ($Config{d_symlink}) {
+	test 59, eval { symlink $TAINT, '' } eq '', 'symlink';
+	test 60, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (59..60) { print "ok $_ # Skipped: symlink() is not available\n" }
+    }
+}
+
+# Operations which affect directories can't use tainted data.
+{
+    test 61, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
+    test 62, $@ =~ /^Insecure dependency/, $@;
+
+    test 63, eval { rmdir $TAINT } eq '', 'rmdir';
+    test 64, $@ =~ /^Insecure dependency/, $@;
+
+    test 65, eval { chdir $TAINT } eq '', 'chdir';
+    test 66, $@ =~ /^Insecure dependency/, $@;
+
+    if ($Config{d_chroot}) {
+	test 67, eval { chroot $TAINT } eq '', 'chroot';
+	test 68, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (67..68) { print "ok $_ # Skipped: chroot() is not available\n" }
+    }
+}
+
+# Some operations using files can't use tainted data.
+{
+    my $foo = "imaginary library" . $TAINT;
+    test 69, eval { require $foo } eq '', 'require';
+    test 70, $@ =~ /^Insecure dependency/, $@;
+
+    my $filename = "./taintB$$";	# NB: $filename isn't tainted!
+    END { unlink $filename if defined $filename }
+    $foo = $filename . $TAINT;
+    unlink $filename;	# in any case
+
+    test 71, eval { open FOO, $foo } eq '', 'open for read';
+    test 72, $@ eq '', $@;		# NB: This should be allowed
+
+    # Try first new style but allow also old style.
+    test 73, $!{ENOENT} || $! == 2 || ($Is_Dos && $! == 22); # File not found
+
+    test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
+    test 75, $@ =~ /^Insecure dependency/, $@;
+}
+
+# Commands to the system can't use tainted data
+{
+    my $foo = $TAINT;
+
+    if ($^O eq 'amigaos') {
+	for (76..79) { print "ok $_ # Skipped: open('|') is not available\n" }
+    }
+    else {
+	test 76, eval { open FOO, "| $foo" } eq '', 'popen to';
+	test 77, $@ =~ /^Insecure dependency/, $@;
+
+	test 78, eval { open FOO, "$foo |" } eq '', 'popen from';
+	test 79, $@ =~ /^Insecure dependency/, $@;
+    }
+
+    test 80, eval { exec $TAINT } eq '', 'exec';
+    test 81, $@ =~ /^Insecure dependency/, $@;
+
+    test 82, eval { system $TAINT } eq '', 'system';
+    test 83, $@ =~ /^Insecure dependency/, $@;
+
+    $foo = "*";
+    taint_these $foo;
+
+    test 84, eval { `$echo 1$foo` } eq '', 'backticks';
+    test 85, $@ =~ /^Insecure dependency/, $@;
+
+    if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe
+	test 86, join('', eval { glob $foo } ) ne '', 'globbing';
+	test 87, $@ eq '', $@;
+    }
+    else {
+	for (86..87) { print "ok $_ # Skipped: this is not VMS\n"; }
+    }
+}
+
+# Operations which affect processes can't use tainted data.
+{
+    test 88, eval { kill 0, $TAINT } eq '', 'kill';
+    test 89, $@ =~ /^Insecure dependency/, $@;
+
+    if ($Config{d_setpgrp}) {
+	test 90, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
+	test 91, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (90..91) { print "ok $_ # Skipped: setpgrp() is not available\n" }
+    }
+
+    if ($Config{d_setprior}) {
+	test 92, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
+	test 93, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (92..93) { print "ok $_ # Skipped: setpriority() is not available\n" }
+    }
+}
+
+# Some miscellaneous operations can't use tainted data.
+{
+    if ($Config{d_syscall}) {
+	test 94, eval { syscall $TAINT } eq '', 'syscall';
+	test 95, $@ =~ /^Insecure dependency/, $@;
+    }
+    else {
+	for (94..95) { print "ok $_ # Skipped: syscall() is not available\n" }
+    }
+
+    {
+	my $foo = "x" x 979;
+	taint_these $foo;
+	local *FOO;
+	my $temp = "./taintC$$";
+	END { unlink $temp }
+	test 96, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
+
+	test 97, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
+	test 98, $@ =~ /^Insecure dependency/, $@;
+
+	if ($Config{d_fcntl}) {
+	    test 99, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
+	    test 100, $@ =~ /^Insecure dependency/, $@;
+	}
+	else {
+	    for (99..100) { print "ok $_ # Skipped: fcntl() is not available\n" }
+	}
+
+	close FOO;
+    }
+}
+
+# Some tests involving references
+{
+    my $foo = 'abc' . $TAINT;
+    my $fooref = \$foo;
+    test 101, not tainted $fooref;
+    test 102, tainted $$fooref;
+    test 103, tainted $foo;
+}
+
+# Some tests involving assignment
+{
+    my $foo = $TAINT0;
+    my $bar = $foo;
+    test 104, all_tainted $foo, $bar;
+    test 105, tainted($foo = $bar);
+    test 106, tainted($bar = $bar);
+    test 107, tainted($bar += $bar);
+    test 108, tainted($bar -= $bar);
+    test 109, tainted($bar *= $bar);
+    test 110, tainted($bar++);
+    test 111, tainted($bar /= $bar);
+    test 112, tainted($bar += 0);
+    test 113, tainted($bar -= 2);
+    test 114, tainted($bar *= -1);
+    test 115, tainted($bar /= 1);
+    test 116, tainted($bar--);
+    test 117, $bar == 0;
+}
+
+# Test assignment and return of lists
+{
+    my @foo = ("A", "tainted" . $TAINT, "B");
+    test 118, not tainted $foo[0];
+    test 119,     tainted $foo[1];
+    test 120, not tainted $foo[2];
+    my @bar = @foo;
+    test 121, not tainted $bar[0];
+    test 122,     tainted $bar[1];
+    test 123, not tainted $bar[2];
+    my @baz = eval { "A", "tainted" . $TAINT, "B" };
+    test 124, not tainted $baz[0];
+    test 125,     tainted $baz[1];
+    test 126, not tainted $baz[2];
+    my @plugh = eval q[ "A", "tainted" . $TAINT, "B" ];
+    test 127, not tainted $plugh[0];
+    test 128,     tainted $plugh[1];
+    test 129, not tainted $plugh[2];
+    my $nautilus = sub { "A", "tainted" . $TAINT, "B" };
+    test 130, not tainted ((&$nautilus)[0]);
+    test 131,     tainted ((&$nautilus)[1]);
+    test 132, not tainted ((&$nautilus)[2]);
+    my @xyzzy = &$nautilus;
+    test 133, not tainted $xyzzy[0];
+    test 134,     tainted $xyzzy[1];
+    test 135, not tainted $xyzzy[2];
+    my $red_october = sub { return "A", "tainted" . $TAINT, "B" };
+    test 136, not tainted ((&$red_october)[0]);
+    test 137,     tainted ((&$red_october)[1]);
+    test 138, not tainted ((&$red_october)[2]);
+    my @corge = &$red_october;
+    test 139, not tainted $corge[0];
+    test 140,     tainted $corge[1];
+    test 141, not tainted $corge[2];
+}
+
+# Test for system/library calls returning string data of dubious origin.
+{
+    # No reliable %Config check for getpw*
+    if (eval { setpwent(); getpwent(); 1 }) {
+	setpwent();
+	my @getpwent = getpwent();
+	die "getpwent: $!\n" unless (@getpwent);
+	test 142,(    not tainted $getpwent[0]
+	          and not tainted $getpwent[1]
+	          and not tainted $getpwent[2]
+	          and not tainted $getpwent[3]
+	          and not tainted $getpwent[4]
+	          and not tainted $getpwent[5]
+	          and     tainted $getpwent[6] # gecos
+	          and not tainted $getpwent[7]
+		  and not tainted $getpwent[8]);
+	endpwent();
+    } else {
+	for (142) { print "ok $_ # Skipped: getpwent() is not available\n" }
+    }
+
+    if ($Config{d_readdir}) { # pretty hard to imagine not
+	local(*D);
+	opendir(D, "op") or die "opendir: $!\n";
+	my $readdir = readdir(D);
+	test 143, tainted $readdir;
+	closedir(OP);
+    } else {
+	for (143) { print "ok $_ # Skipped: readdir() is not available\n" }
+    }
+
+    if ($Config{d_readlink} && $Config{d_symlink}) {
+	my $symlink = "sl$$";
+	unlink($symlink);
+	symlink("/something/naughty", $symlink) or die "symlink: $!\n";
+	my $readlink = readlink($symlink);
+	test 144, tainted $readlink;
+	unlink($symlink);
+    } else {
+	for (144) { print "ok $_ # Skipped: readlink() or symlink() is not available\n"; }
+    }
+}
+
+# test bitwise ops (regression bug)
+{
+    my $why = "y";
+    my $j = "x" | $why;
+    test 145, not tainted $j;
+    $why = $TAINT."y";
+    $j = "x" | $why;
+    test 146,     tainted $j;
+}
+
+# test target of substitution (regression bug)
+{
+    my $why = $TAINT."y";
+    $why =~ s/y/z/;
+    test 147,     tainted $why;
+
+    my $z = "[z]";
+    $why =~ s/$z/zee/;
+    test 148,     tainted $why;
+
+    $why =~ s/e/'-'.$$/ge;
+    test 149,     tainted $why;
+}
diff --git a/contrib/perl5/t/op/tie.t b/contrib/perl5/t/op/tie.t
new file mode 100755
index 0000000..77e74db
--- /dev/null
+++ b/contrib/perl5/t/op/tie.t
@@ -0,0 +1,155 @@
+#!./perl
+
+# This test harness will (eventually) test the "tie" functionality
+# without the need for a *DBM* implementation.
+
+# Currently it only tests the untie warning 
+
+chdir 't' if -d 't';
+@INC = "../lib";
+$ENV{PERL5LIB} = "../lib";
+
+$|=1;
+
+# catch warnings into fatal errors
+$SIG{__WARN__} = sub { die "WARNING: @_" } ;
+
+undef $/;
+@prgs = split "\n########\n", <DATA>;
+print "1..", scalar @prgs, "\n";
+
+for (@prgs){
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    eval "$prog" ;
+    $status = $?;
+    $results = $@ ;
+    $results =~ s/\n+$//;
+    $expected =~ s/\n+$//;
+    if ( $status or $results and $results !~ /^WARNING: $expected/){
+	print STDERR "STATUS: $status\n";
+	print STDERR "PROG: $prog\n";
+	print STDERR "EXPECTED:\n$expected\n";
+	print STDERR "GOT:\n$results\n";
+	print "not ";
+    }
+    print "ok ", ++$i, "\n";
+}
+
+__END__
+
+# standard behaviour, without any extra references
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+untie %h;
+EXPECT
+########
+
+# standard behaviour, with 1 extra reference
+use Tie::Hash ;
+$a = tie %h, Tie::StdHash;
+untie %h;
+EXPECT
+########
+
+# standard behaviour, with 1 extra reference via tied
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+$a = tied %h;
+untie %h;
+EXPECT
+########
+
+# standard behaviour, with 1 extra reference which is destroyed
+use Tie::Hash ;
+$a = tie %h, Tie::StdHash;
+$a = 0 ;
+untie %h;
+EXPECT
+########
+
+# standard behaviour, with 1 extra reference via tied which is destroyed
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+$a = tied %h;
+$a = 0 ;
+untie %h;
+EXPECT
+########
+
+# strict behaviour, without any extra references
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+untie %h;
+EXPECT
+########
+
+# strict behaviour, with 1 extra references generating an error
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+$a = tie %h, Tie::StdHash;
+untie %h;
+EXPECT
+untie attempted while 1 inner references still exist
+########
+
+# strict behaviour, with 1 extra references via tied generating an error
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+$a = tied %h;
+untie %h;
+EXPECT
+untie attempted while 1 inner references still exist
+########
+
+# strict behaviour, with 1 extra references which are destroyed
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+$a = tie %h, Tie::StdHash;
+$a = 0 ;
+untie %h;
+EXPECT
+########
+
+# strict behaviour, with extra 1 references via tied which are destroyed
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+tie %h, Tie::StdHash;
+$a = tied %h;
+$a = 0 ;
+untie %h;
+EXPECT
+########
+
+# strict error behaviour, with 2 extra references 
+#use warning 'untie';
+local $^W = 1 ;
+use Tie::Hash ;
+$a = tie %h, Tie::StdHash;
+$b = tied %h ;
+untie %h;
+EXPECT
+untie attempted while 2 inner references still exist
+########
+
+# strict behaviour, check scope of strictness.
+#no warning 'untie';
+local $^W = 0 ;
+use Tie::Hash ;
+$A = tie %H, Tie::StdHash;
+$C = $B = tied %H ;
+{
+    #use warning 'untie';
+    local $^W = 1 ;
+    use Tie::Hash ;
+    tie %h, Tie::StdHash;
+    untie %h;
+}
+untie %H;
+EXPECT
diff --git a/contrib/perl5/t/op/tiearray.t b/contrib/perl5/t/op/tiearray.t
new file mode 100755
index 0000000..8e78b2f
--- /dev/null
+++ b/contrib/perl5/t/op/tiearray.t
@@ -0,0 +1,210 @@
+#!./perl
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my %seen;
+
+package Implement;
+
+sub TIEARRAY
+{
+ $seen{'TIEARRAY'}++;
+ my ($class,@val) = @_;
+ return bless \@val,$class;
+}
+
+sub STORESIZE
+{        
+ $seen{'STORESIZE'}++;
+ my ($ob,$sz) = @_; 
+ return $#{$ob} = $sz-1;
+}
+
+sub EXTEND
+{        
+ $seen{'EXTEND'}++;
+ my ($ob,$sz) = @_; 
+ return @$ob = $sz;
+}
+
+sub FETCHSIZE
+{        
+ $seen{'FETCHSIZE'}++;
+ return scalar(@{$_[0]});
+}
+
+sub FETCH
+{
+ $seen{'FETCH'}++;
+ my ($ob,$id) = @_;
+ return $ob->[$id]; 
+}
+
+sub STORE
+{
+ $seen{'STORE'}++;
+ my ($ob,$id,$val) = @_;
+ $ob->[$id] = $val; 
+}                 
+
+sub UNSHIFT
+{
+ $seen{'UNSHIFT'}++;
+ my $ob = shift;
+ unshift(@$ob,@_);
+}                 
+
+sub PUSH
+{
+ $seen{'PUSH'}++;
+ my $ob = shift;;
+ push(@$ob,@_);
+}                 
+
+sub CLEAR
+{
+ $seen{'CLEAR'}++;
+ @{$_[0]} = ();
+}
+
+sub DESTROY
+{
+ $seen{'DESTROY'}++;
+}
+
+sub POP
+{
+ $seen{'POP'}++;
+ my ($ob) = @_;
+ return pop(@$ob);
+}
+
+sub SHIFT
+{
+ $seen{'SHIFT'}++;
+ my ($ob) = @_;
+ return shift(@$ob);
+}
+
+sub SPLICE
+{
+ $seen{'SPLICE'}++;
+ my $ob  = shift;                    
+ my $off = @_ ? shift : 0;
+ my $len = @_ ? shift : @$ob-1;
+ return splice(@$ob,$off,$len,@_);
+}
+
+package main;
+
+print "1..31\n";                   
+my $test = 1;
+
+{my @ary;
+
+{ my $ob = tie @ary,'Implement',3,2,1;
+  print "not " unless $ob;
+  print "ok ", $test++,"\n";
+  print "not " unless tied(@ary) == $ob;
+  print "ok ", $test++,"\n";
+}
+
+
+print "not " unless @ary == 3;
+print "ok ", $test++,"\n";
+
+print "not " unless $#ary == 2;
+print "ok ", $test++,"\n";
+
+print "not " unless join(':',@ary) eq '3:2:1';
+print "ok ", $test++,"\n";         
+
+print "not " unless $seen{'FETCH'} >= 3;
+print "ok ", $test++,"\n";
+
+@ary = (1,2,3);
+
+print "not " unless $seen{'STORE'} >= 3;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:2:3';
+print "ok ", $test++,"\n";         
+
+{my @thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";         
+
+tie @thing,'Implement';
+@thing = @ary;
+print "not " unless join(':',@thing) eq '1:2:3';
+print "ok ", $test++,"\n";
+} 
+
+print "not " unless pop(@ary) == 3;
+print "ok ", $test++,"\n";
+print "not " unless $seen{'POP'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:2';
+print "ok ", $test++,"\n";
+
+push(@ary,4);
+print "not " unless $seen{'PUSH'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:2:4';
+print "ok ", $test++,"\n";
+
+my @x = splice(@ary,1,1,7);
+
+
+print "not " unless $seen{'SPLICE'} == 1;
+print "ok ", $test++,"\n";
+
+print "not " unless @x == 1;
+print "ok ", $test++,"\n";
+print "not " unless $x[0] == 2;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '1:7:4';
+print "ok ", $test++,"\n";             
+
+print "not " unless shift(@ary) == 1;
+print "ok ", $test++,"\n";
+print "not " unless $seen{'SHIFT'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '7:4';
+print "ok ", $test++,"\n";             
+
+my $n = unshift(@ary,5,6);
+print "not " unless $seen{'UNSHIFT'} == 1;
+print "ok ", $test++,"\n";
+print "not " unless $n == 4;
+print "ok ", $test++,"\n";
+print "not " unless join(':',@ary) eq '5:6:7:4';
+print "ok ", $test++,"\n";
+
+@ary = split(/:/,'1:2:3');
+print "not " unless join(':',@ary) eq '1:2:3';
+print "ok ", $test++,"\n";         
+  
+my $t = 0;
+foreach $n (@ary)
+ {
+  print "not " unless $n == ++$t;
+  print "ok ", $test++,"\n";         
+ }
+
+@ary = qw(3 2 1);
+print "not " unless join(':',@ary) eq '3:2:1';
+print "ok ", $test++,"\n";         
+
+untie @ary;   
+
+}
+                           
+print "not " unless $seen{'DESTROY'} == 2;
+print "ok ", $test++,"\n";         
+
+
+
diff --git a/contrib/perl5/t/op/tiehandle.t b/contrib/perl5/t/op/tiehandle.t
new file mode 100755
index 0000000..e3d2472
--- /dev/null
+++ b/contrib/perl5/t/op/tiehandle.t
@@ -0,0 +1,137 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @expect;
+my $data = "";
+my @data = ();
+my $test = 1;
+
+sub ok { print "not " unless shift; print "ok ",$test++,"\n"; }
+
+package Implement;
+
+BEGIN { *ok = \*main::ok }
+
+sub compare {
+    return unless @expect;
+    return ok(0) unless(@_ == @expect);
+
+    my $i;
+    for($i = 0 ; $i < @_ ; $i++) {
+	next if $_[$i] eq $expect[$i];
+	return ok(0);
+    }
+
+    ok(1);
+}
+
+sub TIEHANDLE {
+    compare(TIEHANDLE => @_);
+    my ($class,@val) = @_;
+    return bless \@val,$class;
+}
+
+sub PRINT {
+    compare(PRINT => @_);
+    1;
+}
+
+sub PRINTF {
+    compare(PRINTF => @_);
+    2;
+}
+
+sub READLINE {
+    compare(READLINE => @_);
+    wantarray ? @data : shift @data;
+}
+
+sub GETC {
+    compare(GETC => @_);
+    substr($data,0,1);
+}
+
+sub READ {
+    compare(READ => @_);
+    substr($_[1],$_[3] || 0) = substr($data,0,$_[2]);
+    3;
+}
+
+sub WRITE {
+    compare(WRITE => @_);
+    $data = substr($_[1],$_[3] || 0, $_[2]);
+    4;
+}
+
+sub CLOSE {
+    compare(CLOSE => @_);
+    
+    5;
+}
+
+package main;
+
+use Symbol;
+
+print "1..23\n";
+
+my $fh = gensym;
+
+@expect = (TIEHANDLE => 'Implement');
+my $ob = tie *$fh,'Implement';
+ok(ref($ob) eq 'Implement');
+ok(tied(*$fh) == $ob);
+
+@expect = (PRINT => $ob,"some","text");
+$r = print $fh @expect[2,3];
+ok($r == 1);
+
+@expect = (PRINTF => $ob,"%s","text");
+$r = printf $fh @expect[2,3];
+ok($r == 2);
+
+$text = (@data = ("the line\n"))[0];
+@expect = (READLINE => $ob);
+$ln = <$fh>;
+ok($ln eq $text);
+
+@expect = ();
+@in = @data = qw(a line at a time);
+@line = <$fh>;
+@expect = @in;
+Implement::compare(@line);
+
+@expect = (GETC => $ob);
+$data = "abc";
+$ch = getc $fh;
+ok($ch eq "a");
+
+$buf = "xyz";
+@expect = (READ => $ob, $buf, 3);
+$data = "abc";
+$r = read $fh,$buf,3;
+ok($r == 3);
+ok($buf eq "abc");
+
+
+$buf = "xyzasd";
+@expect = (READ => $ob, $buf, 3,3);
+$data = "abc";
+$r = sysread $fh,$buf,3,3;
+ok($r == 3);
+ok($buf eq "xyzabc");
+
+$buf = "qwerty";
+@expect = (WRITE => $ob, $buf, 4,1);
+$data = "";
+$r = syswrite $fh,$buf,4,1;
+ok($r == 4);
+ok($data eq "wert");
+
+@expect = (CLOSE => $ob);
+$r = close $fh;
+ok($r == 5);
diff --git a/contrib/perl5/t/op/time.t b/contrib/perl5/t/op/time.t
new file mode 100755
index 0000000..1bec442
--- /dev/null
+++ b/contrib/perl5/t/op/time.t
@@ -0,0 +1,47 @@
+#!./perl
+
+# $RCSfile: time.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:32 $
+
+if ($does_gmtime = gmtime(time)) { print "1..5\n" }
+else { print "1..3\n" }
+
+($beguser,$begsys) = times;
+
+$beg = time;
+
+while (($now = time) == $beg) { sleep 1 }
+
+if ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";}
+
+for ($i = 0; $i < 100000; $i++) {
+    ($nowuser, $nowsys) = times;
+    $i = 200000 if $nowuser > $beguser && ( $nowsys > $begsys || 
+                                            (!$nowsys && !$begsys));
+    last if time - $beg > 20;
+}
+
+if ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";}
+
+($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg);
+($xsec,$foo) = localtime($now);
+$localyday = $yday;
+
+if ($sec != $xsec && $mday && $year)
+    {print "ok 3\n";}
+else
+    {print "not ok 3\n";}
+
+exit 0 unless $does_gmtime;
+
+($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
+($xsec,$foo) = localtime($now);
+
+if ($sec != $xsec && $mday && $year)
+    {print "ok 4\n";}
+else
+    {print "not ok 4\n";}
+
+if (index(" :0:1:-1:364:365:-364:-365:",':' . ($localyday - $yday) . ':') > 0)
+    {print "ok 5\n";}
+else
+    {print "not ok 5\n";}
diff --git a/contrib/perl5/t/op/undef.t b/contrib/perl5/t/op/undef.t
new file mode 100755
index 0000000..8ab2ec4
--- /dev/null
+++ b/contrib/perl5/t/op/undef.t
@@ -0,0 +1,56 @@
+#!./perl
+
+# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
+
+print "1..21\n";
+
+print defined($a) ? "not ok 1\n" : "ok 1\n";
+
+$a = 1+1;
+print defined($a) ? "ok 2\n" : "not ok 2\n";
+
+undef $a;
+print defined($a) ? "not ok 3\n" : "ok 3\n";
+
+$a = "hi";
+print defined($a) ? "ok 4\n" : "not ok 4\n";
+
+$a = $b;
+print defined($a) ? "not ok 5\n" : "ok 5\n";
+
+@ary = ("1arg");
+$a = pop(@ary);
+print defined($a) ? "ok 6\n" : "not ok 6\n";
+$a = pop(@ary);
+print defined($a) ? "not ok 7\n" : "ok 7\n";
+
+@ary = ("1arg");
+$a = shift(@ary);
+print defined($a) ? "ok 8\n" : "not ok 8\n";
+$a = shift(@ary);
+print defined($a) ? "not ok 9\n" : "ok 9\n";
+
+$ary{'foo'} = 'hi';
+print defined($ary{'foo'}) ? "ok 10\n" : "not ok 10\n";
+print defined($ary{'bar'}) ? "not ok 11\n" : "ok 11\n";
+undef $ary{'foo'};
+print defined($ary{'foo'}) ? "not ok 12\n" : "ok 12\n";
+
+print defined(@ary) ? "ok 13\n" : "not ok 13\n";
+print defined(%ary) ? "ok 14\n" : "not ok 14\n";
+undef @ary;
+print defined(@ary) ? "not ok 15\n" : "ok 15\n";
+undef %ary;
+print defined(%ary) ? "not ok 16\n" : "ok 16\n";
+@ary = (1);
+print defined @ary ? "ok 17\n" : "not ok 17\n";
+%ary = (1,1);
+print defined %ary ? "ok 18\n" : "not ok 18\n";
+
+sub foo { print "ok 19\n"; }
+
+&foo || print "not ok 19\n";
+
+print defined &foo ? "ok 20\n" : "not ok 20\n";
+undef &foo;
+print defined(&foo) ? "not ok 21\n" : "ok 21\n";
diff --git a/contrib/perl5/t/op/universal.t b/contrib/perl5/t/op/universal.t
new file mode 100755
index 0000000..bde78fd
--- /dev/null
+++ b/contrib/perl5/t/op/universal.t
@@ -0,0 +1,104 @@
+#!./perl
+#
+# check UNIVERSAL
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+print "1..72\n";
+
+$a = {};
+bless $a, "Bob";
+print "not " unless $a->isa("Bob");
+print "ok 1\n";
+
+package Human;
+sub eat {}
+
+package Female;
+@ISA=qw(Human);
+
+package Alice;
+@ISA=qw(Bob Female);
+sub drink {}
+sub new { bless {} }
+
+$Alice::VERSION = 2.718;
+
+package main;
+
+my $i = 2;
+sub test { print "not " unless shift; print "ok $i\n"; $i++; }
+
+$a = new Alice;
+
+test $a->isa("Alice");
+
+test $a->isa("Bob");
+
+test $a->isa("Female");
+
+test $a->isa("Human");
+
+test ! $a->isa("Male");
+
+test $a->can("drink");
+
+test $a->can("eat");
+
+test ! $a->can("sleep");
+
+my $b = 'abc';
+my @refs = qw(SCALAR SCALAR     LVALUE      GLOB ARRAY HASH CODE);
+my @vals = (  \$b,   \3.14, \substr($b,1,1), \*b,  [],  {}, sub {} );
+for ($p=0; $p < @refs; $p++) {
+    for ($q=0; $q < @vals; $q++) {
+        test UNIVERSAL::isa($vals[$p], $refs[$q]) eq ($p==$q or $p+$q==1);
+    };
+};
+
+test ! UNIVERSAL::can(23, "can");
+
+test $a->can("VERSION");
+
+test $a->can("can");
+test ! $a->can("export_tags");	# a method in Exporter
+
+test (eval { $a->VERSION }) == 2.718;
+
+test ! (eval { $a->VERSION(2.719) }) &&
+         $@ =~ /^Alice version 2.719 required--this is only version 2.718 at /;
+
+test (eval { $a->VERSION(2.718) }) && ! $@;
+
+my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
+if ('a' lt 'A') {
+    test $subs eq "can isa VERSION";
+} else {
+    test $subs eq "VERSION can isa";
+}
+
+test $a->isa("UNIVERSAL");
+
+# now use UNIVERSAL.pm and see what changes
+eval "use UNIVERSAL";
+
+test $a->isa("UNIVERSAL");
+
+my $sub2 = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::; 
+# XXX import being here is really a bug
+if ('a' lt 'A') {
+    test $sub2 eq "can import isa VERSION";
+} else {
+    test $sub2 eq "VERSION can import isa";
+}
+
+eval 'sub UNIVERSAL::sleep {}';
+test $a->can("sleep");
+
+test ! UNIVERSAL::can($b, "can");
+
+test ! $a->can("export_tags");	# a method in Exporter
diff --git a/contrib/perl5/t/op/unshift.t b/contrib/perl5/t/op/unshift.t
new file mode 100755
index 0000000..68d3775
--- /dev/null
+++ b/contrib/perl5/t/op/unshift.t
@@ -0,0 +1,14 @@
+#!./perl
+
+# $RCSfile: unshift.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:35 $
+
+print "1..2\n";
+
+@a = (1,2,3);
+$cnt1 = unshift(a,0);
+
+if (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";}
+$cnt2 = unshift(a,3,2,1);
+if (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";}
+
+
diff --git a/contrib/perl5/t/op/vec.t b/contrib/perl5/t/op/vec.t
new file mode 100755
index 0000000..7117144
--- /dev/null
+++ b/contrib/perl5/t/op/vec.t
@@ -0,0 +1,27 @@
+#!./perl
+
+# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $
+
+print "1..15\n";
+
+print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
+print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
+vec($foo,0,1) = 1;
+print length($foo) == 1 ? "ok 3\n" : "not ok 3\n";
+print ord($foo) == 1 ? "ok 4\n" : "not ok 4\n";
+print vec($foo,0,1) == 1 ? "ok 5\n" : "not ok 5\n";
+
+print vec($foo,20,1) == 0 ? "ok 6\n" : "not ok 6\n";
+vec($foo,20,1) = 1;
+print vec($foo,20,1) == 1 ? "ok 7\n" : "not ok 7\n";
+print length($foo) == 3 ? "ok 8\n" : "not ok 8\n";
+print vec($foo,1,8) == 0 ? "ok 9\n" : "not ok 9\n";
+vec($foo,1,8) = 0xf1;
+print vec($foo,1,8) == 0xf1 ? "ok 10\n" : "not ok 10\n";
+print ((ord(substr($foo,1,1)) & 255) == 0xf1 ? "ok 11\n" : "not ok 11\n");
+print vec($foo,2,4) == 1 ? "ok 12\n" : "not ok 12\n";
+print vec($foo,3,4) == 15 ? "ok 13\n" : "not ok 13\n";
+vec($Vec, 0, 32) = 0xbaddacab;
+print $Vec eq "\xba\xdd\xac\xab" ? "ok 14\n" : "not ok 14\n";
+print vec($Vec, 0, 32) == 3135089835 ? "ok 15\n" : "not ok 15\n";
+
diff --git a/contrib/perl5/t/op/wantarray.t b/contrib/perl5/t/op/wantarray.t
new file mode 100755
index 0000000..0a47b6d
--- /dev/null
+++ b/contrib/perl5/t/op/wantarray.t
@@ -0,0 +1,16 @@
+#!./perl
+
+print "1..3\n";
+sub context {
+  my ( $cona, $testnum ) = @_;
+  my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
+  unless ( $cona eq $conb ) {
+	print "# Context $conb should be $cona\nnot ";
+  }
+  print "ok $testnum\n";
+}
+
+context('V',1);
+$a = context('S',2);
+@a = context('A',3);
+1;
diff --git a/contrib/perl5/t/op/write.t b/contrib/perl5/t/op/write.t
new file mode 100755
index 0000000..705fa79
--- /dev/null
+++ b/contrib/perl5/t/op/write.t
@@ -0,0 +1,169 @@
+#!./perl
+
+# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
+
+print "1..5\n";
+
+my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
+
+format OUT =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<<
+$foo
+^<<<<<<<<<
+$foo
+^<<<<<<...
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+{
+    'i' . 's', "time\n", $good, 'to'
+}
+.
+
+open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT);
+close OUT;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of huma...
+now is the time for all good men to come to\n";
+
+if (`$CAT Op_write.tmp` eq $right)
+    { print "ok 1\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 1\n"; }
+
+$fox = 'wolfishness';
+my $fox = 'foxiness';		# Test a lexical variable.
+
+format OUT2 =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+
+open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp";
+
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`$CAT Op_write.tmp` eq $right)
+    { print "ok 2\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 2\n"; }
+
+eval <<'EOFORMAT';
+format OUT2 =
+the brown quick @<<
+$fox
+jumped
+@*
+$multiline
+and
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+EOFORMAT
+
+open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the brown quick fox
+jumped
+forescore
+and
+seven years
+and
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`$CAT Op_write.tmp` eq $right)
+    { print "ok 3\n"; unlink 'Op_write.tmp'; }
+else
+    { print "not ok 3\n"; }
+
+# formline tests
+
+$mustbe = <<EOT;
+@ a
+@> ab
+@>> abc
+@>>>  abc
+@>>>>   abc
+@>>>>>    abc
+@>>>>>>     abc
+@>>>>>>>      abc
+@>>>>>>>>       abc
+@>>>>>>>>>        abc
+@>>>>>>>>>>         abc
+EOT
+
+$was1 = $was2 = '';
+for (0..10) {           
+  # lexical picture
+  $^A = '';
+  my $format1 = '@' . '>' x $_;
+  formline $format1, 'abc';
+  $was1 .= "$format1 $^A\n";
+  # global
+  $^A = '';
+  local $format2 = '@' . '>' x $_;
+  formline $format2, 'abc';
+  $was2 .= "$format2 $^A\n";
+}
+print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
+print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+
diff --git a/contrib/perl5/t/pragma/constant.t b/contrib/perl5/t/pragma/constant.t
new file mode 100755
index 0000000..0b58bae
--- /dev/null
+++ b/contrib/perl5/t/pragma/constant.t
@@ -0,0 +1,141 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib';
+}
+
+BEGIN {$^W |= 1}		# Insist upon 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..39\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use constant;
+$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';
+{
+    my $save_warn;
+    local $^W;
+    BEGIN { $save_warn = $^W; $^W = 0 }
+    test 24, TRAILING == 12;
+    BEGIN { $^W = $save_warn }
+}
+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, $^W & 1, "Who disabled the warnings?";
diff --git a/contrib/perl5/t/pragma/locale.t b/contrib/perl5/t/pragma/locale.t
new file mode 100755
index 0000000..00baa66
--- /dev/null
+++ b/contrib/perl5/t/pragma/locale.t
@@ -0,0 +1,483 @@
+#!./perl -wT
+
+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;
+    }
+}
+
+use strict;
+
+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' && $Config{cc} =~ /^(cl|gcc)/i;
+
+print "1..", ($have_setlocale ? 102 : 98), "\n";
+
+use vars qw($a
+	    $English $German $French $Spanish
+	    @C @English @German @French @Spanish
+	    $Locale @Locale %iLocale %UPPER %lower @Neoalpha);
+
+$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.
+    local $^W;	# no warnings 'undef'
+    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      10, sprintf('%e', 123.456);
+check_taint      11, sprintf('%f', 123.456);
+check_taint      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;
+
+# 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;
+
+sub getalnum {
+    sort grep /\w/, map { chr } 0..255
+}
+
+sub locatelocale ($$@) {
+    my ($lcall, $alnum, @try) = @_;
+
+    undef $$lcall;
+
+    for (@try) {
+	local $^W = 0; # suppress "Subroutine LC_ALL redefined"
+	if (setlocale(&LC_ALL, $_)) {
+	    $$lcall = $_;
+	    @$alnum = &getalnum;
+	    last;
+	}
+    }
+
+    @$alnum = () unless (defined $$lcall);
+}
+
+# Find some default locale
+
+locatelocale(\$Locale, \@Locale, qw(C POSIX));
+
+# Find some English locale
+
+locatelocale(\$English, \@English,
+	     qw(en_US.ISO8859-1 en_GB.ISO8859-1
+		en en_US en_UK en_IE en_CA en_AU en_NZ
+		english english.iso88591
+		american american.iso88591
+		british british.iso88591
+		));
+
+# Find some German locale
+
+locatelocale(\$German, \@German,
+	     qw(de_DE.ISO8859-1 de_AT.ISO8859-1 de_CH.ISO8859-1
+		de de_DE de_AT de_CH
+		german german.iso88591));
+
+# Find some French locale
+
+locatelocale(\$French, \@French,
+	     qw(fr_FR.ISO8859-1 fr_BE.ISO8859-1 fr_CA.ISO8859-1 fr_CH.ISO8859-1
+		fr fr_FR fr_BE fr_CA fr_CH
+		french french.iso88591));
+
+# Find some Spanish locale
+
+locatelocale(\$Spanish, \@Spanish,
+	     qw(es_AR.ISO8859-1 es_BO.ISO8859-1 es_CL.ISO8859-1
+		es_CO.ISO8859-1 es_CR.ISO8859-1 es_EC.ISO8859-1
+		es_ES.ISO8859-1 es_GT.ISO8859-1 es_MX.ISO8859-1
+		es_NI.ISO8859-1 es_PA.ISO8859-1 es_PE.ISO8859-1
+		es_PY.ISO8859-1 es_SV.ISO8859-1 es_UY.ISO8859-1 es_VE.ISO8859-1
+		es es_AR es_BO es_CL
+		es_CO es_CR es_EC
+		es_ES es_GT es_MX
+		es_NI es_PA es_PE
+		es_PY es_SV es_UY es_VE
+		spanish spanish.iso88591));
+
+# Select the largest of the alpha(num)bets.
+
+($Locale, @Locale) = ($English, @English)
+    if (@English > @Locale);
+($Locale, @Locale) = ($German, @German)
+    if (@German  > @Locale);
+($Locale, @Locale) = ($French, @French)
+    if (@French  > @Locale);
+($Locale, @Locale) = ($Spanish, @Spanish)
+    if (@Spanish > @Locale);
+
+{
+    local $^W = 0;
+    setlocale(&LC_ALL, $Locale);
+}
+
+# Sort it now that LC_ALL has been set.
+
+@Locale = sort @Locale;
+
+print "# Locale = $Locale\n";
+print "# Alnum_ = @Locale\n";
+
+{
+    my $i = 0;
+
+    for (@Locale) {
+	$iLocale{$_} = $i++;
+    }
+}
+
+# Sieve the uppercase and the lowercase.
+
+for (@Locale) {
+    if (/[^\d_]/) { # skip digits and the _
+	if (lc eq $_) {
+	    $UPPER{$_} = uc;
+	} else {
+	    $lower{$_} = lc;
+	}
+    }
+}
+
+# Find the alphabets that are not alphabets in the default locale.
+
+{
+    no locale;
+    
+    for (keys %UPPER, keys %lower) {
+	push(@Neoalpha, $_) if (/\W/);
+    }
+}
+
+@Neoalpha = sort @Neoalpha;
+
+# Test \w.
+
+{
+    my $word = join('', @Neoalpha);
+
+    $word =~ /^(\w*)$/;
+
+    print 'not ' if ($1 ne $word);
+}
+print "ok 99\n";
+
+# Find places where the collation order differs from the default locale.
+
+print "# testing 100\n";
+{
+    my (@k, $i, $j, @d);
+
+    {
+	no locale;
+
+	@k = sort (keys %UPPER, keys %lower); 
+    }
+
+    for ($i = 0; $i < @k; $i++) {
+	for ($j = $i + 1; $j < @k; $j++) {
+	    if ($iLocale{$k[$j]} < $iLocale{$k[$i]}) {
+		push(@d, [$k[$j], $k[$i]]);
+	    }
+	}
+    }
+
+    # Cross-check those places.
+
+    for (@d) {
+	($i, $j) = @$_;
+	if ($i gt $j) {
+	    print "# failed 100 at:\n";
+	    print "# i = $i, j = $j, i ",
+	          $i le $j ? 'le' : 'gt', " j\n";
+	    print 'not ';
+	    last;
+	}
+    }
+}
+print "ok 100\n";
+
+# Cross-check whole character set.
+
+print "# testing 101\n";
+for (map { chr } 0..255) {
+    if (/\w/ and /\W/) { print 'not '; last }
+    if (/\d/ and /\D/) { print 'not '; last }
+    if (/\s/ and /\S/) { print 'not '; last }
+    if (/\w/ and /\D/ and not /_/ and
+	not (exists $UPPER{$_} or exists $lower{$_})) {
+	print "# failed 101 at:\n";
+	print "# ", ord($_), " '$_'\n";
+	print 'not ';
+	last;
+    }
+}
+print "ok 101\n";
+
+# Test for read-onlys.
+
+{
+    no locale;
+    $a = "qwerty";
+    {
+	use locale;
+	print "not " if $a cmp "qwerty";
+    }
+}
+print "ok 102\n";
+
+# This test must be the last one because its failure is not fatal.
+# The @Locale should be internally consistent.
+# Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
+# for inventing a way to test for ordering consistency
+# without requiring any particular order.
+# ++$jhi;#@iki.fi
+
+print "# testing 103\n";
+{
+    my ($from, $to, $lesser, $greater, @test, %test, $test, $yes, $no, $sign);
+
+    for (0..9) {
+	# Select a slice.
+	$from = int(($_*@Locale)/10);
+	$to = $from + int(@Locale/10);
+        $to = $#Locale if ($to > $#Locale);
+	$lesser  = join('', @Locale[$from..$to]);
+	# Select a slice one character on.
+	$from++; $to++;
+        $to = $#Locale if ($to > $#Locale);
+	$greater = join('', @Locale[$from..$to]);
+	($yes, $no, $sign) = ($lesser lt $greater
+				? ("    ", "not ", 1)
+				: ("not ", "    ", -1));
+	# all these tests should FAIL (return 0).
+	@test = 
+	    (
+	     $no.'    ($lesser  lt $greater)',  # 0
+	     $no.'    ($lesser  le $greater)',  # 1
+	     'not      ($lesser  ne $greater)', # 2
+	     '         ($lesser  eq $greater)', # 3
+	     $yes.'    ($lesser  ge $greater)', # 4
+	     $yes.'    ($lesser  gt $greater)', # 5
+	     $yes.'    ($greater lt $lesser )', # 6
+	     $yes.'    ($greater le $lesser )', # 7
+	     'not      ($greater ne $lesser )', # 8
+	     '         ($greater eq $lesser )', # 9
+	     $no.'     ($greater ge $lesser )', # 10
+	     $no.'     ($greater gt $lesser )', # 11
+	     'not (($lesser cmp $greater) == -$sign)' # 12
+	     );
+	@test{@test} = 0 x @test;
+	$test = 0;
+	for my $ti (@test) { $test{$ti} = eval $ti ; $test ||= $test{$ti} }
+	if ($test) {
+	    print "# failed 103 at:\n";
+	    print "# lesser  = '$lesser'\n";
+	    print "# greater = '$greater'\n";
+	    print "# lesser cmp greater = ", $lesser cmp $greater, "\n";
+	    print "# greater cmp lesser = ", $greater cmp $lesser, "\n";
+	    print "# (greater) from = $from, to = $to\n";
+	    for my $ti (@test) {
+		printf("# %-40s %-4s", $ti,
+		       $test{$ti} ? 'FAIL' : 'ok');
+		if ($ti =~ /\(\.*(\$.+ +cmp +\$[^\)]+)\.*\)/) {
+		    printf("(%s == %4d)", $1, eval $1);
+	        }
+		print "\n";
+	    }
+
+	    warn "The locale definition on your system may have errors.\n";
+	    last;
+	}
+    }
+}
+
+# eof
diff --git a/contrib/perl5/t/pragma/overload.t b/contrib/perl5/t/pragma/overload.t
new file mode 100755
index 0000000..afba8a3
--- /dev/null
+++ b/contrib/perl5/t/pragma/overload.t
@@ -0,0 +1,698 @@
+#!./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
+
+
+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/z-Z/z-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 z-Z tr z-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->[0,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->[0,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')
+}
+
+# Last test is:
+sub last {173}
diff --git a/contrib/perl5/t/pragma/strict-refs b/contrib/perl5/t/pragma/strict-refs
new file mode 100644
index 0000000..7bf1556
--- /dev/null
+++ b/contrib/perl5/t/pragma/strict-refs
@@ -0,0 +1,295 @@
+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.
+########
+
+--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.
+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/contrib/perl5/t/pragma/strict-subs b/contrib/perl5/t/pragma/strict-subs
new file mode 100644
index 0000000..61ec286
--- /dev/null
+++ b/contrib/perl5/t/pragma/strict-subs
@@ -0,0 +1,279 @@
+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 ;
+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.
diff --git a/contrib/perl5/t/pragma/strict-vars b/contrib/perl5/t/pragma/strict-vars
new file mode 100644
index 0000000..42107fa
--- /dev/null
+++ b/contrib/perl5/t/pragma/strict-vars
@@ -0,0 +1,223 @@
+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) ;
+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.
+########
+
+# 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.
+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.
diff --git a/contrib/perl5/t/pragma/strict.t b/contrib/perl5/t/pragma/strict.t
new file mode 100755
index 0000000..fc32820
--- /dev/null
+++ b/contrib/perl5/t/pragma/strict.t
@@ -0,0 +1,93 @@
+#!./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 $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+
+my @prgs = () ;
+
+foreach (sort glob("pragma/strict-*")) {
+
+    next if /(~|\.orig)$/;
+
+    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 ;
+    	    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 ?
+                  `MCR $^X $switch $tmpfile` :
+		  $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  `sh -c './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+$//;
+    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/contrib/perl5/t/pragma/subs.t b/contrib/perl5/t/pragma/subs.t
new file mode 100755
index 0000000..680564f
--- /dev/null
+++ b/contrib/perl5/t/pragma/subs.t
@@ -0,0 +1,133 @@
+#!./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 $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 ?
+                  `MCR $^X $switch $tmpfile` :
+		  $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  `sh -c './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
+    $results =~ s/Syntax/syntax/;  # non-standard yacc
+    $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
+########
+
+--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/contrib/perl5/t/pragma/warn-1global b/contrib/perl5/t/pragma/warn-1global
new file mode 100644
index 0000000..07b5bc8
--- /dev/null
+++ b/contrib/perl5/t/pragma/warn-1global
@@ -0,0 +1,151 @@
+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.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator 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 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 at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value 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 at - line 3.
+########
+
+$^W = 1;
+eval "my $b ; chop $b ;" ;
+EXPECT
+Use of uninitialized value at - line 3.
+Use of uninitialized value at - line 3.
+########
+
+eval "$^W = 1;" ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+eval {$^W = 1;} ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value at - line 3.
+########
+
+{
+    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 at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value at - line 2.
diff --git a/contrib/perl5/t/pragma/warning.t b/contrib/perl5/t/pragma/warning.t
new file mode 100755
index 0000000..fa0301e
--- /dev/null
+++ b/contrib/perl5/t/pragma/warning.t
@@ -0,0 +1,94 @@
+#!./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 $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
+
+my @prgs = () ;
+
+foreach (sort glob("pragma/warn-*")) {
+
+    next if /(~|\.orig)$/;
+
+    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 = $&;
+        $switch =~ s/(-\S*[A-Z]\S*)/"-$1"/ if $Is_VMS; # protect uc switches
+    }
+    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 ?
+                  `MCR $^X $switch $tmpfile` :
+		  $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  `sh -c './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+$//;
+    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 $_ } 
+}