stock perl 5.6.1

47 files changed, 3498 insertions, 177 deletions

diff --git a/gnu/usr.bin/perl/t/base/rs.t b/gnu/usr.bin/perl/t/base/rs.t
index 021d699e2e8..e470f3a30c1 100644
--- a/gnu/usr.bin/perl/t/base/rs.t
+++ b/gnu/usr.bin/perl/t/base/rs.t
@@ -6,6 +6,8 @@ print "1..14\n";
 $teststring = "1\n12\n123\n1234\n1234\n12345\n\n123456\n1234567\n";
 
 # Create our test datafile
+1 while unlink 'foo';                # in case junk left around
+rmdir 'foo';
 open TESTFILE, ">./foo" or die "error $! $^E opening";
 binmode TESTFILE;
 print TESTFILE $teststring;
diff --git a/gnu/usr.bin/perl/t/comp/bproto.t b/gnu/usr.bin/perl/t/comp/bproto.t
index 01efb8401cc..70748be551c 100644
--- a/gnu/usr.bin/perl/t/comp/bproto.t
+++ b/gnu/usr.bin/perl/t/comp/bproto.t
@@ -5,7 +5,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 print "1..10\n";
diff --git a/gnu/usr.bin/perl/t/io/openpid.t b/gnu/usr.bin/perl/t/io/openpid.t
index 80c6bde5d1f..7c04a29fe81 100644
--- a/gnu/usr.bin/perl/t/io/openpid.t
+++ b/gnu/usr.bin/perl/t/io/openpid.t
@@ -9,17 +9,15 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
     if ($^O eq 'dos') {
         print "1..0 # Skip: no multitasking\n";
         exit 0;
     }
 }
 
-
-use FileHandle;
 use Config;
-autoflush STDOUT 1;
+$| = 1;
 $SIG{PIPE} = 'IGNORE';
 
 print "1..10\n";
@@ -33,10 +31,8 @@ $perl = qq[$^X "-I../lib"];
 # the other reader reads one line, waits a few seconds and then
 # exits to test the waitpid function.
 #
-$cmd1 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
-        qq/print qq[first process\\n]; sleep 30;"/;
-$cmd2 = qq/$perl -e "use FileHandle; autoflush STDOUT 1; / .
-        qq/print qq[second process\\n]; sleep 30;"/;
+$cmd1 = qq/$perl -e "\$|=1; print qq[first process\\n]; sleep 30;"/;
+$cmd2 = qq/$perl -e "\$|=1; print qq[second process\\n]; sleep 30;"/;
 $cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
 $cmd4 = qq/$perl -e "print scalar <>;"/;
 
@@ -76,9 +72,9 @@ print "not " unless $kill_cnt == 2;
 print "ok 8\n";
 
 # send one expected line of text to child process and then wait for it
-autoflush FH4 1;
+select(FH4); $| = 1; select(STDOUT);
+
 print FH4 "ok 9\n";
-print "ok 9 # skip VMS\n" if $^O eq 'VMS';
 print "# waiting for process $pid4 to exit\n";
 $reap_pid = waitpid $pid4, 0;
 print "# reaped pid $reap_pid != $pid4\nnot "
