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

80 files changed, 9164 insertions, 0 deletions

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";
+