diff --git a/gnu/usr.bin/perl/t/lib/b.t b/gnu/usr.bin/perl/t/lib/b.t
new file mode 100644
index 00000000000..22156c2354a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/b.t
@@ -0,0 +1,163 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    if ($^O eq 'MacOS') { 
+	@INC = qw(: ::lib ::macos:lib); 
+    } else { 
+	@INC = '.'; 
+	push @INC, '../lib'; 
+    }
+}
+
+$|  = 1;
+use warnings;
+use strict;
+use Config;
+
+print "1..15\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+use B::Deparse;
+my $deparse = B::Deparse->new() or print "not ";
+ok;
+
+print "not " if "{\n    1;\n}" ne $deparse->coderef2text(sub {1});
+ok;
+
+print "not " if "{\n    '???';\n    2;\n}" ne
+                    $deparse->coderef2text(sub {1;2});
+ok;
+
+print "not " if "{\n    \$test /= 2 if ++\$test;\n}" ne
+                    $deparse->coderef2text(sub {++$test and $test/=2;});
+ok;
+{
+my $a = <<'EOF';
+{
+    $test = sub : lvalue {
+        my $x;
+    }
+    ;
+}
+EOF
+chomp $a;
+print "not " if $deparse->coderef2text(sub{$test = sub : lvalue{my $x}}) ne $a;
+ok;
+
+$a =~ s/lvalue/method/;
+print "not " if $deparse->coderef2text(sub{$test = sub : method{my $x}}) ne $a;
+ok;
+
+$a =~ s/method/locked method/;
+print "not " if $deparse->coderef2text(sub{$test = sub : method locked {my $x}})
+                                     ne $a;
+ok;
+}
+
+my $a;
+my $Is_VMS = $^O eq 'VMS';
+my $Is_MacOS = $^O eq 'MacOS';
+
+my $path = join " ", map { qq["-I$_"] } @INC;
+my $redir = $Is_MacOS ? "" : "2>&1";
+
+$a = `$^X $path "-MO=Deparse" -anle 1 $redir`;
+$a =~ s/-e syntax OK\n//g;
+$a =~ s{\\340\\242}{\\s} if (ord("\\") == 224); # EBCDIC, cp 1047 or 037
+$a =~ s{\\274\\242}{\\s} if (ord("\\") == 188); # $^O eq 'posix-bc'
+$b = <<'EOF';
+
+LINE: while (defined($_ = <ARGV>)) {
+    chomp $_;
+    @F = split(/\s+/, $_, 0);
+    '???';
+}
+
+EOF
+print "# [$a]\n\# vs\n# [$b]\nnot " if $a ne $b;
+ok;
+
+#6
+$a = `$^X $path "-MO=Debug" -e 1 $redir`;
+print "not " unless $a =~
+/\bLISTOP\b.*\bOP\b.*\bCOP\b.*\bOP\b/s;
+ok;
+
+#7
+$a = `$^X $path "-MO=Terse" -e 1 $redir`;
+print "not " unless $a =~
+/\bLISTOP\b.*leave.*\n    OP\b.*enter.*\n    COP\b.*nextstate.*\n    OP\b.*null/s;
+ok;
+
+$a = `$^X $path "-MO=Terse" -ane "s/foo/bar/" $redir`;
+$a =~ s/\(0x[^)]+\)//g;
+$a =~ s/\[[^\]]+\]//g;
+$a =~ s/-e syntax OK//;
+$a =~ s/[^a-z ]+//g;
+$a =~ s/\s+/ /g;
+$a =~ s/\b(s|foo|bar|ullsv)\b\s?//g;
+$a =~ s/^\s+//;
+$a =~ s/\s+$//;
+my $is_thread = $Config{use5005threads} && $Config{use5005threads} eq 'define';
+if ($is_thread) {
+    $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null
+threadsv readline gv lineseq nextstate aassign null pushmark split pushre
+threadsv const null pushmark rvav gv nextstate subst const unstack nextstate
+EOF
+} else {
+    $b=<<EOF;
+leave enter nextstate label leaveloop enterloop null and defined null
+null gvsv readline gv lineseq nextstate aassign null pushmark split pushre
+null gvsv const null pushmark rvav gv nextstate subst const unstack nextstate
+EOF
+}
+$b=~s/\n/ /g;$b=~s/\s+/ /g;
+$b =~ s/\s+$//;
+print "# [$a]\n# vs\n# [$b]\nnot " if $a ne $b;
+ok;
+
+chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
+$a = join ',', sort split /,/, $a;
+$a =~ s/-uWin32,// if $^O eq 'MSWin32';
+$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
+$a =~ s/-uCwd,// if $^O eq 'cygwin';
+if ($Config{static_ext} eq ' ') {
+  $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
+     . '-umain,-uwarnings';
+  if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
+      $b = join ',', sort split /,/, $b;
+  }
+  print "# [$a] vs [$b]\nnot " if $a ne $b;
+  ok;
+} else {
+  print "ok $test # skipped: one or more static extensions\n"; $test++;
+}
+
+if ($is_thread) {
+    print "# use5005threads: test $test skipped\n";
+} else {
+    $a = `$^X $path "-MO=Showlex" -e "my %one" $redir`;
+    if (ord('A') != 193) { # ASCIIish
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%one.*sv_undef.*HV/s;
+    } 
+    else { # EBCDICish C<1: PVNV (0x1a7ede34) "%\226\225\205">
+        print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*%\\[0-9].*sv_undef.*HV/s;
+    }
+}
+ok;
+
+# Bug 20001204.07
+{
+my $foo = $deparse->coderef2text(sub { { 234; }});
+# Constants don't get optimised here.
+print "not " unless $foo =~ /{.*{.*234;.*}.*}/sm;
+ok;
+$foo = $deparse->coderef2text(sub { { 234; } continue { 123; } });
+print "not " unless $foo =~ /{.*{.*234;.*}.*continue.*{.*123.*}/sm; 
+ok;
+}
diff --git a/gnu/usr.bin/perl/t/lib/cgi-esc.t b/gnu/usr.bin/perl/t/lib/cgi-esc.t
new file mode 100644
index 00000000000..f0471cfed37
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-esc.t
@@ -0,0 +1,56 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to escape() and unescape() punctuation characters
+# except for qw(- . _).
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..59\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Config;
+use CGI::Util qw(escape unescape);
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# ASCII order, ASCII codepoints, ASCII repertoire
+
+my %punct = (
+    ' ' => '20',  '!' => '21',  '"' => '22',  '#' =>  '23', 
+    '$' => '24',  '%' => '25',  '&' => '26',  '\'' => '27', 
+    '(' => '28',  ')' => '29',  '*' => '2A',  '+' =>  '2B', 
+    ',' => '2C',                              '/' =>  '2F',  # '-' => '2D',  '.' => '2E' 
+    ':' => '3A',  ';' => '3B',  '<' => '3C',  '=' =>  '3D', 
+    '>' => '3E',  '?' => '3F',  '[' => '5B',  '\\' => '5C', 
+    ']' => '5D',  '^' => '5E',                '`' =>  '60',  # '_' => '5F',
+    '{' => '7B',  '|' => '7C',  '}' => '7D',  '~' =>  '7E', 
+         );
+
+# The sort order may not be ASCII on EBCDIC machines:
+
+my $i = 1;
+
+foreach(sort(keys(%punct))) { 
+    $i++;
+    my $escape = "AbC\%$punct{$_}dEF";
+    my $cgi_escape = escape("AbC$_" . "dEF");
+    test($i, $escape eq $cgi_escape , "# $escape ne $cgi_escape");
+    $i++;
+    my $unescape = "AbC$_" . "dEF";
+    my $cgi_unescape = unescape("AbC\%$punct{$_}dEF");
+    test($i, $unescape eq $cgi_unescape , "# $unescape ne $cgi_unescape");
+}
+
diff --git a/gnu/usr.bin/perl/t/lib/cgi-pretty.t b/gnu/usr.bin/perl/t/lib/cgi-pretty.t
new file mode 100644
index 00000000000..14f6447033a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/cgi-pretty.t
@@ -0,0 +1,41 @@
+#!/usr/local/bin/perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+use lib '../blib/lib','../blib/arch';
+
+BEGIN {$| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI::Pretty (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<h1>',"single tag");
+test(3,ol(li('fred'),li('ethel')) eq "<ol>\n\t<li>\n\t\tfred\n\t</li>\n\t <li>\n\t\tethel\n\t</li>\n</ol>\n","basic indentation");
+test(4,p('hi',pre('there'),'frog') eq 
+'<p>
+	hi <pre>there</pre>
+	 frog
+</p>
+',"<pre> tags");
+test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
+'<p>
+	hi <a href="frog">there</a>
+	 frog
+</p>
+',"as-is");
diff --git a/gnu/usr.bin/perl/t/lib/class-struct.t b/gnu/usr.bin/perl/t/lib/class-struct.t
new file mode 100644
index 00000000000..26505bacfc6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/class-struct.t
@@ -0,0 +1,66 @@
+#!./perl -w
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+print "1..8\n";
+
+package aClass;
+
+sub new { bless {}, shift }
+
+sub meth { 42 }
+
+package MyObj;
+
+use Class::Struct;
+use Class::Struct 'struct'; # test out both forms
+
+use Class::Struct SomeClass => { SomeElem => '$' };
+
+struct( s => '$', a => '@', h => '%', c => 'aClass' );
+
+my $obj = MyObj->new;
+
+$obj->s('foo');
+
+print "not " unless $obj->s() eq 'foo';
+print "ok 1\n";
+
+my $arf = $obj->a;
+
+print "not " unless ref $arf eq 'ARRAY';
+print "ok 2\n";
+
+$obj->a(2, 'secundus');
+
+print "not " unless $obj->a(2) eq 'secundus';
+print "ok 3\n";
+
+my $hrf = $obj->h;
+
+print "not " unless ref $hrf eq 'HASH';
+print "ok 4\n";
+
+$obj->h('x', 10);
+
+print "not " unless $obj->h('x') == 10;
+print "ok 5\n";
+
+my $orf = $obj->c;
+
+print "not " unless ref $orf eq 'aClass';
+print "ok 6\n";
+
+print "not " unless $obj->c->meth() == 42;
+print "ok 7\n";
+
+my $obk = SomeClass->new();
+
+$obk->SomeElem(123);
+
+print "not " unless $obk->SomeElem() == 123;
+print "ok 8\n";
+
diff --git a/gnu/usr.bin/perl/t/lib/ftmp-mktemp.t b/gnu/usr.bin/perl/t/lib/ftmp-mktemp.t
new file mode 100644
index 00000000000..b0a78721e75
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ftmp-mktemp.t
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -w
+
+# Test for mktemp family of commands in File::Temp
+# Use STANDARD safe level for these tests
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 9);
+}
+
+use strict;
+
+use File::Spec;
+use File::Path;
+use File::Temp qw/ :mktemp unlink0 /;
+
+ok(1);
+
+# MKSTEMP - test
+
+# Create file in temp directory
+my $template = File::Spec->catfile(File::Spec->tmpdir, 'wowserXXXX');
+
+(my $fh, $template) = mkstemp($template);
+
+print "# MKSTEMP: FH is $fh File is $template fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $template) );
+
+# Autoflush
+$fh->autoflush(1) if $] >= 5.006;
+
+# Try printing something to the file
+my $string = "woohoo\n";
+print $fh $string;
+
+# rewind the file
+ok(seek( $fh, 0, 0));
+
+# Read from the file
+my $line = <$fh>;
+
+# compare with previous string
+ok($string, $line);
+
+# Tidy up
+# This test fails on Windows NT since it seems that the size returned by 
+# stat(filehandle) does not always equal the size of the stat(filename)
+# This must be due to caching. In particular this test writes 7 bytes
+# to the file which are not recognised by stat(filename)
+# Simply waiting 3 seconds seems to be enough for the system to update
+
+if ($^O eq 'MSWin32') {
+  sleep 3;
+}
+my $status = unlink0($fh, $template);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# MKSTEMPS
+# File with suffix. This is created in the current directory so
+# may be problematic on NFS
+
+$template = "suffixXXXXXX";
+my $suffix = ".dat";
+
+($fh, my $fname) = mkstemps($template, $suffix);
+
+print "# MKSTEMPS: File is $template -> $fname fileno=".fileno($fh)."\n";
+# Check if the file exists
+ok( (-e $fname) );
+
+# This fails if you are running on NFS
+# If this test fails simply skip it rather than doing a hard failure
+$status = unlink0($fh, $fname);
+
+if ($status) {
+  ok($status);
+} else {
+  skip("Skip test failed probably due to cwd being on NFS",1)
+}
+
+# MKDTEMP
+# Temp directory
+
+$template = File::Spec->catdir(File::Spec->tmpdir, 'tmpdirXXXXXX');
+
+my $tmpdir = mkdtemp($template);
+
+print "# MKDTEMP: Name is $tmpdir from template $template\n";
+
+ok( (-d $tmpdir ) );
+
+# Need to tidy up after myself
+rmtree($tmpdir);
+
+# MKTEMP
+# Just a filename, not opened
+
+$template = File::Spec->catfile(File::Spec->tmpdir, 'mytestXXXXXX');
+
+my $tmpfile = mktemp($template);
+
+print "# MKTEMP: Tempfile is $template -> $tmpfile\n";
+
+# Okay if template no longer has XXXXX in
+
+
+ok( ($tmpfile !~ /XXXXX$/) );
diff --git a/gnu/usr.bin/perl/t/lib/ftmp-posix.t b/gnu/usr.bin/perl/t/lib/ftmp-posix.t
new file mode 100644
index 00000000000..79496d8a4ab
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ftmp-posix.t
@@ -0,0 +1,81 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - POSIX functions
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 7);
+}
+
+use strict;
+
+use File::Temp qw/ :POSIX unlink0 /;
+ok(1);
+
+# TMPNAM - scalar
+
+print "# TMPNAM: in a scalar context: \n";
+my $tmpnam = tmpnam();
+
+# simply check that the file does not exist
+# Not a 100% water tight test though if another program 
+# has managed to create one in the meantime.
+ok( !(-e $tmpnam ));
+
+print "# TMPNAM file name: $tmpnam\n";
+
+# TMPNAM list context
+# Not strict posix behaviour
+(my $fh, $tmpnam) = tmpnam();
+
+print "# TMPNAM: in list context: $fh $tmpnam\n";
+
+# File is opened - make sure it exists
+ok( (-e $tmpnam ));
+
+# Unlink it - a possible NFS issue again if TMPDIR is not a local disk
+my $status = unlink0($fh, $tmpnam);
+if ($status) {
+  ok( $status );
+} else {
+  skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+}
+
+# TMPFILE
+
+$fh = tmpfile();
+
+if (defined $fh) {
+  ok( $fh );
+  print "# TMPFILE: tmpfile got FH $fh\n";
+
+  $fh->autoflush(1) if $] >= 5.006;
+
+  # print something to it
+  my $original = "Hello a test\n";
+  print "# TMPFILE: Wrote line: $original";
+  print $fh $original
+    or die "Error printing to tempfile\n";
+
+  # rewind it
+  ok( seek($fh,0,0) );
+
+  # Read from it
+  my $line = <$fh>;
+
+  print "# TMPFILE: Read line: $line";
+  ok( $original, $line);
+
+  close($fh);
+
+} else {
+  # Skip all the remaining tests
+  foreach (1..3) {
+    skip("Skip test failed probably due to \$TMPDIR being on NFS",1);
+  }
+}
+
+
+
+
diff --git a/gnu/usr.bin/perl/t/lib/ftmp-security.t b/gnu/usr.bin/perl/t/lib/ftmp-security.t
new file mode 100644
index 00000000000..96b2c4283c3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ftmp-security.t
@@ -0,0 +1,140 @@
+#!/usr/bin/perl -w
+# Test for File::Temp - Security levels
+
+# Some of the security checking will not work on all platforms
+# Test a simple open in the cwd and tmpdir foreach of the
+# security levels
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 13);
+}
+
+use strict;
+use File::Spec;
+
+# Set up END block - this needs to happen before we load
+# File::Temp since this END block must be evaluated after the
+# END block configured by File::Temp
+my @files; # list of files to remove
+END { foreach (@files) { ok( !(-e $_) )} }
+
+use File::Temp qw/ tempfile unlink0 /;
+ok(1);
+
+# The high security tests must currently be skipped on some platforms
+my $skipplat = ( (
+		  # No sticky bits.
+		  $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'dos'
+		  ) ? 1 : 0 );
+
+# Can not run high security tests in perls before 5.6.0
+my $skipperl  = ($] < 5.006 ? 1 : 0 );
+
+# Determine whether we need to skip things and why
+my $skip = 0;
+if ($skipplat) {
+  $skip = "Skip Not supported on this platform";
+} elsif ($skipperl) {
+  $skip = "Skip Perl version must be v5.6.0 for these tests";
+
+}
+
+print "# We will be skipping some tests : $skip\n" if $skip;
+
+# start off with basic checking
+
+File::Temp->safe_level( File::Temp::STANDARD );
+
+print "# Testing with STANDARD security...\n";
+
+&test_security(0);
+
+# Try medium
+
+File::Temp->safe_level( File::Temp::MEDIUM )
+  unless $skip;
+
+print "# Testing with MEDIUM security...\n";
+
+# Now we need to start skipping tests
+&test_security($skip);
+
+# Try HIGH
+
+File::Temp->safe_level( File::Temp::HIGH )
+  unless $skip;
+
+print "# Testing with HIGH security...\n";
+
+&test_security($skip);
+
+exit;
+
+# Subroutine to open two temporary files.
+# one is opened in the current dir and the other in the temp dir
+
+sub test_security {
+
+  # Read in the skip flag
+  my $skip = shift;
+
+  # If we are skipping we need to simply fake the correct number
+  # of tests -- we dont use skip since the tempfile() commands will
+  # fail with MEDIUM/HIGH security before the skip() command would be run
+  if ($skip) {
+
+    skip($skip,1);
+    skip($skip,1);
+
+    # plus we need an end block so the tests come out in the right order
+    eval q{ END { skip($skip,1); skip($skip,1)  } 1; } || die;
+
+    return;
+  }
+
+  # Create the tempfile
+  my $template = "tmpXXXXX";
+  my ($fh1, $fname1) = eval { tempfile ( $template, 
+				  DIR => File::Spec->tmpdir,
+				  UNLINK => 1,
+				);
+			    };
+
+  if (defined $fname1) {
+      print "# fname1 = $fname1\n";
+      ok( (-e $fname1) );
+      push(@files, $fname1); # store for end block
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+  # Explicitly 
+  if ( $< < File::Temp->top_system_uid() ){
+      skip("Skip Test inappropriate for root", 1);
+      eval q{ END { skip($skip,1); } 1; } || die;
+      return;
+  }
+  my ($fh2, $fname2) = eval { tempfile ($template,  UNLINK => 1 ); };
+  if (defined $fname2) {
+      print "# fname2 = $fname2\n";
+      ok( (-e $fname2) );
+      push(@files, $fname2); # store for end block
+      close($fh2);
+  } elsif (File::Temp->safe_level() != File::Temp::STANDARD) {
+      my $skip2 = "Skip system possibly insecure, see INSTALL, section 'make test'";
+      skip($skip2, 1);
+      # plus we need an end block so the tests come out in the right order
+      eval q{ END { skip($skip2,1); } 1; } || die;
+  } else {
+      ok(0);
+  }
+
+}
diff --git a/gnu/usr.bin/perl/t/lib/ftmp-tempfile.t b/gnu/usr.bin/perl/t/lib/ftmp-tempfile.t
new file mode 100644
index 00000000000..ed59765a757
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ftmp-tempfile.t
@@ -0,0 +1,145 @@
+#!/usr/local/bin/perl -w
+# Test for File::Temp - tempfile function
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Test; import Test;
+	plan(tests => 20);
+}
+
+use strict;
+use File::Spec;
+
+# Will need to check that all files were unlinked correctly
+# Set up an END block here to do it
+
+# Arrays containing list of dirs/files to test
+my (@files, @dirs, @still_there);
+
+# And a test for files that should still be around
+# These are tidied up
+END {
+  foreach (@still_there) {
+    ok( -f $_ );
+    ok( unlink( $_ ) );
+    ok( !(-f $_) );
+  }
+}
+
+# Loop over an array hoping that the files dont exist
+END { foreach (@files) { ok( !(-e $_) )} }
+
+# And a test for directories
+END { foreach (@dirs)  { ok( !(-d $_) )} }
+
+# Need to make sure that the END blocks are setup before
+# the ones that File::Temp configures since END blocks are evaluated
+# in revers order and we need to check the files *after* File::Temp
+# removes them
+use File::Temp qw/ tempfile tempdir/;
+
+# Now we start the tests properly
+ok(1);
+
+
+# Tempfile
+# Open tempfile in some directory, unlink at end
+my ($fh, $tempfile) = tempfile(
+			       UNLINK => 1,
+			       SUFFIX => '.txt',
+			      );
+
+ok( (-f $tempfile) );
+# Should still be around after closing
+ok( close( $fh ) ); 
+ok( (-f $tempfile) );
+# Check again at exit
+push(@files, $tempfile);
+
+# TEMPDIR test
+# Create temp directory in current dir
+my $template = 'tmpdirXXXXXX';
+print "# Template: $template\n";
+my $tempdir = tempdir( $template ,
+		       DIR => File::Spec->curdir,
+		       CLEANUP => 1,
+		     );
+
+print "# TEMPDIR: $tempdir\n";
+
+ok( (-d $tempdir) );
+push(@dirs, $tempdir);
+
+# Create file in the temp dir
+($fh, $tempfile) = tempfile(
+			    DIR => $tempdir,
+			    UNLINK => 1,
+			    SUFFIX => '.dat',
+			   );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile));
+push(@files, $tempfile);
+
+# Test tempfile
+# ..and again
+($fh, $tempfile) = tempfile(
+			    DIR => $tempdir,
+			   );
+
+
+ok( (-f $tempfile ));
+push(@files, $tempfile);
+
+print "# TEMPFILE: Created $tempfile\n";
+
+# and another (with template)
+
+($fh, $tempfile) = tempfile( 'helloXXXXXXX',
+			    DIR => $tempdir,
+			    UNLINK => 1,
+			    SUFFIX => '.dat',
+			   );
+
+print "# TEMPFILE: Created $tempfile\n";
+
+ok( (-f $tempfile) );
+push(@files, $tempfile);
+
+
+# Create a temporary file that should stay around after
+# it has been closed
+($fh, $tempfile) = tempfile( 'permXXXXXXX', UNLINK => 0 );
+print "# TEMPFILE: Created $tempfile\n";
+ok( -f $tempfile );
+ok( close( $fh ) );
+push( @still_there, $tempfile); # check at END
+
+# Would like to create a temp file and just retrieve the handle
+# but the test is problematic since:
+#  - We dont know the filename so we cant check that it is tidied
+#    correctly
+#  - The unlink0 required on unix for tempfile creation will fail
+#    on NFS
+# Try to do what we can.
+# Tempfile croaks on error so we need an eval
+$fh = eval { tempfile( 'ftmpXXXXX', DIR => File::Spec->tmpdir ) };
+
+if ($fh) {
+
+  # print something to it to make sure something is there
+  ok( print $fh "Test\n" );
+
+  # Close it - can not check it is gone since we dont know the name
+  ok( close($fh) );
+
+} else {
+  skip "Skip Failed probably due to NFS", 1;
+  skip "Skip Failed probably due to NFS", 1;
+}
+
+# Now END block will execute to test the removal of directories
+print "# End of tests. Execute END blocks\n";
+
diff --git a/gnu/usr.bin/perl/t/lib/gol-oo.t b/gnu/usr.bin/perl/t/lib/gol-oo.t
new file mode 100644
index 00000000000..98f3eaadb9b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gol-oo.t
@@ -0,0 +1,26 @@
+#!./perl -w
+
+BEGIN {
+    chdir('t') if -d 't';
+    @INC = '../lib';
+}
+
+use Getopt::Long;
+die("Getopt::Long version 2.24 required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION >= 2.24;
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+my $p = new Getopt::Long::Parser (config => ["no_ignore_case"]);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if $p->getoptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/gnu/usr.bin/perl/t/lib/peek.t b/gnu/usr.bin/perl/t/lib/peek.t
new file mode 100644
index 00000000000..fe9cb2cdf98
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/peek.t
@@ -0,0 +1,312 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bPeek\b/) {
+        print "1..0 # Skip: Devel::Peek was not built\n";
+        exit 0;
+    }
+}
+
+use Devel::Peek;
+
+print "1..17\n";
+
+our $DEBUG = 0;
+open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
+
+sub do_test {
+    my $pattern = pop;
+    if (open(OUT,">peek$$")) {
+	open(STDERR, ">&OUT") or die "Can't dup OUT: $!";
+	Dump($_[1]);
+	open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!";
+	close(OUT);
+	if (open(IN, "peek$$")) {
+	    local $/;
+	    $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
+	    print $pattern, "\n" if $DEBUG;
+	    my $dump = <IN>;
+	    print $dump, "\n"    if $DEBUG;
+	    print "[$dump] vs [$pattern]\nnot " unless $dump =~ /$pattern/ms;
+	    print "ok $_[0]\n";
+	    close(IN);
+	} else {
+	    die "$0: failed to open peek$$: !\n";
+	}
+    } else {
+	die "$0: failed to create peek$$: $!\n";
+    }
+}
+
+our   $a;
+our   $b;
+my    $c;
+local $d = 0;
+
+do_test( 1,
+	$a = "foo",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(POK,pPOK\\)
+  PV = $ADDR "foo"\\\0
+  CUR = 3
+  LEN = 4'
+       );
+
+do_test( 2,
+        "bar",
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*POK,READONLY,pPOK\\)
+  PV = $ADDR "bar"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 3,
+        $b = 123,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(IOK,pIOK\\)
+  IV = 123');
+
+do_test( 4,
+        456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*IOK,READONLY,pIOK\\)
+  IV = 456');
+
+do_test( 5,
+        $c = 456,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADBUSY,PADMY,IOK,pIOK\\)
+  IV = 456');
+
+do_test( 6,
+        $c + $d,
+'SV = NV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADTMP,NOK,pNOK\\)
+  NV = 456');
+
+($d = "789") += 0.1;
+
+do_test( 7,
+       $d,
+'SV = PVNV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(NOK,pNOK\\)
+  IV = 0
+  NV = 789\\.(?:1(?:000+\d+)?|0999+\d+)
+  PV = $ADDR "789"\\\0
+  CUR = 3
+  LEN = 4');
+
+do_test( 8,
+        0xabcd,
+'SV = IV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(.*IOK,READONLY,pIOK,IsUV\\)
+  UV = 43981');
+
+do_test( 9,
+        undef,
+'SV = NULL\\(0x0\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(\\)');
+
+do_test(10,
+        \$a,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(POK,pPOK\\)
+    PV = $ADDR "foo"\\\0
+    CUR = 3
+    LEN = 4');
+
+do_test(11,
+       [$b,$c],
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVAV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    ARRAY = $ADDR
+    FILL = 1
+    MAX = 1
+    ARYLEN = 0x0
+    FLAGS = \\(REAL\\)
+    Elt No. 0
+    SV = IV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,pIOK\\)
+      IV = 123
+    Elt No. 1
+    SV = PVNV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+      IV = 456
+      NV = 456
+      PV = 0');
+
+do_test(12,
+       {$b=>$c},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(SHAREKEYS\\)
+    IV = 1
+    NV = 0
+    ARRAY = $ADDR  \\(0:7, 1:1\\)
+    hash quality = 150.0%
+    KEYS = 1
+    FILL = 1
+    MAX = 7
+    RITER = -1
+    EITER = 0x0
+    Elt "123" HASH = $ADDR
+    SV = PVNV\\($ADDR\\) at $ADDR
+      REFCNT = 1
+      FLAGS = \\(IOK,NOK,pIOK,pNOK\\)
+      IV = 456
+      NV = 456
+      PV = 0');
+
+do_test(13,
+        sub(){@_},
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(PADBUSY,PADMY,POK,pPOK,ANON\\)
+    IV = 0
+    NV = 0
+    PROTOTYPE = ""
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*"
+    FILE = ".*\\b(?i:peek\\.t)"
+    DEPTH = 0
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x4
+    PADLIST = $ADDR
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(14,
+        \&do_test,
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVCV\\($ADDR\\) at $ADDR
+    REFCNT = (3|4)
+    FLAGS = \\(\\)
+    IV = 0
+    NV = 0
+    COMP_STASH = $ADDR\\t"main"
+    START = $ADDR ===> \\d+
+    ROOT = $ADDR
+    XSUB = 0x0
+    XSUBANY = 0
+    GVGV::GV = $ADDR\\t"main" :: "do_test"
+    FILE = ".*\\b(?i:peek\\.t)"
+    DEPTH = 1
+(?:    MUTEXP = $ADDR
+    OWNER = $ADDR
+)?    FLAGS = 0x0
+    PADLIST = $ADDR
+      \\d+\\. $ADDR \\("\\$pattern" \\d+-\\d+\\)
+     \\d+\\. $ADDR \\(FAKE "\\$DEBUG" 0-\\d+\\)
+     \\d+\\. $ADDR \\("\\$dump" \\d+-\\d+\\)
+    OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(15,
+        qr(tic),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVMG\\($ADDR\\) at $ADDR
+    REFCNT = 1
+    FLAGS = \\(OBJECT,RMG\\)
+    IV = 0
+    NV = 0
+    PV = 0
+    MAGIC = $ADDR
+      MG_VIRTUAL = $ADDR
+      MG_TYPE = \'r\'
+      MG_OBJ = $ADDR
+    STASH = $ADDR\\t"Regexp"');
+
+do_test(16,
+        (bless {}, "Tac"),
+'SV = RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 2
+    FLAGS = \\(OBJECT,SHAREKEYS\\)
+    IV = 0
+    NV = 0
+    STASH = $ADDR\\t"Tac"
+    ARRAY = 0x0
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0');
+
+do_test(17,
+	*a,
+'SV = PVGV\\($ADDR\\) at $ADDR
+  REFCNT = 5
+  FLAGS = \\(GMG,SMG,MULTI(?:,IN_PAD)?\\)
+  IV = 0
+  NV = 0
+  MAGIC = $ADDR
+    MG_VIRTUAL = &PL_vtbl_glob
+    MG_TYPE = \'\\*\'
+    MG_OBJ = $ADDR
+  NAME = "a"
+  NAMELEN = 1
+  GvSTASH = $ADDR\\t"main"
+  GP = $ADDR
+    SV = $ADDR
+    REFCNT = 1
+    IO = 0x0
+    FORM = 0x0  
+    AV = 0x0
+    HV = 0x0
+    CV = 0x0
+    CVGEN = 0x0
+    GPFLAGS = 0x0
+    LINE = \\d+
+    FILE = ".*\\b(?i:peek\\.t)"
+    FLAGS = $ADDR
+    EGV = $ADDR\\t"a"');
+
+END {
+  1 while unlink("peek$$");
+}
diff --git a/gnu/usr.bin/perl/t/lib/selfloader.t b/gnu/usr.bin/perl/t/lib/selfloader.t
new file mode 100644
index 00000000000..6b9c244b7eb
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/selfloader.t
@@ -0,0 +1,201 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    $dir = "self-$$";
+    @INC = $dir;
+    push @INC, '../lib';
+
+    print "1..19\n";
+
+    # First we must set up some selfloader files
+    mkdir $dir, 0755            or die "Can't mkdir $dir: $!";
+
+    open(FOO, ">$dir/Foo.pm") or die;
+    print FOO <<'EOT';
+package Foo;
+use SelfLoader;
+
+sub new { bless {}, shift }
+sub foo;
+sub bar;
+sub bazmarkhianish;
+sub a;
+sub never;    # declared but definition should never be read
+1;
+__DATA__
+
+sub foo { shift; shift || "foo" };
+
+sub bar { shift; shift || "bar" }
+
+sub bazmarkhianish { shift; shift || "baz" }
+
+package sheep;
+sub bleat { shift; shift || "baa" }
+
+__END__
+sub never { die "D'oh" }
+EOT
+
+    close(FOO);
+
+    open(BAR, ">$dir/Bar.pm") or die;
+    print BAR <<'EOT';
+package Bar;
+use SelfLoader;
+
+@ISA = 'Baz';
+
+sub new { bless {}, shift }
+sub a;
+
+1;
+__DATA__
+
+sub a { 'a Bar'; }
+sub b { 'b Bar' }
+
+__END__ DATA
+sub never { die "D'oh" }
+EOT
+
+    close(BAR);
+};
+
+
+package Baz;
+
+sub a { 'a Baz' }
+sub b { 'b Baz' }
+sub c { 'c Baz' }
+
+
+package main;
+use Foo;
+use Bar;
+
+$foo = new Foo;
+
+print "not " unless $foo->foo eq 'foo';  # selfloaded first time
+print "ok 1\n";
+
+print "not " unless $foo->foo eq 'foo';  # regular call
+print "ok 2\n";
+
+# Try an undefined method
+eval {
+    $foo->will_fail;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 3\n";
+} else {
+    print "not ok 3 $@\n";
+}
+
+# Used to be trouble with this
+eval {
+    my $foo = new Foo;
+    die "oops";
+};
+if ($@ =~ /oops/) {
+    print "ok 4\n";
+} else {
+    print "not ok 4 $@\n";
+}
+
+# Pass regular expression variable to autoloaded function.  This used
+# to go wrong in AutoLoader because it used regular expressions to generate
+# autoloaded filename.
+"foo" =~ /(\w+)/;
+print "not " unless $1 eq 'foo';
+print "ok 5\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 6\n";
+
+print "not " unless $foo->bar($1) eq 'foo';
+print "ok 7\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 8\n";
+
+print "not " unless $foo->bazmarkhianish($1) eq 'foo';
+print "ok 9\n";
+
+# Check nested packages inside __DATA__
+print "not " unless sheep::bleat()  eq 'baa';
+print "ok 10\n";
+
+# Now check inheritance:
+
+$bar = new Bar;
+
+# Before anything is SelfLoaded there is no declaration of Foo::b so we should
+# get Baz::b
+print "not " unless $bar->b() eq 'b Baz';
+print "ok 11\n";
+
+# There is no Bar::c so we should get Baz::c
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 12\n";
+
+# This selfloads Bar::a because it is stubbed. It also stubs Bar::b as a side
+# effect
+print "not " unless $bar->a() eq 'a Bar';
+print "ok 13\n";
+
+print "not " unless $bar->b() eq 'b Bar';
+print "ok 14\n";
+
+print "not " unless $bar->c() eq 'c Baz';
+print "ok 15\n";
+
+
+
+# Check that __END__ is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $foo->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 16\n";
+} else {
+    print "not ok 16 $@\n";
+}
+
+# Try to read from the data file handle
+my $foodata = <Foo::DATA>;
+close Foo::DATA;
+if (defined $foodata) {
+    print "not ok 17 # $foodata\n";
+} else {
+    print "ok 17\n";
+}
+
+# Check that __END__ DATA is honoured
+# Try an subroutine that should never be noticed by selfloader
+eval {
+    $bar->never;
+};
+if ($@ =~ /^Undefined subroutine/) {
+    print "ok 18\n";
+} else {
+    print "not ok 18 $@\n";
+}
+
+# Try to read from the data file handle
+my $bardata = <Bar::DATA>;
+close Bar::DATA;
+if ($bardata ne "sub never { die \"D'oh\" }\n") {
+    print "not ok 19 # $bardata\n";
+} else {
+    print "ok 19\n";
+}
+
+# cleanup
+END {
+return unless $dir && -d $dir;
+unlink "$dir/Foo.pm", "$dir/Bar.pm";
+rmdir "$dir";
+}
diff --git a/gnu/usr.bin/perl/t/lib/tie-refhash.t b/gnu/usr.bin/perl/t/lib/tie-refhash.t
new file mode 100644
index 00000000000..d80b2e10fc9
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-refhash.t
@@ -0,0 +1,305 @@
+#!/usr/bin/perl -w
+# 
+# Basic test suite for Tie::RefHash and Tie::RefHash::Nestable.
+# 
+# The testing is in two parts: first, run lots of tests on both a tied
+# hash and an ordinary un-tied hash, and check they give the same
+# answer.  Then there are tests for those cases where the tied hashes
+# should behave differently to normal hashes, that is, when using
+# references as keys.
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+use strict;
+use Tie::RefHash;
+use Data::Dumper;
+my $numtests = 34;
+my $currtest = 1;
+print "1..$numtests\n";
+
+my $ref = []; my $ref1 = [];
+
+# Test standard hash functionality, by performing the same operations
+# on a tied hash and on a normal hash, and checking that the results
+# are the same.  This does of course assume that Perl hashes are not
+# buggy :-)
+# 
+my @tests = standard_hash_tests();
+
+my @ordinary_results = runtests(\@tests, undef);
+foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
+    my @tied_results = runtests(\@tests, $class);
+    my $all_ok = 1;
+
+    die if @ordinary_results != @tied_results;
+    foreach my $i (0 .. $#ordinary_results) {
+        my ($or, $ow, $oe) = @{$ordinary_results[$i]};
+        my ($tr, $tw, $te) = @{$tied_results[$i]};
+        
+        my $ok = 1;
+        local $^W = 0;
+        $ok = 0 if (defined($or) != defined($tr)) or ($or ne $tr);
+        $ok = 0 if (defined($ow) != defined($tw)) or ($ow ne $tw);
+        $ok = 0 if (defined($oe) != defined($te)) or ($oe ne $te);
+        
+        if (not $ok) {
+            print STDERR
+              "failed for $class: $tests[$i]\n",
+              "ordinary hash gave:\n",
+              defined $or ? "\tresult:    $or\n" : "\tundef result\n",
+              defined $ow ? "\twarning:   $ow\n" : "\tno warning\n",
+              defined $oe ? "\texception: $oe\n" : "\tno exception\n",
+              "tied $class hash gave:\n",
+              defined $tr ? "\tresult:    $tr\n" : "\tundef result\n",
+              defined $tw ? "\twarning:   $tw\n" : "\tno warning\n",
+              defined $te ? "\texception: $te\n" : "\tno exception\n",
+              "\n";
+            $all_ok = 0;
+        }
+    }
+    test($all_ok);
+}
+
+# Now test Tie::RefHash's special powers
+my (%h, $h);
+$h = eval { tie %h, 'Tie::RefHash' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash/);
+$h{$ref} = 'cholet';
+test($h{$ref} eq 'cholet');
+test(exists $h{$ref});
+test((keys %h) == 1);
+test(ref((keys %h)[0]) eq 'ARRAY');
+test((keys %h)[0] eq $ref);
+test((values %h) == 1);
+test((values %h)[0] eq 'cholet');
+my $count = 0;
+while (my ($k, $v) = each %h) {
+    if ($count++ == 0) {
+        test(ref($k) eq 'ARRAY');
+        test($k eq $ref);
+    }
+}
+test($count == 1);
+delete $h{$ref};
+test(not defined $h{$ref});
+test(not exists($h{$ref}));
+test((keys %h) == 0);
+test((values %h) == 0);
+undef $h;
+untie %h;
+
+# And now Tie::RefHash::Nestable's differences from Tie::RefHash.
+$h = eval { tie %h, 'Tie::RefHash::Nestable' };
+warn $@ if $@;
+test(not $@);
+test(ref($h) eq 'Tie::RefHash::Nestable');
+test(defined(tied(%h)) and tied(%h) =~ /^Tie::RefHash::Nestable/);
+$h{$ref}->{$ref1} = 'bungo';
+test($h{$ref}->{$ref1} eq 'bungo');
+
+# Test that the nested hash is also tied (for current implementation)
+test(defined(tied(%{$h{$ref}}))
+     and tied(%{$h{$ref}}) =~ /^Tie::RefHash::Nestable=/ );
+
+test((keys %h) == 1);
+test((keys %h)[0] eq $ref);
+test((keys %{$h{$ref}}) == 1);
+test((keys %{$h{$ref}})[0] eq $ref1);
+
+
+die "expected to run $numtests tests, but ran ", $currtest - 1
+  if $currtest - 1 != $numtests;
+
+@tests = ();
+undef $ref;
+undef $ref1;
+
+exit();
+
+
+# Print 'ok X' if true, 'not ok X' if false
+# Uses global $currtest.
+# 
+sub test {
+    my $t = shift;
+    print 'not ' if not $t;
+    print 'ok ', $currtest++, "\n";
+}
+
+
+# Wrapper for Data::Dumper to 'dump' a scalar as an EXPR string. 
+sub dumped {
+    my $s = shift;
+    my $d = Dumper($s);
+    $d =~ s/^\$VAR1 =\s*//;
+    $d =~ s/;$//;
+    chomp $d;
+    return $d;
+}
+
+# Crudely dump a hash into a canonical string representation (because
+# hash keys can appear in any order, Data::Dumper may give different
+# strings for the same hash).
+# 
+sub dumph {
+    my $h = shift;
+    my $r = '';
+    foreach (sort keys %$h) {
+        $r = dumped($_) . ' => ' . dumped($h->{$_}) . "\n";
+    }
+    return $r;
+}
+
+# Run the tests and give results.
+# 
+# Parameters: reference to list of tests to run
+#             name of class to use for tied hash, or undef if not tied
+# 
+# Returns: list of [R, W, E] tuples, one for each test.
+# R is the return value from running the test, W any warnings it gave,
+# and E any exception raised with 'die'.  E and W will be tidied up a
+# little to remove irrelevant details like line numbers :-)
+# 
+# Will also run a few of its own 'ok N' tests.
+# 
+sub runtests {
+    my ($tests, $class) = @_;
+    my @r;
+
+    my (%h, $h);
+    if (defined $class) {
+        $h = eval { tie %h, $class };
+        warn $@ if $@;
+        test(not $@);
+        test(ref($h) eq $class);
+        test(defined(tied(%h)) and tied(%h) =~ /^\Q$class\E/);
+    }
+
+    foreach (@$tests) {
+        my ($result, $warning, $exception);
+        local $SIG{__WARN__} = sub { $warning .= $_[0] };
+        $result = scalar(eval $_);
+        if ($@)
+         {
+          die "$@:$_" unless defined $class;
+          $exception = $@;
+         }
+
+        foreach ($warning, $exception) {
+            next if not defined;
+            s/ at .+ line \d+\.$//mg;
+            s/ at .+ line \d+, at .*//mg;
+            s/ at .+ line \d+, near .*//mg;
+        }
+
+        my (@warnings, %seen);
+        foreach (split /\n/, $warning) {
+            push @warnings, $_ unless $seen{$_}++;
+        }
+        $warning = join("\n", @warnings);
+
+        push @r, [ $result, $warning, $exception ];
+    }
+
+    return @r;
+}
+
+
+# Things that should work just the same for an ordinary hash and a
+# Tie::RefHash.
+# 
+# Each test is a code string to be eval'd, it should do something with
+# %h and give a scalar return value.  The global $ref and $ref1 may
+# also be used.
+# 
+# One thing we don't test is that the ordering from 'keys', 'values'
+# and 'each' is the same.  You can't reasonably expect that.
+# 
+sub standard_hash_tests {
+    my @r;
+
+    # Library of standard tests on keys, values and each
+    my $STD_TESTS = <<'END'
+    join $;, sort keys %h;
+    join $;, sort values %h;
+    { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
+    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
+END
+  ;
+    
+    # Tests on the existence of the element 'foo'
+    my $FOO_TESTS = <<'END'
+    defined $h{foo};
+    exists $h{foo};
+    $h{foo};    
+END
+  ;
+
+    # Test storing and deleting 'foo'
+    push @r, split /\n/, <<"END"
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = undef;
+    $STD_TESTS;
+    $FOO_TESTS;
+    \$h{foo} = 'hello';
+    $STD_TESTS;
+    $FOO_TESTS;
+    delete  \$h{foo};
+    $STD_TESTS;
+    $FOO_TESTS;
+END
+  ;
+
+    # Test storing and removing under ordinary keys
+    my @things = ('boink', 0, 1, '', undef);
+    foreach my $key (map { dumped($_) } @things) {
+        foreach my $value ((map { dumped($_) } @things), '$ref') {
+            push @r, split /\n/, <<"END"
+            \$h{$key} = $value;
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+            delete \$h{$key};
+            $STD_TESTS;
+            defined \$h{$key};
+            exists \$h{$key};
+            \$h{$key};
+END
+  ;
+        }
+    }
+    
+    # Test hash slices
+    my @slicetests;
+    @slicetests = split /\n/, <<'END'
+    @h{'b'} = ();
+    @h{'c'} = ('d');
+    @h{'e'} = ('f', 'g');
+    @h{'h', 'i'} = ();
+    @h{'j', 'k'} = ('l');
+    @h{'m', 'n'} = ('o', 'p');
+    @h{'q', 'r'} = ('s', 't', 'u');
+END
+  ;
+    my @aaa = @slicetests;
+    foreach (@slicetests) {
+        push @r, $_;
+        push @r, split(/\n/, $STD_TESTS);
+    }
+
+    # Test CLEAR
+    push @r, '%h = ();', split(/\n/, $STD_TESTS);
+
+    return @r;
+}
+
diff --git a/gnu/usr.bin/perl/t/lib/tie-splice.t b/gnu/usr.bin/perl/t/lib/tie-splice.t
new file mode 100644
index 00000000000..d7ea6cc1dcc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-splice.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}
+
+# bug id 20001020.002
+# -dlc 20001021
+
+use Tie::Array;
+tie @a,Tie::StdArray;
+undef *Tie::StdArray::SPLICE;
+require "op/splice.t"
+
+# Pre-fix, this failed tests 6-9
diff --git a/gnu/usr.bin/perl/t/lib/tie-substrhash.t b/gnu/usr.bin/perl/t/lib/tie-substrhash.t
new file mode 100644
index 00000000000..8256db7b58a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-substrhash.t
@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+# 
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '.'; 
+    push @INC, '../lib';
+}    
+
+print "1..20\n";
+
+use strict;
+
+require Tie::SubstrHash;
+
+my %a;
+
+tie %a, 'Tie::SubstrHash', 3, 3, 3;
+
+$a{abc} = 123;
+$a{bcd} = 234;
+
+print "not " unless $a{abc} == 123;
+print "ok 1\n";
+
+print "not " unless keys %a == 2;
+print "ok 2\n";
+
+delete $a{abc};
+
+print "not " unless $a{bcd} == 234;
+print "ok 3\n";
+
+print "not " unless (values %a)[0] == 234;
+print "ok 4\n";
+
+eval { $a{abcd} = 123 };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 5\n";
+
+eval { $a{abc} = 1234 };
+print "not " unless $@ =~ /Value "1234" is not 3 characters long/;
+print "ok 6\n";
+
+eval { $a = $a{abcd}; $a++  };
+print "not " unless $@ =~ /Key "abcd" is not 3 characters long/;
+print "ok 7\n";
+
+@a{qw(abc cde)} = qw(123 345); 
+
+print "not " unless $a{cde} == 345;
+print "ok 8\n";
+
+eval { $a{def} = 456 };
+print "not " unless $@ =~ /Table is full \(3 elements\)/;
+print "ok 9\n";
+
+%a = ();
+
+print "not " unless keys %a == 0;
+print "ok 10\n";
+
+# Tests 11..16 by Linc Madison.
+
+my $hashsize = 119;                # arbitrary values from my data
+my %test;
+tie %test, "Tie::SubstrHash", 13, 86, $hashsize;
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;           # fix to uniform 6-digit numbers
+        my $key2 = "abcdefg$key1";
+        $test{$key2} = ("abcdefgh" x 10) . "$key1";
+}
+
+for (my $i = 1; $i <= $hashsize; $i++) {
+        my $key1 = $i + 100_000;
+        my $key2 = "abcdefg$key1";
+	unless ($test{$key2}) {
+		print "not ";
+		last;
+	}
+}
+print "ok 11\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1) == 2;
+print "ok 12\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(2) == 2;
+print "ok 13\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(5.5) == 7;
+print "ok 14\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13) == 13;
+print "ok 15\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(13.000001) == 17;
+print "ok 16\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(114) == 127;
+print "ok 17\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1000) == 1009;
+print "ok 18\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(1024) == 1031;
+print "ok 19\n";
+
+print "not " unless Tie::SubstrHash::findgteprime(10000) == 10007;
+print "ok 20\n";
+
diff --git a/gnu/usr.bin/perl/t/op/64bitint.t b/gnu/usr.bin/perl/t/op/64bitint.t
index 60f72c3536e..88fbc55c671 100644
--- a/gnu/usr.bin/perl/t/op/64bitint.t
+++ b/gnu/usr.bin/perl/t/op/64bitint.t
@@ -3,20 +3,20 @@
 BEGIN {
 	eval { my $q = pack "q", 0 };
 	if ($@) {
-		print "1..0\n# no 64-bit types\n";
+		print "1..0\n# Skip: no 64-bit types\n";
 		exit(0);
 	}
 	chdir 't' if -d 't';
-	unshift @INC, '../lib';
+	@INC = '../lib';
 }
 
-# This could use a lot of more tests.
+# This could use many more tests.
 
 # so that using > 0xfffffff constants and
 # 32+ bit integers don't cause noise
 no warnings qw(overflow portable);
 
-print "1..48\n";
+print "1..55\n";
 
 my $q = 12345678901;
 my $r = 23456789012;
@@ -123,85 +123,106 @@ $x = $q - $r;
 print "not " unless $x == -11111110111 && -$x > $f;
 print "ok 22\n";
 
-$x = $q * 1234567;
-print "not " unless $x == 15241567763770867 && $x > $f;
-print "ok 23\n";
-
-$x /= 1234567;
-print "not " unless $x == $q && $x > $f;
-print "ok 24\n";
-
-$x = 98765432109 % 12345678901;
-print "not " unless $x == 901;
-print "ok 25\n";
-
-# The following 12 tests adapted from op/inc.
-
-$a = 9223372036854775807;
-$c = $a++;
-print "not " unless $a == 9223372036854775808;
-print "ok 26\n";
-
-$a = 9223372036854775807;
-$c = ++$a;
-print "not " unless $a == 9223372036854775808 && $c == $a;
-print "ok 27\n";
-
-$a = 9223372036854775807;
-$c = $a + 1;
-print "not " unless $a == 9223372036854775807 && $c == 9223372036854775808;
-print "ok 28\n";
-
-$a = -9223372036854775808;
-$c = $a--;
-print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808;
-print "ok 29\n";
-
-$a = -9223372036854775808;
-$c = --$a;
-print "not " unless $a == -9223372036854775809 && $c == $a;
-print "ok 30\n";
-
-$a = -9223372036854775808;
-$c = $a - 1;
-print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809;
-print "ok 31\n";
-
-$a = 9223372036854775808;
-$a = -$a;
-$c = $a--;
-print "not " unless $a == -9223372036854775809 && $c == -9223372036854775808;
-print "ok 32\n";
-
-$a = 9223372036854775808;
-$a = -$a;
-$c = --$a;
-print "not " unless $a == -9223372036854775809 && $c == $a;
-print "ok 33\n";
-
-$a = 9223372036854775808;
-$a = -$a;
-$c = $a - 1;
-print "not " unless $a == -9223372036854775808 && $c == -9223372036854775809;
-print "ok 34\n";
-
-$a = 9223372036854775808;
-$b = -$a;
-$c = $b--;
-print "not " unless $b == -$a-1 && $c == -$a;
-print "ok 35\n";
-
-$a = 9223372036854775808;
-$b = -$a;
-$c = --$b;
-print "not " unless $b == -$a-1 && $c == $b;
-print "ok 36\n";
-
-$a = 9223372036854775808;
-$b = -$a;
-$b = $b - 1;
-print "not " unless $b == -(++$a);
-print "ok 37\n";
+if ($^O ne 'unicos') {
+    $x = $q * 1234567;
+    print "not " unless $x == 15241567763770867 && $x > $f;
+    print "ok 23\n";
+
+    $x /= 1234567;
+    print "not " unless $x == $q && $x > $f;
+    print "ok 24\n";
+
+    $x = 98765432109 % 12345678901;
+    print "not " unless $x == 901;
+    print "ok 25\n";
+    
+    # The following 12 tests adapted from op/inc.
+
+    $a = 9223372036854775807;
+    $c = $a++;
+    print "not " unless $a == 9223372036854775808;
+    print "ok 26\n";
+
+    $a = 9223372036854775807;
+    $c = ++$a;
+    print "not "
+	unless $a == 9223372036854775808 && $c == $a;
+    print "ok 27\n";
+
+    $a = 9223372036854775807;
+    $c = $a + 1;
+    print "not "
+	unless $a == 9223372036854775807 && $c == 9223372036854775808;
+    print "ok 28\n";
+
+    $a = -9223372036854775808;
+    $c = $a--;
+    print "not "
+	unless $a == -9223372036854775809 && $c == -9223372036854775808;
+    print "ok 29\n";
+
+    $a = -9223372036854775808;
+    $c = --$a;
+    print "not "
+	unless $a == -9223372036854775809 && $c == $a;
+    print "ok 30\n";
+
+    $a = -9223372036854775808;
+    $c = $a - 1;
+    print "not "
+	unless $a == -9223372036854775808 && $c == -9223372036854775809;
+    print "ok 31\n";
+    
+    $a = 9223372036854775808;
+    $a = -$a;
+    $c = $a--;
+    print "not "
+	unless $a == -9223372036854775809 && $c == -9223372036854775808;
+    print "ok 32\n";
+    
+    $a = 9223372036854775808;
+    $a = -$a;
+    $c = --$a;
+    print "not "
+	unless $a == -9223372036854775809 && $c == $a;
+    print "ok 33\n";
+    
+    $a = 9223372036854775808;
+    $a = -$a;
+    $c = $a - 1;
+    print "not "
+	unless $a == -9223372036854775808 && $c == -9223372036854775809;
+    print "ok 34\n";
+
+    $a = 9223372036854775808;
+    $b = -$a;
+    $c = $b--;
+    print "not "
+	unless $b == -$a-1 && $c == -$a;
+    print "ok 35\n";
+
+    $a = 9223372036854775808;
+    $b = -$a;
+    $c = --$b;
+    print "not "
+	unless $b == -$a-1 && $c == $b;
+    print "ok 36\n";
+
+    $a = 9223372036854775808;
+    $b = -$a;
+    $b = $b - 1;
+    print "not "
+	unless $b == -(++$a);
+    print "ok 37\n";
+
+} else {
+    # Unicos has imprecise doubles (14 decimal digits or so),
+    # especially if operating near the UV/IV limits the low-order bits
+    # become mangled even by simple arithmetic operations.
+    for (23..37) {
+	print "ok $_ # skipped: too imprecise numbers\n";
+    }
+}
 
 
 $x = '';
@@ -233,10 +254,44 @@ print "ok 45\n";
 print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001;
 print "ok 46\n";
 
-print "not " unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000;
+print "not "
+    unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000;
 print "ok 47\n";
 
-print "not " unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0;
+print "not "
+    unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0;
 print "ok 48\n";
 
+
+print "not "
+    unless (sprintf "%b", ~0)   eq
+           '1111111111111111111111111111111111111111111111111111111111111111';
+print "ok 49\n";
+
+print "not "
+    unless (sprintf "%64b", ~0) eq
+           '1111111111111111111111111111111111111111111111111111111111111111';
+print "ok 50\n";
+
+print "not " unless (sprintf "%d", ~0>>1) eq '9223372036854775807';
+print "ok 51\n";
+
+print "not " unless (sprintf "%u", ~0)    eq '18446744073709551615';
+print "ok 52\n";
+
+# If the 53..55 fail you have problems in the parser's string->int conversion,
+# see toke.c:scan_num().
+
+$q = -9223372036854775808;
+print "# $q ne\n# -9223372036854775808\nnot " unless "$q" eq "-9223372036854775808";
+print "ok 53\n";
+
+$q =  9223372036854775807;
+print "# $q ne\n# 9223372036854775807\nnot " unless "$q" eq "9223372036854775807";
+print "ok 54\n";
+
+$q = 18446744073709551615;
+print "# $q ne\n# 18446744073709551615\nnot " unless "$q" eq "18446744073709551615";
+print "ok 55\n";
+
 # eof
diff --git a/gnu/usr.bin/perl/t/op/anonsub.t b/gnu/usr.bin/perl/t/op/anonsub.t
new file mode 100644
index 00000000000..17889d9d2f9
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/anonsub.t
@@ -0,0 +1,93 @@
+#!./perl
+
+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 = "asubtmp000";
+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 2>&1` :
+		      $Is_MSWin32 ?  
+			  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+			      `./perl $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/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__
+sub X {
+    my $n = "ok 1\n";
+    sub { print $n };
+}
+my $x = X();
+undef &X;
+$x->();
+EXPECT
+ok 1
+########
+sub X {
+    my $n = "ok 1\n";
+    sub {
+        my $dummy = $n;	# eval can't close on $n without internal reference
+	eval 'print $n';
+	die $@ if $@;
+    };
+}
+my $x = X();
+undef &X;
+$x->();
+EXPECT
+ok 1
+########
+sub X {
+    my $n = "ok 1\n";
+    eval 'sub { print $n }';
+}
+my $x = X();
+die $@ if $@;
+undef &X;
+$x->();
+EXPECT
+ok 1
+########
+sub X;
+sub X {
+    my $n = "ok 1\n";
+    eval 'sub Y { my $p = shift; $p->() }';
+    die $@ if $@;
+    Y(sub { print $n });
+}
+X();
+EXPECT
+ok 1
diff --git a/gnu/usr.bin/perl/t/op/args.t b/gnu/usr.bin/perl/t/op/args.t
index 48bf5afec09..ce2c3988656 100644
--- a/gnu/usr.bin/perl/t/op/args.t
+++ b/gnu/usr.bin/perl/t/op/args.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..8\n";
+print "1..9\n";
 
 # test various operations on @_
 
@@ -52,3 +52,24 @@ sub new4 { goto &new2 }
     print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y";
     print "ok $ord\n";
 }
+
+# see if POPSUB gets to see the right pad across a dounwind() with
+# a reified @_
+
+sub methimpl {
+    my $refarg = \@_;
+    die( "got: @_\n" );
+}
+
+sub method {
+    &methimpl;
+}
+
+sub try {
+    eval { method('foo', 'bar'); };
+    print "# $@" if $@;
+}
+
+for (1..5) { try() }
+++$ord;
+print "ok $ord\n";
diff --git a/gnu/usr.bin/perl/t/op/attrs.t b/gnu/usr.bin/perl/t/op/attrs.t
index 615e4d33430..27020048816 100644
--- a/gnu/usr.bin/perl/t/op/attrs.t
+++ b/gnu/usr.bin/perl/t/op/attrs.t
@@ -4,7 +4,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 sub NTESTS () ;
diff --git a/gnu/usr.bin/perl/t/op/avhv.t b/gnu/usr.bin/perl/t/op/avhv.t
index cd7c957619d..5b91fd21474 100644
--- a/gnu/usr.bin/perl/t/op/avhv.t
+++ b/gnu/usr.bin/perl/t/op/avhv.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 require Tie::Array;
diff --git a/gnu/usr.bin/perl/t/op/concat.t b/gnu/usr.bin/perl/t/op/concat.t
new file mode 100644
index 00000000000..76074e0f28f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/concat.t
@@ -0,0 +1,100 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..11\n";
+
+($a, $b, $c) = qw(foo bar);
+
+print "not " unless "$a" eq "foo";
+print "ok 1\n";
+
+print "not " unless "$a$b" eq "foobar";
+print "ok 2\n";
+
+print "not " unless "$c$a$c" eq "foo";
+print "ok 3\n";
+
+# Okay, so that wasn't very challenging.  Let's go Unicode.
+
+my $test = 4;
+
+{
+    # bug id 20000819.004 
+
+    $_ = $dx = "\x{10f2}";
+    s/($dx)/$dx$1/;
+    {
+	use bytes;
+	print "not " unless $_ eq "$dx$dx";
+	print "ok $test\n";
+	$test++;
+    }
+
+    $_ = $dx = "\x{10f2}";
+    s/($dx)/$1$dx/;
+    {
+	use bytes;
+	print "not " unless $_ eq "$dx$dx";
+	print "ok $test\n";
+	$test++;
+    }
+
+    $dx = "\x{10f2}";
+    $_  = "\x{10f2}\x{10f2}";
+    s/($dx)($dx)/$1$2/;
+    {
+	use bytes;
+	print "not " unless $_ eq "$dx$dx";
+	print "ok $test\n";
+	$test++;
+    }
+}
+
+{
+    # bug id 20000901.092
+    # test that undef left and right of utf8 results in a valid string
+
+    my $a;
+    $a .= "\x{1ff}";
+    print "not " unless $a eq "\x{1ff}";
+    print "ok $test\n";
+    $test++;
+}
+
+{
+    # ID 20001020.006
+
+    "x" =~ /(.)/; # unset $2
+
+    # Without the fix this 5.7.0 would croak:
+    # Modification of a read-only value attempted at ...
+    "$2\x{1234}";
+
+    print "ok $test\n";
+    $test++;
+
+    # For symmetry with the above.
+    "\x{1234}$2";
+
+    print "ok $test\n";
+    $test++;
+
+    *pi = \undef;
+    # This bug existed earlier than the $2 bug, but is fixed with the same
+    # patch. Without the fix this 5.7.0 would also croak:
+    # Modification of a read-only value attempted at ...
+    "$pi\x{1234}";
+
+    print "ok $test\n";
+    $test++;
+
+    # For symmetry with the above.
+    "\x{1234}$pi";
+
+    print "ok $test\n";
+    $test++;
+}
diff --git a/gnu/usr.bin/perl/t/op/defins.t b/gnu/usr.bin/perl/t/op/defins.t
index 9e714a718bc..33c74ea28e8 100644
--- a/gnu/usr.bin/perl/t/op/defins.t
+++ b/gnu/usr.bin/perl/t/op/defins.t
@@ -6,7 +6,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
     print "1..14\n";
 }
diff --git a/gnu/usr.bin/perl/t/op/die_exit.t b/gnu/usr.bin/perl/t/op/die_exit.t
index cb0478b9b2e..a389946fe37 100644
--- a/gnu/usr.bin/perl/t/op/die_exit.t
+++ b/gnu/usr.bin/perl/t/op/die_exit.t
@@ -7,7 +7,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib' if -e '../lib';
+    @INC = '../lib';
 }
 
 if ($^O eq 'mpeix') {
diff --git a/gnu/usr.bin/perl/t/op/exists_sub.t b/gnu/usr.bin/perl/t/op/exists_sub.t
index 3363dfd837a..d4aa29251ad 100644
--- a/gnu/usr.bin/perl/t/op/exists_sub.t
+++ b/gnu/usr.bin/perl/t/op/exists_sub.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 print "1..9\n";
diff --git a/gnu/usr.bin/perl/t/op/filetest.t b/gnu/usr.bin/perl/t/op/filetest.t
index e00d5fb7b06..f757c79c05f 100644
--- a/gnu/usr.bin/perl/t/op/filetest.t
+++ b/gnu/usr.bin/perl/t/op/filetest.t
@@ -5,7 +5,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib' if -d '../lib';
+    @INC = '../lib';
 }
 
 use Config;
diff --git a/gnu/usr.bin/perl/t/op/grent.t b/gnu/usr.bin/perl/t/op/grent.t
index 761d8b9cf60..211dc911bba 100644
--- a/gnu/usr.bin/perl/t/op/grent.t
+++ b/gnu/usr.bin/perl/t/op/grent.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, "../lib" if -d "../lib";
+    @INC = '../lib';
     eval {my @n = getgrgid 0};
     if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
 	print "1..0 # Skip: $1\n";
@@ -54,9 +54,9 @@ BEGIN {
     }
 }
 
-# By now GR filehandle should be open and full of juicy group entries.
+# By now the GR filehandle should be open and full of juicy group entries.
 
-print "1..1\n";
+print "1..2\n";
 
 # Go through at most this many groups.
 # (note that the first entry has been read away by now)
@@ -67,9 +67,11 @@ my $tst = 1;
 my %perfect;
 my %seen;
 
+setgrent();
 while (<GR>) {
     chomp;
-    my @s = split /:/;
+    # LIMIT -1 so that groups with no users don't fall off
+    my @s = split /:/, $_, -1;
     my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
     if (@s) {
 	push @{ $seen{$name_s} }, $.;
@@ -111,6 +113,8 @@ while (<GR>) {
     $n++;
 }
 
+endgrent();
+
 if (keys %perfect == 0) {
     $max++;
     print <<EOEX;
@@ -136,4 +140,29 @@ print "ok ", $tst++;
 print "\t# (not necessarily serious: run t/op/grent.t by itself)" if $not;
 print "\n";
 
+# Test both the scalar and list contexts.
+
+my @gr1;
+
+setgrent();
+for (1..$max) {
+    my $gr = scalar getgrent();
+    last unless defined $gr;
+    push @gr1, $gr;
+}
+endgrent();
+
+my @gr2;
+
+setgrent();
+for (1..$max) {
+    my ($gr) = (getgrent());
+    last unless defined $gr;
+    push @gr2, $gr;
+}
+endgrent();
+
+print "not " unless "@gr1" eq "@gr2";
+print "ok ", $tst++, "\n";
+
 close(GR);
diff --git a/gnu/usr.bin/perl/t/op/hashwarn.t b/gnu/usr.bin/perl/t/op/hashwarn.t
index 9182273ec3c..8466a7196e5 100644
--- a/gnu/usr.bin/perl/t/op/hashwarn.t
+++ b/gnu/usr.bin/perl/t/op/hashwarn.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 use strict;
diff --git a/gnu/usr.bin/perl/t/op/length.t b/gnu/usr.bin/perl/t/op/length.t
new file mode 100644
index 00000000000..ceb005ecc4a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/length.t
@@ -0,0 +1,85 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..13\n";
+
+print "not " unless length("")    == 0;
+print "ok 1\n";
+
+print "not " unless length("abc") == 3;
+print "ok 2\n";
+
+$_ = "foobar";
+print "not " unless length()      == 6;
+print "ok 3\n";
+
+# Okay, so that wasn't very challenging.  Let's go Unicode.
+
+{
+    my $a = "\x{41}";
+
+    print "not " unless length($a) == 1;
+    print "ok 4\n";
+    $test++;
+
+    use bytes;
+    print "not " unless $a eq "\x41" && length($a) == 1;
+    print "ok 5\n";
+    $test++;
+}
+
+{
+    my $a = "\x{80}";
+    
+    print "not " unless length($a) == 1;
+    print "ok 6\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc2\x80" && length($a) == 2;
+    print "ok 7\n";
+    $test++;
+}
+
+{
+    my $a = "\x{100}";
+    
+    print "not " unless length($a) == 1;
+    print "ok 8\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc4\x80" && length($a) == 2;
+    print "ok 9\n";
+    $test++;
+}
+
+{
+    my $a = "\x{100}\x{80}";
+    
+    print "not " unless length($a) == 2;
+    print "ok 10\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc4\x80\xc2\x80" && length($a) == 4;
+    print "ok 11\n";
+    $test++;
+}
+
+{
+    my $a = "\x{80}\x{100}";
+    
+    print "not " unless length($a) == 2;
+    print "ok 12\n";
+    $test++;
+    
+    use bytes;
+    print "not " unless $a eq "\xc2\x80\xc4\x80" && length($a) == 4;
+    print "ok 13\n";
+    $test++;
+}
diff --git a/gnu/usr.bin/perl/t/op/lex_assign.t b/gnu/usr.bin/perl/t/op/lex_assign.t
index 2fb059d8d87..d761f73ce7c 100644
--- a/gnu/usr.bin/perl/t/op/lex_assign.t
+++ b/gnu/usr.bin/perl/t/op/lex_assign.t
@@ -2,9 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
-$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; 
 
 umask 0;
 $xref = \ "";
@@ -112,11 +111,12 @@ for (@INPUT) {
   $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
+  chomp;
   $op = "$op==$op" unless $op =~ /==/;
   ($op, $expectop) = $op =~ /(.*)==(.*)/;
   
   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
-	  ? "skip" : "not";
+	  ? "skip" : "# '$_'\nnot";
   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
   (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
   
@@ -137,7 +137,7 @@ EOE
       print "# skipping $comment: unimplemented:\nok $ord\n";
     } else {
       warn $@;
-      print "not ok $ord\n";
+      print "# '$_'\nnot ok $ord\n";
     }
   }
 }
@@ -146,6 +146,7 @@ for (@simple_input) {
   $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
+  chomp;
   ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
   eval <<EOE;
   local \$SIG{__WARN__} = \\&wrn;
@@ -164,14 +165,14 @@ EOE
       print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
     } else {
       warn $@;
-      print "not ok $ord\n";
+      print "# '$_'\nnot ok $ord\n";
     }
   }
 }
 __END__
 ref $xref			# ref
 ref $cstr			# ref nonref
-`$runme -e "print qq[1\n]"`				# backtick skip(MSWin32)
+`$runme -e "print qq[1\\n]"`				# backtick skip(MSWin32)
 `$undefed`			# backtick undef skip(MSWin32)
 <*>				# glob
 <OP>				# readline
@@ -242,7 +243,7 @@ lc $cstr			# lc
 quotemeta $cstr			# quotemeta
 @$aref				# rv2av
 @$undefed			# rv2av undef
-each %h==1			# each
+(each %h) % 2 == 1		# each
 values %h			# values
 keys %h				# keys
 %$href				# rv2hv
@@ -307,7 +308,7 @@ getpriority $$, $$		# getpriority
 time				# time
 localtime $^T			# localtime
 gmtime $^T			# gmtime
-sleep 1				# sleep
+'???'				# sleep: can randomly fail
 '???'				# alarm
 '???'				# shmget
 '???'				# shmctl
diff --git a/gnu/usr.bin/perl/t/op/lfs.t b/gnu/usr.bin/perl/t/op/lfs.t
index e704f6f57b6..0a1c3998401 100644
--- a/gnu/usr.bin/perl/t/op/lfs.t
+++ b/gnu/usr.bin/perl/t/op/lfs.t
@@ -4,15 +4,20 @@
 
 BEGIN {
 	chdir 't' if -d 't';
-	unshift @INC, '../lib';
+	@INC = '../lib';
 	# Don't bother if there are no quad offsets.
 	require Config; import Config;
 	if ($Config{lseeksize} < 8) {
-		print "1..0\n# no 64-bit file offsets\n";
+		print "1..0 # Skip: no 64-bit file offsets\n";
 		exit(0);
 	}
 }
 
+use strict;
+
+our @s;
+our $fail;
+
 sub zap {
     close(BIG);
     unlink("big");
@@ -25,35 +30,42 @@ sub bye {
     exit(0);
 }
 
+my $explained;
+
 sub explain {
-    print <<EOM;
+    unless ($explained++) {
+	print <<EOM;
 #
-# If the lfs (large file support: large meaning larger than two gigabytes)
-# tests are skipped or fail, it may mean either that your process
-# (or process group) is not allowed to write large files (resource
-# limits) or that the file system you are running the tests on doesn't
-# let your user/group have large files (quota) or the filesystem simply
-# doesn't support large files.  You may even need to reconfigure your kernel.
-# (This is all very operating system and site-dependent.)
+# If the lfs (large file support: large meaning larger than two
+# gigabytes) tests are skipped or fail, it may mean either that your
+# process (or process group) is not allowed to write large files
+# (resource limits) or that the file system (the network filesystem?)
+# you are running the tests on doesn't let your user/group have large
+# files (quota) or the filesystem simply doesn't support large files.
+# You may even need to reconfigure your kernel.  (This is all very
+# operating system and site-dependent.)
 #
 # Perl may still be able to support large files, once you have
 # such a process, enough quota, and such a (file) system.
+# It is just that the test failed now.
 #
 EOM
+    }
+    print "1..0 # Skip: @_\n" if @_;
 }
 
 print "# checking whether we have sparse files...\n";
 
 # Known have-nots.
-if ($^O eq 'win32' || $^O eq 'vms') {
-    print "1..0\n# no sparse files (because this is $^O) \n";
+if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+    print "1..0 # Skip: no sparse files in $^O\n";
     bye();
 }
 
 # Known haves that have problems running this test
 # (for example because they do not support sparse files, like UNICOS)
 if ($^O eq 'unicos') {
-    print "1..0\n# large files known to work but unable to test them here ($^O)\n";
+    print "1..0 # Skip: no sparse files in $^0, unable to test large files\n";
     bye();
 }
 
@@ -102,7 +114,7 @@ zap();
 
 unless ($s1[7] == 1_000_003 && $s2[7] == 2_000_003 &&
 	$s1[11] == $s2[11] && $s1[12] == $s2[12]) {
-	print "1..0\n#no sparse files?\n";
+	print "1..0 # Skip: no sparse files?\n";
 	bye;
 }
 
@@ -110,14 +122,22 @@ print "# we seem to have sparse files...\n";
 
 # By now we better be sure that we do have sparse files:
 # if we are not, the following will hog 5 gigabytes of disk.  Ooops.
+# This may fail by producing some signal; run in a subprocess first for safety
 
 $ENV{LC_ALL} = "C";
 
+my $r = system '../perl', '-e', <<'EOF';
+open(BIG, ">big");
+seek(BIG, 5_000_000_000, 0);
+print BIG "big";
+exit 0;
+EOF
+
 open(BIG, ">big") or do { warn "open failed: $!\n"; bye };
 binmode BIG;
-unless (seek(BIG, 5_000_000_000, $SEEK_SET)) {
-    print "1..0\n# seeking past 2GB failed: $!\n";
-    explain();
+if ($r or not seek(BIG, 5_000_000_000, $SEEK_SET)) {
+    my $err = $r ? 'signal '.($r & 0x7f) : $!;
+    explain("seeking past 2GB failed: $err");
     bye();
 }
 
@@ -129,11 +149,12 @@ my $close = close BIG;
 print "# close failed: $!\n" unless $close;
 unless ($print && $close) {
     if ($! =~/too large/i) {
-	print "1..0\n# writing past 2GB failed: process limits?\n";
+	explain("writing past 2GB failed: process limits?");
     } elsif ($! =~ /quota/i) {
-	print "1..0\n# filesystem quota limits?\n";
+	explain("filesystem quota limits?");
+    } else {
+	explain("error: $!");
     }
-    explain();
     bye();
 }
 
@@ -142,8 +163,7 @@ unless ($print && $close) {
 print "# @s\n";
 
 unless ($s[7] == 5_000_000_003) {
-    print "1..0\n# not configured to use large files?\n";
-    explain();
+    explain("kernel/fs not configured to use large files?");
     bye();
 }
 
@@ -152,9 +172,30 @@ sub fail () {
     $fail++;
 }
 
+sub offset ($$) {
+    my ($offset_will_be, $offset_want) = @_;
+    my $offset_is = eval $offset_will_be;
+    unless ($offset_is == $offset_want) {
+        print "# bad offset $offset_is, want $offset_want\n";
+	my ($offset_func) = ($offset_will_be =~ /^(\w+)/);
+	if (unpack("L", pack("L", $offset_want)) == $offset_is) {
+	    print "# 32-bit wraparound suspected in $offset_func() since\n";
+	    print "# $offset_want cast into 32 bits equals $offset_is.\n";
+	} elsif ($offset_want - unpack("L", pack("L", $offset_want)) - 1
+	         == $offset_is) {
+	    print "# 32-bit wraparound suspected in $offset_func() since\n";
+	    printf "# %s - unpack('L', pack('L', %s)) - 1 equals %s.\n",
+	        $offset_want,
+	        $offset_want,
+	        $offset_is;
+        }
+        fail;
+    }
+}
+
 print "1..17\n";
 
-my $fail = 0;
+$fail = 0;
 
 fail unless $s[7] == 5_000_000_003;	# exercizes pp_stat
 print "ok 1\n";
@@ -174,25 +215,28 @@ binmode BIG;
 fail unless seek(BIG, 4_500_000_000, $SEEK_SET);
 print "ok 5\n";
 
-fail unless tell(BIG) == 4_500_000_000;
+offset('tell(BIG)', 4_500_000_000);
 print "ok 6\n";
 
 fail unless seek(BIG, 1, $SEEK_CUR);
 print "ok 7\n";
 
-fail unless tell(BIG) == 4_500_000_001;
+# If you get 205_032_705 from here it means that
+# your tell() is returning 32-bit values since (I32)4_500_000_001
+# is exactly 205_032_705.
+offset('tell(BIG)', 4_500_000_001);
 print "ok 8\n";
 
 fail unless seek(BIG, -1, $SEEK_CUR);
 print "ok 9\n";
 
-fail unless tell(BIG) == 4_500_000_000;
+offset('tell(BIG)', 4_500_000_000);
 print "ok 10\n";
 
 fail unless seek(BIG, -3, $SEEK_END);
 print "ok 11\n";
 
-fail unless tell(BIG) == 5_000_000_000;
+offset('tell(BIG)', 5_000_000_000);
 print "ok 12\n";
 
 my $big;
@@ -204,6 +248,8 @@ fail unless $big eq "big";
 print "ok 14\n";
 
 # 705_032_704 = (I32)5_000_000_000
+# See that we don't have "big" in the 705_... spot:
+# that would mean that we have a wraparound.
 fail unless seek(BIG, 705_032_704, $SEEK_SET);
 print "ok 15\n";
 
@@ -215,7 +261,7 @@ print "ok 16\n";
 fail unless $zero eq "\0\0\0";
 print "ok 17\n";
 
-explain if $fail;
+explain() if $fail;
 
 bye(); # does the necessary cleanup
 
diff --git a/gnu/usr.bin/perl/t/op/lop.t b/gnu/usr.bin/perl/t/op/lop.t
index f15201ff096..d57271abd62 100644
--- a/gnu/usr.bin/perl/t/op/lop.t
+++ b/gnu/usr.bin/perl/t/op/lop.t
@@ -6,7 +6,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 print "1..7\n";
diff --git a/gnu/usr.bin/perl/t/op/my_stash.t b/gnu/usr.bin/perl/t/op/my_stash.t
new file mode 100644
index 00000000000..4a1d5022e02
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/my_stash.t
@@ -0,0 +1,31 @@
+#!./perl
+
+package Foo;
+
+BEGIN {
+    @INC = '../lib';
+}
+
+use Test;
+
+plan tests => 7;
+
+use constant MyClass => 'Foo::Bar::Biz::Baz';
+
+{
+    package Foo::Bar::Biz::Baz;
+}
+
+for (qw(Foo Foo:: MyClass __PACKAGE__)) {
+    eval "sub { my $_ \$obj = shift; }";
+    ok ! $@;
+#    print $@ if $@;
+}
+
+use constant NoClass => 'Nope::Foo::Bar::Biz::Baz';
+
+for (qw(Nope Nope:: NoClass)) {
+    eval "sub { my $_ \$obj = shift; }";
+    ok $@;
+#    print $@ if $@;
+}
diff --git a/gnu/usr.bin/perl/t/op/numconvert.t b/gnu/usr.bin/perl/t/op/numconvert.t
index 8eb9b6e3418..f3c9867a911 100644
--- a/gnu/usr.bin/perl/t/op/numconvert.t
+++ b/gnu/usr.bin/perl/t/op/numconvert.t
@@ -51,7 +51,13 @@ my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here
 
 print "# max_uv1 = $max_uv1, max_uv2 = $max_uv2, big_iv = $big_iv\n";
 if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) {
-  print "1..0\n# Unsigned arithmetic is not sane\n";
+  print "1..0 # skipped: unsigned perl arithmetic is not sane";
+  eval { require Config; import Config };
+  use vars qw(%Config);
+  if ($Config{d_quad} eq 'define') {
+      print " (common in 64-bit platforms)";
+  }
+  print "\n";
   exit 0;
 }
 
diff --git a/gnu/usr.bin/perl/t/op/pos.t b/gnu/usr.bin/perl/t/op/pos.t
index 46811b7bbc7..f3bc23c84ac 100644
--- a/gnu/usr.bin/perl/t/op/pos.t
+++ b/gnu/usr.bin/perl/t/op/pos.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..3\n";
+print "1..4\n";
 
 $x='banana';
 $x=~/.a/g;
@@ -14,3 +14,10 @@ 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";}
 
+# Is pos() set inside //g? (bug id 19990615.008)
+$x = "test string?"; $x =~ s/\w/pos($x)/eg;
+print "not " unless $x eq "0123 5678910?";
+print "ok 4\n";
+
+
+
diff --git a/gnu/usr.bin/perl/t/op/pwent.t b/gnu/usr.bin/perl/t/op/pwent.t
index ca14a99eec4..d811f06a33e 100644
--- a/gnu/usr.bin/perl/t/op/pwent.t
+++ b/gnu/usr.bin/perl/t/op/pwent.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, "../lib" if -d "../lib";
+    @INC = '../lib';
     eval {my @n = getpwuid 0};
     if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
 	print "1..0 # Skip: $1\n";
@@ -55,9 +55,9 @@ BEGIN {
     }
 }
 
-# By now PW filehandle should be open and full of juicy password entries.
+# By now the PW filehandle should be open and full of juicy password entries.
 
-print "1..1\n";
+print "1..2\n";
 
 # Go through at most this many users.
 # (note that the first entry has been read away by now)
@@ -68,10 +68,17 @@ my $tst = 1;
 my %perfect;
 my %seen;
 
+setpwent();
 while (<PW>) {
     chomp;
-    my @s = split /:/;
-    my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
+    # LIMIT -1 so that users with empty shells don't fall off
+    my @s = split /:/, $_, -1;
+    my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s);
+    if ($^O eq 'darwin') {
+       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s[0,1,2,3,7,8,9];
+    } else {
+       ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
+    }
     next if /^\+/; # ignore NIS includes
     if (@s) {
 	push @{ $seen{$name_s} }, $.;
@@ -86,7 +93,7 @@ while (<PW>) {
     }
     # In principle we could whine if @s != 7 but do we know enough
     # of passwd file formats everywhere?
-    if (@s == 7) {
+    if (@s == 7 || ($^O eq 'darwin' && @s == 10)) {
 	@n = getpwuid($uid_s);
 	# 'nobody' et al.
 	next unless @n;
@@ -108,6 +115,7 @@ while (<PW>) {
     }
     $n++;
 }
+endpwent();
 
 if (keys %perfect == 0) {
     $max++;
@@ -134,4 +142,29 @@ print "ok ", $tst++;
 print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
 print "\n";
 
+# Test both the scalar and list contexts.
+
+my @pw1;
+
+setpwent();
+for (1..$max) {
+    my $pw = scalar getpwent();
+    last unless defined $pw;
+    push @pw1, $pw;
+}
+endpwent();
+
+my @pw2;
+
+setpwent();
+for (1..$max) {
+    my ($pw) = (getpwent());
+    last unless defined $pw;
+    push @pw2, $pw;
+}
+endpwent();
+
+print "not " unless "@pw1" eq "@pw2";
+print "ok ", $tst++, "\n";
+
 close(PW);
diff --git a/gnu/usr.bin/perl/t/op/regmesg.t b/gnu/usr.bin/perl/t/op/regmesg.t
new file mode 100644
index 00000000000..01fa675bd5d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/regmesg.t
@@ -0,0 +1,179 @@
+#!./perl -w
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+my $debug = 1;
+
+##
+## If the markers used are changed (search for "MARKER1" in regcomp.c),
+## update only these two variables, and leave the {#} in the @death/@warning
+## arrays below. The {#} is a meta-marker -- it marks where the marker should
+## go.
+
+my $marker1 = "HERE";
+my $marker2 = " << HERE ";
+
+##
+## Key-value pairs of code/error of code that should have fatal errors.
+##
+
+eval 'use Config';         # assume defaults if fail
+our %Config;
+my $inf_m1 = ($Config{reg_infty} || 32767) - 1;
+my $inf_p1 = $inf_m1 + 2;
+my @death =
+(
+ '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions before {#} mark in regex m/[[=foo=]{#}]/',
+
+ '/(?<= .*)/' =>  'Variable length lookbehind not implemented before {#} mark in regex m/(?<= .*){#}/',
+
+ '/(?<= x{1000})/' => 'Lookbehind longer than 255 not implemented before {#} mark in regex m/(?<= x{1000}){#}/',
+
+ '/(?@)/' => 'Sequence (?@...) not implemented before {#} mark in regex m/(?@{#})/',
+
+ '/(?{ 1/' => 'Sequence (?{...}) not terminated or not {}-balanced before {#} mark in regex m/(?{{#} 1/',
+
+ '/(?(1x))/' => 'Switch condition not recognized before {#} mark in regex m/(?(1x{#}))/',
+
+ '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches before {#} mark in regex m/(?(1)x|y|{#}z)/',
+
+ '/(?(x)y|x)/' => 'Unknown switch condition (?(x) before {#} mark in regex m/(?({#}x)y|x)/',
+
+ '/(?/' => 'Sequence (? incomplete before {#} mark in regex m/(?{#}/',
+
+ '/(?;x/' => 'Sequence (?;...) not recognized before {#} mark in regex m/(?;{#}x/',
+ '/(?<;x/' => 'Sequence (?<;...) not recognized before {#} mark in regex m/(?<;{#}x/',
+
+ '/((x)/' => 'Unmatched ( before {#} mark in regex m/({#}(x)/',
+
+ "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 before {#} mark in regex m/x{{#}$inf_p1}/",
+
+ '/x{3,1}/' => 'Can\'t do {n,m} with n > m before {#} mark in regex m/x{3,1}{#}/',
+
+ '/x**/' => 'Nested quantifiers before {#} mark in regex m/x**{#}/',
+
+ '/x[/' => 'Unmatched [ before {#} mark in regex m/x[{#}/',
+
+ '/*/', => 'Quantifier follows nothing before {#} mark in regex m/*{#}/',
+
+ '/\p{x/' => 'Missing right brace on \p{} before {#} mark in regex m/\p{{#}x/',
+
+ 'use utf8; /[\p{x]/' => 'Missing right brace on \p{} before {#} mark in regex m/[\p{{#}x]/',
+
+ '/(x)\2/' => 'Reference to nonexistent group before {#} mark in regex m/(x)\2{#}/',
+
+ 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/',
+
+ '/\x{1/' => 'Missing right brace on \x{} before {#} mark in regex m/\x{{#}1/',
+
+ 'use utf8; /[\x{X]/' => 'Missing right brace on \x{} before {#} mark in regex m/[\x{{#}X]/',
+
+ '/[[:barf:]]/' => 'POSIX class [:barf:] unknown before {#} mark in regex m/[[:barf:]{#}]/',
+
+ '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions before {#} mark in regex m/[[=barf=]{#}]/',
+
+ '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions before {#} mark in regex m/[[.barf.]{#}]/',
+  
+ '/[z-a]/' => 'Invalid [] range "z-a" before {#} mark in regex m/[z-a{#}]/',
+);
+
+##
+## Key-value pairs of code/error of code that should have non-fatal warnings.
+##
+@warning = (
+    "m/(?p{ 'a' })/" => "(?p{}) is deprecated - use (??{}) before {#} mark in regex m/(?p{#}{ 'a' })/",
+
+    'm/\b*/' => '\b* matches null string many times before {#} mark in regex m/\b*{#}/',
+
+    'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes before {#} mark in regex m/[:blank:]{#}/',
+
+    "m'[\\y]'"     => 'Unrecognized escape \y in character class passed through before {#} mark in regex m/[\y{#}]/',
+
+    'm/[a-\d]/' => 'False [] range "a-\d" before {#} mark in regex m/[a-\d{#}]/',
+    'm/[\w-x]/' => 'False [] range "\w-" before {#} mark in regex m/[\w-{#}x]/',
+    "m'\\y'"     => 'Unrecognized escape \y passed through before {#} mark in regex m/\y{#}/',
+);
+
+my $total = (@death + @warning)/2;
+
+# utf8 is a noop on EBCDIC platforms, it is not fatal
+my $Is_EBCDIC = (ord('A') == 193);
+if ($Is_EBCDIC) {
+    my @utf8_death = grep(/utf8/, @death); 
+    $total = $total - scalar(@utf8_death);
+}
+
+print "1..$total\n";
+
+my $count = 0;
+
+while (@death)
+{
+    my $regex = shift @death;
+    my $result = shift @death;
+    # skip the utf8 test on EBCDIC since they do not die
+    next if ($Is_EBCDIC && $regex =~ /utf8/);
+    $count++;
+
+    $_ = "x";
+    eval $regex;
+    if (not $@) {
+	print "# oops, $regex didn't die\nnot ok $count\n";
+	next;
+    }
+    chomp $@;
+    $result =~ s/{\#}/$marker1/;
+    $result =~ s/{\#}/$marker2/;
+    if ($@ !~ /^\Q$result/) {
+	print "# For $regex, expected:\n#  $result\n# Got:\n#  $@\n#\nnot ";
+    }
+    print "ok $count\n";
+}
+
+
+our $warning;
+$SIG{__WARN__} = sub { $warning = shift };
+
+while (@warning)
+{
+    $count++;
+    my $regex = shift @warning;
+    my $result = shift @warning;
+
+    undef $warning;
+    $_ = "x";
+    eval $regex;
+
+    if ($@)
+    {
+	print "# oops, $regex died with:\n#\t$@#\nnot ok $count\n";
+	next;
+    }
+
+    if (not $warning)
+    {
+	print "# oops, $regex didn't generate a warning\nnot ok $count\n";
+	next;
+    }
+    $result =~ s/{\#}/$marker1/;
+    $result =~ s/{\#}/$marker2/;
+    if ($warning !~ /^\Q$result/)
+    {
+	print <<"EOM";
+# For $regex, expected:
+#   $result
+# Got:
+#   $warning
+#
+not ok $count
+EOM
+	next;
+    }
+    print "ok $count\n";
+}
+
+
+
diff --git a/gnu/usr.bin/perl/t/op/reverse.t b/gnu/usr.bin/perl/t/op/reverse.t
new file mode 100644
index 00000000000..bb7b9b77fea
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/reverse.t
@@ -0,0 +1,33 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+print "not " unless reverse("abc")    eq "cba";
+print "ok 1\n";
+
+$_ = "foobar";
+print "not " unless reverse()         eq "raboof";
+print "ok 2\n";
+
+{
+    my @a = ("foo", "bar");
+    my @b = reverse @a;
+
+    print "not " unless $b[0] eq $a[1] && $b[1] eq $a[0];
+    print "ok 3\n";
+}
+
+{
+    # Unicode.
+
+    my $a = "\x{263A}\x{263A}x\x{263A}y\x{263A}";
+    my $b = scalar reverse($a);
+    my $c = scalar reverse($b);
+    print "not " unless $a eq $c;
+    print "ok 4\n";
+}
diff --git a/gnu/usr.bin/perl/t/op/tiearray.t b/gnu/usr.bin/perl/t/op/tiearray.t
index 25fda3fb034..8e78b2f76b0 100644
--- a/gnu/usr.bin/perl/t/op/tiearray.t
+++ b/gnu/usr.bin/perl/t/op/tiearray.t
@@ -3,7 +3,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 my %seen;
diff --git a/gnu/usr.bin/perl/t/op/tiehandle.t b/gnu/usr.bin/perl/t/op/tiehandle.t
index 6ae3faaaecd..b04bdb78977 100644
--- a/gnu/usr.bin/perl/t/op/tiehandle.t
+++ b/gnu/usr.bin/perl/t/op/tiehandle.t
@@ -2,7 +2,7 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, '../lib';
+    @INC = '../lib';
 }
 
 my @expect;
@@ -77,7 +77,7 @@ package main;
 
 use Symbol;
 
-print "1..29\n";
+print "1..33\n";
 
 my $fh = gensym;
 
@@ -149,3 +149,19 @@ ok($data eq "qwerty");
 @expect = (CLOSE => $ob);
 $r = close $fh;
 ok($r == 5);
+
+# Does aliasing work with tied FHs?
+*ALIAS = *$fh;
+@expect = (PRINT => $ob,"some","text");
+$r = print ALIAS @expect[2,3];
+ok($r == 1);
+
+{
+    use warnings;
+    # Special case of aliasing STDERR, which used
+    # to dump core when warnings were enabled
+    *STDERR = *$fh;
+    @expect = (PRINT => $ob,"some","text");
+    $r = print STDERR @expect[2,3];
+    ok($r == 1);
+}
diff --git a/gnu/usr.bin/perl/t/op/tr.t b/gnu/usr.bin/perl/t/op/tr.t
index 4e6667cd7fb..c7ba0d8c55f 100644
--- a/gnu/usr.bin/perl/t/op/tr.t
+++ b/gnu/usr.bin/perl/t/op/tr.t
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, "../lib";
+    @INC = '../lib';
 }
 
-print "1..4\n";
+print "1..54\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
 
@@ -37,3 +37,275 @@ print "ok 3\n";
     print "ok 4\n";
 }
 #
+
+# make sure that tr cancels IOK and NOK
+($x = 12) =~ tr/1/3/;
+(my $y = 12) =~ tr/1/3/;
+($f = 1.5) =~ tr/1/3/;
+(my $g = 1.5) =~ tr/1/3/;
+print "not " unless $x + $y + $f + $g == 71;
+print "ok 5\n";
+
+# make sure tr is harmless if not updating  -  see [ID 20000511.005]
+$_ = 'fred';
+/([a-z]{2})/;
+$1 =~ tr/A-Z//;
+s/^(\s*)f/$1F/;
+print "not " if $_ ne 'Fred';
+print "ok 6\n";
+
+# check tr handles UTF8 correctly
+($x = 256.65.258) =~ tr/a/b/;
+print "not " if $x ne 256.65.258 or length $x != 3;
+print "ok 7\n";
+$x =~ tr/A/B/;
+if (ord("\t") == 9) { # ASCII
+    print "not " if $x ne 256.66.258 or length $x != 3;
+}
+else {
+    print "not " if $x ne 256.65.258 or length $x != 3;
+}
+print "ok 8\n";
+# EBCDIC variants of the above tests
+($x = 256.193.258) =~ tr/a/b/;
+print "not " if $x ne 256.193.258 or length $x != 3;
+print "ok 9\n";
+$x =~ tr/A/B/;
+if (ord("\t") == 9) { # ASCII
+    print "not " if $x ne 256.193.258 or length $x != 3;
+}
+else {
+    print "not " if $x ne 256.194.258 or length $x != 3;
+}
+print "ok 10\n";
+
+{
+if (ord("\t") == 9) { # ASCII
+    use utf8;
+}
+# 11 - changing UTF8 characters in a UTF8 string, same length.
+$l = chr(300); $r = chr(400);
+$x = 200.300.400;
+$x =~ tr/\x{12c}/\x{190}/;
+printf "not (%vd) ", $x if $x ne 200.400.400 or length $x != 3;
+print "ok 11\n";
+
+# 12 - changing UTF8 characters in UTF8 string, more bytes.
+$x = 200.300.400;
+$x =~ tr/\x{12c}/\x{be8}/;
+printf "not (%vd) ", $x if $x ne 200.3048.400 or length $x != 3;
+print "ok 12\n";
+
+# 13 - introducing UTF8 characters to non-UTF8 string.
+$x = 100.125.60;
+$x =~ tr/\x{64}/\x{190}/;
+printf "not (%vd) ", $x if $x ne 400.125.60 or length $x != 3;
+print "ok 13\n";
+
+# 14 - removing UTF8 characters from UTF8 string
+$x = 400.125.60;
+$x =~ tr/\x{190}/\x{64}/;
+printf "not (%vd) ", $x if $x ne 100.125.60 or length $x != 3;
+print "ok 14\n";
+
+# 15 - counting UTF8 chars in UTF8 string
+$x = 400.125.60.400;
+$y = $x =~ tr/\x{190}/\x{190}/;
+print "not " if $y != 2;
+print "ok 15\n";
+
+# 16 - counting non-UTF8 chars in UTF8 string
+$x = 60.400.125.60.400;
+$y = $x =~ tr/\x{3c}/\x{3c}/;
+print "not " if $y != 2;
+print "ok 16\n";
+
+# 17 - counting UTF8 chars in non-UTF8 string
+$x = 200.125.60;
+$y = $x =~ tr/\x{190}/\x{190}/;
+print "not " if $y != 0;
+print "ok 17\n";
+}
+
+# 18: test brokenness with tr/a-z-9//;
+$_ = "abcdefghijklmnopqrstuvwxyz";
+eval "tr/a-z-9/ /";
+print (($@ =~ /^Ambiguous range in transliteration operator/ || $^V lt v5.7.0) 
+       ? '' : 'not ', "ok 18\n");
+
+# 19-21: Make sure leading and trailing hyphens still work
+$_ = "car-rot9";
+tr/-a-m/./;
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 19\n");
+
+$_ = "car-rot9";
+tr/a-m-/./;
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 20\n");
+
+$_ = "car-rot9";
+tr/-a-m-/./;
+print (($_ eq '..r.rot9') ? '' : 'not ', "ok 21\n");
+
+$_ = "abcdefghijklmnop";
+tr/ae-hn/./;
+print (($_ eq '.bcd....ijklm.op') ? '' : 'not ', "ok 22\n");
+
+$_ = "abcdefghijklmnop";
+tr/a-cf-kn-p/./;
+print (($_ eq '...de......lm...') ? '' : 'not ', "ok 23\n");
+
+$_ = "abcdefghijklmnop";
+tr/a-ceg-ikm-o/./;
+print (($_ eq '...d.f...j.l...p') ? '' : 'not ', "ok 24\n");
+
+# 25: Test reversed range check
+# 20000705 MJD
+eval "tr/m-d/ /";
+print (($@ =~ /^Invalid \[\] range "m-d" in transliteration operator/ || $^V lt v5.7.0) 
+       ? '' : 'not ', "ok 25\n");
+
+# 26: test cannot update if read-only
+eval '$1 =~ tr/x/y/';
+print (($@ =~ /^Modification of a read-only value attempted/) ? '' : 'not ',
+       "ok 26\n");
+
+# 27: test can count read-only
+'abcdef' =~ /(bcd)/;
+print (( eval '$1 =~ tr/abcd//' == 3) ? '' : 'not ', "ok 27\n");
+
+# 28: test lhs OK if not updating
+print ((eval '"123" =~ tr/12//' == 2) ? '' : 'not ', "ok 28\n");
+
+# 29: test lhs bad if updating
+eval '"123" =~ tr/1/1/';
+print (($@ =~ m|^Can't modify constant item in transliteration \(tr///\)|)
+       ? '' : 'not ', "ok 29\n");
+
+# v300 (0x12c) is UTF-8-encoded as 196 172 (0xc4 0xac)
+# v400 (0x190) is UTF-8-encoded as 198 144 (0xc6 0x90)
+
+# Transliterate a byte to a byte, all four ways.
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/;
+print "not " unless $a eq v300.197.172.300.197.172;
+print "ok 30\n";
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{c5}/;
+print "not " unless $a eq v300.197.172.300.197.172;
+print "ok 31\n";
+
+($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\xc5/;
+print "not " unless $a eq v300.197.172.300.197.172;
+print "ok 32\n";
+
+($a = v300.196.172.300.196.172) =~ tr/\x{c4}/\x{c5}/;
+print "not " unless $a eq v300.197.172.300.197.172;
+print "ok 33\n";
+
+# Transliterate a byte to a wide character.
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/;
+print "not " unless $a eq v300.301.172.300.301.172;
+print "ok 34\n";
+
+# Transliterate a wide character to a byte.
+
+($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc3/;
+print "not " unless $a eq v195.196.172.195.196.172;
+print "ok 35\n";
+
+# Transliterate a wide character to a wide character.
+
+($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/;
+print "not " unless $a eq v301.196.172.301.196.172;
+print "ok 36\n";
+
+# Transliterate both ways.
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4\x{12c}/\x{12d}\xc3/;
+print "not " unless $a eq v195.301.172.195.301.172;
+print "ok 37\n";
+
+# Transliterate all (four) ways.
+
+($a = v300.196.172.300.196.172.400.198.144) =~
+	tr/\xac\xc4\x{12c}\x{190}/\xad\x{12d}\xc5\x{191}/;
+print "not " unless $a eq v197.301.173.197.301.173.401.198.144;
+print "ok 38\n";
+
+# Transliterate and count.
+
+print "not "
+    unless (($a = v300.196.172.300.196.172) =~ tr/\xc4/\xc5/)       == 2;
+print "ok 39\n";
+
+print "not "
+    unless (($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\x{12d}/) == 2;
+print "ok 40\n";
+
+# Transliterate with complement.
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4/\x{12d}/c;
+print "not " unless $a eq v301.196.301.301.196.301;
+print "ok 41\n";
+
+($a = v300.196.172.300.196.172) =~ tr/\x{12c}/\xc5/c;
+print "not " unless $a eq v300.197.197.300.197.197;
+print "ok 42\n";
+
+# Transliterate with deletion.
+
+($a = v300.196.172.300.196.172) =~ tr/\xc4//d;
+print "not " unless $a eq v300.172.300.172;
+print "ok 43\n";
+
+($a = v300.196.172.300.196.172) =~ tr/\x{12c}//d;
+print "not " unless $a eq v196.172.196.172;
+print "ok 44\n";
+
+# Transliterate with squeeze.
+
+($a = v196.196.172.300.300.196.172) =~ tr/\xc4/\xc5/s;
+print "not " unless $a eq v197.172.300.300.197.172;
+print "ok 45\n";
+
+($a = v196.172.300.300.196.172.172) =~ tr/\x{12c}/\x{12d}/s;
+print "not " unless $a eq v196.172.301.196.172.172;
+print "ok 46\n";
+
+# Tricky cases by Simon Cozens.
+
+($a = v196.172.200) =~ tr/\x{12c}/a/;
+print "not " unless sprintf("%vd", $a) eq '196.172.200';
+print "ok 47\n";
+
+($a = v196.172.200) =~ tr/\x{12c}/\x{12c}/;
+print "not " unless sprintf("%vd", $a) eq '196.172.200';
+print "ok 48\n";
+
+($a = v196.172.200) =~ tr/\x{12c}//d;
+print "not " unless sprintf("%vd", $a) eq '196.172.200';
+print "ok 49\n";
+
+# UTF8 range
+
+($a = v300.196.172.302.197.172) =~ tr/\x{12c}-\x{130}/\xc0-\xc4/;
+print "not " unless $a eq v192.196.172.194.197.172;
+print "ok 50\n";
+
+($a = v300.196.172.302.197.172) =~ tr/\xc4-\xc8/\x{12c}-\x{130}/;
+print "not " unless $a eq v300.300.172.302.301.172;
+print "ok 51\n";
+
+# misc
+($a = "R0_001") =~ tr/R_//d;
+print "not " if hex($a) != 1;
+print "ok 52\n";
+
+@a = (1,2); map { y/1/./ for $_ } @a;
+print "not " if "@a" ne ". 2";
+print "ok 53\n";
+
+@a = (1,2); map { y/1/./ for $_.'' } @a;
+print "not " if "@a" ne "1 2";
+print "ok 54\n";
diff --git a/gnu/usr.bin/perl/t/op/utf8decode.t b/gnu/usr.bin/perl/t/op/utf8decode.t
new file mode 100644
index 00000000000..4d05a6b8d37
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/utf8decode.t
@@ -0,0 +1,183 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+no utf8;
+
+print "1..78\n";
+
+my $test = 1;
+
+# This table is based on Markus Kuhn's UTF-8 Decode Stress Tester,
+# http://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt,
+# version dated 2000-09-02. 
+
+# We use the \x notation instead of raw binary bytes for \x00-\x1f\x7f-\xff
+# because e.g. many patch programs have issues with binary data.
+
+my @MK = split(/\n/, <<__EOMK__);
+1	Correct UTF-8
+1.1.1 y "\xce\xba\xe1\xbd\xb9\xcf\x83\xce\xbc\xce\xb5"	-		11	ce:ba:e1:bd:b9:cf:83:ce:bc:ce:b5	5
+2	Boundary conditions 
+2.1	First possible sequence of certain length
+2.1.1 y "\x00"			0		1	00	1
+2.1.2 y "\xc2\x80"			80		2	c2:80	1
+2.1.3 y "\xe0\xa0\x80"		800		3	e0:a0:80	1
+2.1.4 y "\xf0\x90\x80\x80"		10000		4	f0:90:80:80	1
+2.1.5 y "\xf8\x88\x80\x80\x80"	200000		5	f8:88:80:80:80	1
+2.1.6 y "\xfc\x84\x80\x80\x80\x80"	4000000		6	fc:84:80:80:80:80	1
+2.2	Last possible sequence of certain length
+2.2.1 y "\x7f"			7f		1	7f	1
+2.2.2 y "\xdf\xbf"			7ff		2	df:bf	1
+# The ffff is illegal unless UTF8_ALLOW_FFFF
+2.2.3 n "\xef\xbf\xbf"			ffff		3	ef:bf:bf	1	character 0xffff
+2.2.4 y "\xf7\xbf\xbf\xbf"			1fffff		4	f7:bf:bf:bf	1
+2.2.5 y "\xfb\xbf\xbf\xbf\xbf"			3ffffff		5	fb:bf:bf:bf:bf	1
+2.2.6 y "\xfd\xbf\xbf\xbf\xbf\xbf"		7fffffff	6	fd:bf:bf:bf:bf:bf	1
+2.3	Other boundary conditions
+2.3.1 y "\xed\x9f\xbf"		d7ff		3	ed:9f:bf	1
+2.3.2 y "\xee\x80\x80"		e000		3	ee:80:80	1
+2.3.3 y "\xef\xbf\xbd"			fffd		3	ef:bf:bd	1
+2.3.4 y "\xf4\x8f\xbf\xbf"		10ffff		4	f4:8f:bf:bf	1
+2.3.5 y "\xf4\x90\x80\x80"		110000		4	f4:90:80:80	1
+3	Malformed sequences
+3.1	Unexpected continuation bytes
+3.1.1 n "\x80"			-		1	80	-	unexpected continuation byte 0x80
+3.1.2 n "\xbf"			-		1	bf	-	unexpected continuation byte 0xbf
+3.1.3 n "\x80\xbf"			-		2	80:bf	-	unexpected continuation byte 0x80
+3.1.4 n "\x80\xbf\x80"		-		3	80:bf:80	-	unexpected continuation byte 0x80
+3.1.5 n "\x80\xbf\x80\xbf"		-		4	80:bf:80:bf	-	unexpected continuation byte 0x80
+3.1.6 n "\x80\xbf\x80\xbf\x80"	-		5	80:bf:80:bf:80	-	unexpected continuation byte 0x80
+3.1.7 n "\x80\xbf\x80\xbf\x80\xbf"	-		6	80:bf:80:bf:80:bf	-	unexpected continuation byte 0x80
+3.1.8 n "\x80\xbf\x80\xbf\x80\xbf\x80"	-		7	80:bf:80:bf:80:bf:80	-	unexpected continuation byte 0x80
+3.1.9 n "\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf"				-	64	80:81:82:83:84:85:86:87:88:89:8a:8b:8c:8d:8e:8f:90:91:92:93:94:95:96:97:98:99:9a:9b:9c:9d:9e:9f:a0:a1:a2:a3:a4:a5:a6:a7:a8:a9:aa:ab:ac:ad:ae:af:b0:b1:b2:b3:b4:b5:b6:b7:b8:b9:ba:bb:bc:bd:be:bf	-	unexpected continuation byte 0x80
+3.2	Lonely start characters
+3.2.1 n "\xc0 \xc1 \xc2 \xc3 \xc4 \xc5 \xc6 \xc7 \xc8 \xc9 \xca \xcb \xcc \xcd \xce \xcf \xd0 \xd1 \xd2 \xd3 \xd4 \xd5 \xd6 \xd7 \xd8 \xd9 \xda \xdb \xdc \xdd \xde \xdf "	-	64 	c0:20:c1:20:c2:20:c3:20:c4:20:c5:20:c6:20:c7:20:c8:20:c9:20:ca:20:cb:20:cc:20:cd:20:ce:20:cf:20:d0:20:d1:20:d2:20:d3:20:d4:20:d5:20:d6:20:d7:20:d8:20:d9:20:da:20:db:20:dc:20:dd:20:de:20:df:20	-	unexpected non-continuation byte 0x20 after start byte 0xc0
+3.2.2 n "\xe0 \xe1 \xe2 \xe3 \xe4 \xe5 \xe6 \xe7 \xe8 \xe9 \xea \xeb \xec \xed \xee \xef "	-	32	e0:20:e1:20:e2:20:e3:20:e4:20:e5:20:e6:20:e7:20:e8:20:e9:20:ea:20:eb:20:ec:20:ed:20:ee:20:ef:20	-	unexpected non-continuation byte 0x20 after start byte 0xe0
+3.2.3 n "\xf0 \xf1 \xf2 \xf3 \xf4 \xf5 \xf6 \xf7 "	-	16	f0:20:f1:20:f2:20:f3:20:f4:20:f5:20:f6:20:f7:20	-	unexpected non-continuation byte 0x20 after start byte 0xf0
+3.2.4 n "\xf8 \xf9 \xfa \xfb "		-	8	f8:20:f9:20:fa:20:fb:20	-	unexpected non-continuation byte 0x20 after start byte 0xf8
+3.2.5 n "\xfc \xfd "			-	4	fc:20:fd:20	-	unexpected non-continuation byte 0x20 after start byte 0xfc
+3.3	Sequences with last continuation byte missing
+3.3.1 n "\xc0"			-	1	c0	-	1 byte, need 2
+3.3.2 n "\xe0\x80"			-	2	e0:80	-	2 bytes, need 3
+3.3.3 n "\xf0\x80\x80"		-	3	f0:80:80	-	3 bytes, need 4
+3.3.4 n "\xf8\x80\x80\x80"		-	4	f8:80:80:80	-	4 bytes, need 5
+3.3.5 n "\xfc\x80\x80\x80\x80"	-	5	fc:80:80:80:80	-	5 bytes, need 6
+3.3.6 n "\xdf"			-	1	df	-	1 byte, need 2
+3.3.7 n "\xef\xbf"			-	2	ef:bf	-	2 bytes, need 3
+3.3.8 n "\xf7\xbf\xbf"			-	3	f7:bf:bf	-	3 bytes, need 4
+3.3.9 n "\xfb\xbf\xbf\xbf"			-	4	fb:bf:bf:bf	-	4 bytes, need 5
+3.3.10 n "\xfd\xbf\xbf\xbf\xbf"		-	5	fd:bf:bf:bf:bf	-	5 bytes, need 6
+3.4	Concatenation of incomplete sequences
+3.4.1 n "\xc0\xe0\x80\xf0\x80\x80\xf8\x80\x80\x80\xfc\x80\x80\x80\x80\xdf\xef\xbf\xf7\xbf\xbf\xfb\xbf\xbf\xbf\xfd\xbf\xbf\xbf\xbf"	-	30	c0:e0:80:f0:80:80:f8:80:80:80:fc:80:80:80:80:df:ef:bf:f7:bf:bf:fb:bf:bf:bf:fd:bf:bf:bf:bf	-	unexpected non-continuation byte 0xe0 after start byte 0xc0
+3.5	Impossible bytes
+3.5.1 n "\xfe"			-	1	fe	-	byte 0xfe
+3.5.2 n "\xff"			-	1	ff	-	byte 0xff
+3.5.3 n "\xfe\xfe\xff\xff"			-	4	fe:fe:ff:ff	-	byte 0xfe
+4	Overlong sequences
+4.1	Examples of an overlong ASCII character
+4.1.1 n "\xc0\xaf"			-	2	c0:af	-	2 bytes, need 1
+4.1.2 n "\xe0\x80\xaf"		-	3	e0:80:af	-	3 bytes, need 1
+4.1.3 n "\xf0\x80\x80\xaf"		-	4	f0:80:80:af	-	4 bytes, need 1
+4.1.4 n "\xf8\x80\x80\x80\xaf"	-	5	f8:80:80:80:af	-	5 bytes, need 1
+4.1.5 n "\xfc\x80\x80\x80\x80\xaf"	-	6	fc:80:80:80:80:af	-	6 bytes, need 1
+4.2	Maximum overlong sequences
+4.2.1 n "\xc1\xbf"			-	2	c1:bf	-	2 bytes, need 1
+4.2.2 n "\xe0\x9f\xbf"		-	3	e0:9f:bf	-	3 bytes, need 2
+4.2.3 n "\xf0\x8f\xbf\xbf"		-	4	f0:8f:bf:bf	-	4 bytes, need 3
+4.2.4 n "\xf8\x87\xbf\xbf\xbf"		-	5	f8:87:bf:bf:bf	-	5 bytes, need 4
+4.2.5 n "\xfc\x83\xbf\xbf\xbf\xbf"		-	6	fc:83:bf:bf:bf:bf	-	6 bytes, need 5
+4.3	Overlong representation of the NUL character
+4.3.1 n "\xc0\x80"			-	2	c0:80	-	2 bytes, need 1
+4.3.2 n "\xe0\x80\x80"		-	3	e0:80:80	-	3 bytes, need 1
+4.3.3 n "\xf0\x80\x80\x80"		-	4	f0:80:80:80	-	4 bytes, need 1
+4.3.4 n "\xf8\x80\x80\x80\x80"	-	5	f8:80:80:80:80	-	5 bytes, need 1
+4.3.5 n "\xfc\x80\x80\x80\x80\x80"	-	6	fc:80:80:80:80:80	-	6 bytes, need 1
+5	Illegal code positions
+5.1	Single UTF-16 surrogates
+5.1.1 n "\xed\xa0\x80"		-	3	ed:a0:80	-	UTF-16 surrogate 0xd800
+5.1.2 n "\xed\xad\xbf"			-	3	ed:ad:bf	-	UTF-16 surrogate 0xdb7f
+5.1.3 n "\xed\xae\x80"		-	3	ed:ae:80	-	UTF-16 surrogate 0xdb80
+5.1.4 n "\xed\xaf\xbf"			-	3	ed:af:bf	-	UTF-16 surrogate 0xdbff
+5.1.5 n "\xed\xb0\x80"		-	3	ed:b0:80	-	UTF-16 surrogate 0xdc00
+5.1.6 n "\xed\xbe\x80"		-	3	ed:be:80	-	UTF-16 surrogate 0xdf80
+5.1.7 n "\xed\xbf\xbf"			-	3	ed:bf:bf	-	UTF-16 surrogate 0xdfff
+5.2	Paired UTF-16 surrogates
+5.2.1 n "\xed\xa0\x80\xed\xb0\x80"		-	6	ed:a0:80:ed:b0:80	-	UTF-16 surrogate 0xd800
+5.2.2 n "\xed\xa0\x80\xed\xbf\xbf"		-	6	ed:a0:80:ed:bf:bf	-	UTF-16 surrogate 0xd800
+5.2.3 n "\xed\xad\xbf\xed\xb0\x80"		-	6	ed:ad:bf:ed:b0:80	-	UTF-16 surrogate 0xdb7f
+5.2.4 n "\xed\xad\xbf\xed\xbf\xbf"		-	6	ed:ad:bf:ed:bf:bf	-	UTF-16 surrogate 0xdb7f
+5.2.5 n "\xed\xae\x80\xed\xb0\x80"		-	6	ed:ae:80:ed:b0:80	-	UTF-16 surrogate 0xdb80
+5.2.6 n "\xed\xae\x80\xed\xbf\xbf"		-	6	ed:ae:80:ed:bf:bf	-	UTF-16 surrogate 0xdb80
+5.2.7 n "\xed\xaf\xbf\xed\xb0\x80"		-	6	ed:af:bf:ed:b0:80	-	UTF-16 surrogate 0xdbff
+5.2.8 n "\xed\xaf\xbf\xed\xbf\xbf"		-	6	ed:af:bf:ed:bf:bf	-	UTF-16 surrogate 0xdbff
+5.3	Other illegal code positions
+5.3.1 n "\xef\xbf\xbe"			-	3	ef:bf:be	-	byte order mark 0xfffe
+# The ffff is illegal unless UTF8_ALLOW_FFFF
+5.3.2 n "\xef\xbf\xbf"			-	3	ef:bf:bf	-	character 0xffff
+__EOMK__
+
+# 104..181
+{
+    my $WARNCNT;
+    my $id;
+
+    local $SIG{__WARN__} =
+	sub {
+	    print "# $id: @_";
+	    $WARNCNT++;
+	    $WARNMSG = "@_";
+	};
+
+    sub moan {
+	print "$id: @_";
+    }
+    
+    sub test_unpack_U {
+	$WARNCNT = 0;
+	$WARNMSG = "";
+	unpack('U*', $_[0]);
+    }
+
+    for (@MK) {
+	if (/^(?:\d+(?:\.\d+)?)\s/ || /^#/) {
+	    # print "# $_\n";
+	} elsif (/^(\d+\.\d+\.\d+[bu]?)\s+([yn])\s+"(.+)"\s+([0-9a-f]{1,8}|-)\s+(\d+)\s+([0-9a-f]{2}(?::[0-9a-f]{2})*)(?:\s+((?:\d+|-)(?:\s+(.+))?))?$/) {
+	    $id = $1;
+	    my ($okay, $bytes, $Unicode, $byteslen, $hex, $charslen, $error) =
+		($2, $3, $4, $5, $6, $7, $8);
+	    my @hex = split(/:/, $hex);
+	    unless (@hex == $byteslen) {
+		my $nhex = @hex;
+		moan "amount of hex ($nhex) not equal to byteslen ($byteslen)\n";
+	    }
+	    {
+		use bytes;
+		my $bytesbyteslen = length($bytes);
+		unless ($bytesbyteslen == $byteslen) {
+		    moan "bytes length() ($bytesbyteslen) not equal to $byteslen\n";
+		}
+	    }
+	    if ($okay eq 'y') {
+		test_unpack_U($bytes);
+		if ($WARNCNT) {
+		    moan "unpack('U*') false negative\n";
+		    print "not ";
+		}
+	    } elsif ($okay eq 'n') {
+		test_unpack_U($bytes);
+		if ($WARNCNT == 0 || ($error ne '' && $WARNMSG !~ /$error/)) {
+		    moan "unpack('U*') false positive\n";
+		    print "not ";
+		}
+	    }
+	    print "ok $test\n";
+	    $test++;
+ 	} else {
+	    moan "unknown format\n";
+	}
+    }
+}
diff --git a/gnu/usr.bin/perl/t/op/ver.t b/gnu/usr.bin/perl/t/op/ver.t
index b08849f53a4..edfebd20ffc 100644
--- a/gnu/usr.bin/perl/t/op/ver.t
+++ b/gnu/usr.bin/perl/t/op/ver.t
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    unshift @INC, "../lib";
+    @INC = '../lib';
 }
 
-print "1..22\n";
+print "1..28\n";
 
 my $test = 1;
 
@@ -14,13 +14,24 @@ require v5.5.640;
 print "ok $test\n";  ++$test;
 
 # printing characters should work
-print v111;
-print v107.32;
-print "$test\n"; ++$test;
-
-# hash keys too
-$h{v111.107} = "ok";
-print "$h{ok} $test\n"; ++$test;
+if (ord("\t") == 9) { # ASCII
+    print v111;
+    print v107.32;
+    print "$test\n"; ++$test;
+
+    # hash keys too
+    $h{v111.107} = "ok";
+    print "$h{ok} $test\n"; ++$test;
+}
+else { # EBCDIC
+    print v150;
+    print v146.64;
+    print "$test\n"; ++$test;
+
+    # hash keys too
+    $h{v150.146} = "ok";
+    print "$h{ok} $test\n"; ++$test;
+}
 
 # poetry optimization should also
 sub v77 { "ok" }
@@ -28,7 +39,12 @@ $x = v77;
 print "$x $test\n"; ++$test;
 
 # but not when dots are involved
-$x = v77.78.79;
+if (ord("\t") == 9) { # ASCII
+    $x = v77.78.79;
+}
+else {
+    $x = v212.213.214;
+}
 print "not " unless $x eq "MNO";
 print "ok $test\n";  ++$test;
 
@@ -42,10 +58,20 @@ require 5.5.640;
 print "ok $test\n";  ++$test;
 
 # hash keys too
-$h{111.107.32} = "ok";
+if (ord("\t") == 9) { # ASCII
+    $h{111.107.32} = "ok";
+}
+else {
+    $h{150.146.64} = "ok";
+}
 print "$h{ok } $test\n"; ++$test;
 
-$x = 77.78.79;
+if (ord("\t") == 9) { # ASCII
+    $x = 77.78.79;
+}
+else {
+    $x = 212.213.214;
+}
 print "not " unless $x eq "MNO";
 print "ok $test\n";  ++$test;
 
@@ -53,44 +79,103 @@ print "not " unless 1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}";
 print "ok $test\n";  ++$test;
 
 # test sprintf("%vd"...) etc
-print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+if (ord("\t") == 9) { # ASCII
+    print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+}
+else {
+    print "not " unless sprintf("%vd", "Perl") eq '215.133.153.147';
+}
 print "ok $test\n";  ++$test;
 
 print "not " unless sprintf("%vd", v1.22.333.4444) eq '1.22.333.4444';
 print "ok $test\n";  ++$test;
 
-print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+if (ord("\t") == 9) { # ASCII
+    print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+}
+else {
+    print "not " unless sprintf("%vx", "Perl") eq 'd7.85.99.93';
+}
 print "ok $test\n";  ++$test;
 
 print "not " unless sprintf("%vX", 1.22.333.4444) eq '1.16.14D.115C';
 print "ok $test\n";  ++$test;
 
-print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154';
+if (ord("\t") == 9) { # ASCII
+    print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154';
+}
+else {
+    print "not " unless sprintf("%*v#o", ":", "Perl") eq '0327:0205:0231:0223';
+}
 print "ok $test\n";  ++$test;
 
 print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
     eq '1##10110##101001101##1000101011100';
 print "ok $test\n";  ++$test;
 
+print "not " unless sprintf("%vd", join("", map { chr }
+					    unpack "U*", v2001.2002.2003))
+		    eq '2001.2002.2003';
+print "ok $test\n";  ++$test;
+
 {
     use bytes;
-    print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+    }
+    else {
+        print "not " unless sprintf("%vd", "Perl") eq '215.133.153.147';
+    }
     print "ok $test\n";  ++$test;
 
     print "not " unless
         sprintf("%vd", 1.22.333.4444) eq '1.22.197.141.225.133.156';
     print "ok $test\n";  ++$test;
 
-    print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless sprintf("%vx", "Perl") eq '50.65.72.6c';
+    }
+    else {
+        print "not " unless sprintf("%vx", "Perl") eq 'd7.85.99.93';
+    }
     print "ok $test\n";  ++$test;
 
     print "not " unless sprintf("%vX", v1.22.333.4444) eq '1.16.C5.8D.E1.85.9C';
     print "ok $test\n";  ++$test;
 
-    print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154';
+    if (ord("\t") == 9) { # ASCII
+        print "not " unless sprintf("%*v#o", ":", "Perl") eq '0120:0145:0162:0154';
+    }
+    else {
+        print "not " unless sprintf("%*v#o", ":", "Perl") eq '0327:0205:0231:0223';
+    }
     print "ok $test\n";  ++$test;
 
     print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
 	eq '1##10110##11000101##10001101##11100001##10000101##10011100';
     print "ok $test\n";  ++$test;
 }
+
+{
+    # bug id 20000323.056
+
+    print "not " unless "\x{41}" eq +v65;
+    print "ok $test\n";
+    $test++;
+
+    print "not " unless "\x41" eq +v65;
+    print "ok $test\n";
+    $test++;
+
+    print "not " unless "\x{c8}" eq +v200;
+    print "ok $test\n";
+    $test++;
+
+    print "not " unless "\xc8" eq +v200;
+    print "ok $test\n";
+    $test++;
+
+    print "not " unless "\x{221b}" eq v8731;
+    print "ok $test\n";
+    $test++;
+}
diff --git a/gnu/usr.bin/perl/t/op/wantarray.t b/gnu/usr.bin/perl/t/op/wantarray.t
index 0a47b6d3ba0..4b6f37cf0fa 100644
--- a/gnu/usr.bin/perl/t/op/wantarray.t
+++ b/gnu/usr.bin/perl/t/op/wantarray.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..3\n";
+print "1..7\n";
 sub context {
   my ( $cona, $testnum ) = @_;
   my $conb = (defined wantarray) ? ( wantarray ? 'A' : 'S' ) : 'V';
@@ -13,4 +13,8 @@ sub context {
 context('V',1);
 $a = context('S',2);
 @a = context('A',3);
+scalar context('S',4);
+$a = scalar context('S',5);
+($a) = context('A',6);
+($a) = scalar context('S',7);
 1;
diff --git a/gnu/usr.bin/perl/t/pod/find.t b/gnu/usr.bin/perl/t/pod/find.t
new file mode 100644
index 00000000000..db39508363c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/find.t
@@ -0,0 +1,119 @@
+# Testing of Pod::Find
+# Author: Marek Rouchal <marek@saftsack.fs.uni-bayreuth.de>
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+$| = 1;
+
+use Test;
+
+BEGIN { plan tests => 4 }
+
+use Pod::Find qw(pod_find pod_where);
+use File::Spec;
+
+# load successful
+ok(1);
+
+require Cwd;
+my $THISDIR = Cwd::cwd();
+my $VERBOSE = 0;
+my $lib_dir = File::Spec->catdir($THISDIR,'..','lib','Pod');
+if ($^O eq 'VMS') {
+    $lib_dir = VMS::Filespec::unixify(File::Spec->catdir($THISDIR,'-','lib','pod'));
+    $Qlib_dir = $lib_dir;
+    $Qlib_dir =~ s#\/#::#g;
+}
+print "### searching $lib_dir\n";
+my %pods = pod_find("$lib_dir");
+my $result = join(",", sort values %pods);
+print "### found $result\n";
+my $compare = join(',', qw(
+    Checker
+    Find
+    Html
+    InputObjects
+    LaTeX
+    Man
+    ParseUtils
+    Parser
+    Plainer
+    Select
+    Text
+    Text::Color
+    Text::Overstrike
+    Text::Termcap
+    Usage
+));
+if ($^O eq 'VMS') {
+    $compare = lc($compare);
+    $result = join(',', sort grep(/pod::/, values %pods));
+    my $undollared = $Qlib_dir;
+    $undollared =~ s/\$/\\\$/g;
+    $undollared =~ s/\-/\\\-/g;
+    $result =~ s/$undollared/pod::/g;
+    my $count = 0;
+    my @result = split(/,/,$result);
+    my @compare = split(/,/,$compare);
+    foreach(@compare) {
+        $count += grep {/$_/} @result;
+    }
+    ok($count/($#result+1)-1,$#compare);
+}
+else {
+    ok($result,$compare);
+}
+
+# File::Find is located in this place since eons
+# and on all platforms, hopefully
+
+print "### searching for File::Find\n";
+$result = pod_where({ -inc => 1, -verbose => $VERBOSE }, 'File::Find')
+  || 'undef - pod not found!';
+print "### found $result\n";
+
+if ($^O eq 'VMS') { # privlib is perl_root:[lib] OK but not under mms
+    $compare = "lib.File]Find.pm";
+    $result =~ s/perl_root:\[\-?\.?//i;
+    $result =~ s/\[\-?\.?//i; # needed under `mms test`
+    ok($result,$compare);
+}
+else {
+    $compare = File::Spec->catfile("..","lib","File","Find.pm");
+    ok(_canon($result),_canon($compare));
+}
+
+# Search for a documentation pod rather than a module
+print "### searching for perlfunc.pod\n";
+$result = pod_where({ -dirs => ['../pod'], -verbose => $VERBOSE }, 'perlfunc')
+  || 'undef - perlfunc.pod not found!';
+print "### found $result\n";
+
+if ($^O eq 'VMS') { # privlib is perl_root:[lib] unfortunately
+    $compare = "/lib/pod/perlfunc.pod";
+    $result = VMS::Filespec::unixify($result);
+    $result =~ s/perl_root\///i;
+    $result =~ s/^\.\.//;  # needed under `mms test`
+    ok($result,$compare);
+}
+else {
+    $compare = File::Spec->catfile("..","pod","perlfunc.pod");
+    ok(_canon($result),_canon($compare));
+}
+
+# make the path as generic as possible
+sub _canon
+{
+  my ($path) = @_;
+  $path = File::Spec->canonpath($path);
+  my @comp = File::Spec->splitpath($path);
+  my @dir = File::Spec->splitdir($comp[1]);
+  $comp[1] = File::Spec->catdir(@dir);
+  $path = File::Spec->catpath(@dir);
+  $path = uc($path) if File::Spec->case_tolerant;
+  $path;
+}
+
diff --git a/gnu/usr.bin/perl/t/run/runenv.t b/gnu/usr.bin/perl/t/run/runenv.t
new file mode 100644
index 00000000000..a59ad26f35c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/runenv.t
@@ -0,0 +1,147 @@
+#!./perl
+#
+# Tests for Perl run-time environment variable settings
+#
+# $PERL5OPT, $PERL5LIB, etc.
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    unless ($Config{'d_fork'}) {
+        print "1..0 # Skip: no fork\n";
+	    exit 0;
+    }
+}
+
+my $STDOUT = './results-0';
+my $STDERR = './results-1';
+my $PERL = './perl';
+my $FAILURE_CODE = 119;
+
+print "1..9\n";
+
+# Run perl with specified environment and arguments returns a list.
+# First element is true iff Perl's stdout and stderr match the
+# supplied $stdout and $stderr argument strings exactly.
+# second element is an explanation of the failure
+sub runperl {
+  local *F;
+  my ($env, $args, $stdout, $stderr) = @_;
+
+  unshift @$args, '-I../lib';
+
+  $stdout = '' unless defined $stdout;
+  $stderr = '' unless defined $stderr;
+  my $pid = fork;
+  return (0, "Couldn't fork: $!") unless defined $pid;   # failure
+  if ($pid) {                   # parent
+    my ($actual_stdout, $actual_stderr);
+    wait;
+    return (0, "Failure in child.\n") if ($?>>8) == $FAILURE_CODE;
+
+    open F, "< $STDOUT" or return (0, "Couldn't read $STDOUT file");
+    { local $/; $actual_stdout = <F> }
+    open F, "< $STDERR" or return (0, "Couldn't read $STDERR file");
+    { local $/; $actual_stderr = <F> }
+
+    if ($actual_stdout ne $stdout) {
+      return (0, "Stdout mismatch: expected [$stdout], saw [$actual_stdout]");
+    } elsif ($actual_stderr ne $stderr) {
+      return (0, "Stderr mismatch: expected [$stderr], saw [$actual_stderr]");
+    } else {
+      return 1;                 # success
+    }
+  } else {                      # child
+    for my $k (keys %$env) {
+      $ENV{$k} = $env->{$k};
+    }
+    open STDOUT, "> $STDOUT" or exit $FAILURE_CODE;
+    open STDERR, "> $STDERR" or it_didnt_work();
+    { exec $PERL, @$args }
+    it_didnt_work();
+  }
+}
+
+
+sub it_didnt_work {
+    print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
+    exit $FAILURE_CODE;
+}
+
+sub try {
+  my $testno = shift;
+  my ($success, $reason) = runperl(@_);
+  if ($success) {
+    print "ok $testno\n";
+  } else {
+    $reason =~ s/\n/\\n/g;
+    print "not ok $testno # $reason\n";    
+  }
+}
+
+#  PERL5OPT    Command-line options (switches).  Switches in
+#                    this variable are taken as if they were on
+#                    every Perl command line.  Only the -[DIMUdmw]
+#                    switches are allowed.  When running taint
+#                    checks (because the program was running setuid
+#                    or setgid, or the -T switch was used), this
+#                    variable is ignored.  If PERL5OPT begins with
+#                    -T, tainting will be enabled, and any
+#                    subsequent options ignored.
+
+my  $T = 1;
+try($T++, {PERL5OPT => '-w'}, ['-e', 'print $::x'],
+    "", 
+    qq{Name "main::x" used only once: possible typo at -e line 1.\nUse of uninitialized value in print at -e line 1.\n});
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $::x'],
+    "", "");
+
+try($T++, {PERL5OPT => '-Mstrict'}, ['-e', 'print $x'],
+    "", 
+    qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-Mstrict -w'}, ['-e', 'print $x'],
+    "", 
+    qq{Global symbol "\$x" requires explicit package name at -e line 1.\nExecution of -e aborted due to compilation errors.\n});
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+    "", 
+    <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+    );
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-w -Mstrict'}, ['-e', 'print $::x'],
+    "", 
+    <<ERROR
+Name "main::x" used only once: possible typo at -e line 1.
+Use of uninitialized value in print at -e line 1.
+ERROR
+    );
+
+try($T++, {PERL5OPT => '-MExporter'}, ['-e0'],
+    "", 
+    "");
+
+# Fails in 5.6.0
+try($T++, {PERL5OPT => '-MExporter -MExporter'}, ['-e0'],
+    "", 
+    "");
+
+try($T++, {PERL5OPT => '-Mstrict -Mwarnings'}, 
+    ['-e', 'print "ok" if $INC{"strict.pm"} and $INC{"warnings.pm"}'],
+    "ok",
+    "");
+
+print "# ", $T-1, " tests total.\n";
+
+END {
+    1 while unlink $STDOUT;
+    1 while unlink $STDERR;
+}