virgin perl 5.6.0

139 files changed, 13709 insertions, 24 deletions

diff --git a/gnu/usr.bin/perl/t/UTEST b/gnu/usr.bin/perl/t/UTEST
new file mode 100644
index 00000000000..b5f285bd599
--- /dev/null
+++ b/gnu/usr.bin/perl/t/UTEST
@@ -0,0 +1,195 @@
+#!./perl
+
+# Last change: Fri Jan 10 09:57:03 WET 1997
+
+# This is written in a peculiar style, since we're trying to avoid
+# most of the constructs we'll be testing for.
+
+$| = 1;
+
+if ($#ARGV >= 0 && $ARGV[0] eq '-v') {
+    $verbose = 1;
+    shift;
+}
+
+chdir 't' if -f 't/TEST';
+
+die "You need to run \"make test\" first to set things up.\n"
+  unless -e 'perl' or -e 'perl.exe';
+
+#$ENV{PERL_DESTRUCT_LEVEL} = '2';
+$ENV{EMXSHELL} = 'sh';        # For OS/2
+
+if ($#ARGV == -1) {
+    @ARGV = split(/[ \n]/,
+      `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
+}
+
+if ($^O eq 'os2' || $^O eq 'qnx') {
+    $sharpbang = 0;
+}
+else {
+    open(CONFIG, "../config.sh");
+    while (<CONFIG>) {
+	if (/sharpbang='(.*)'/) {
+	    $sharpbang = ($1 eq '#!');
+	    last;
+	}
+    }
+    close(CONFIG);
+}
+
+%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); 
+
+_testprogs('perl', @ARGV);
+_testprogs('compile', @ARGV) if (-e "../testcompile"); 
+
+sub _testprogs {
+    $type = shift @_;
+    @tests = @_;
+
+
+    print <<'EOT' if ($type eq 'compile');
+--------------------------------------------------------------------------------
+TESTING COMPILER
+--------------------------------------------------------------------------------
+EOT
+
+    $ENV{PERLCC_TIMEOUT} = 120 
+        if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
+
+    $bad = 0;
+    $good = 0;
+    $total = @tests;
+    $files  = 0;
+    $totmax = 0;
+    while ($test = shift @tests) {
+
+	if ( $infinite{$test} && $type eq 'compile' ) {
+	    print STDERR "$test creates infinite loop! Skipping.\n"; 
+            next;
+	}
+	if ($test =~ /^$/) {
+	    next;
+	}
+	$te = $test;
+	chop($te);
+	print "$te" . '.' x (18 - length($te));
+	if (0) {
+	    -x $test || (print "isn't executable.\n");
+
+	    if ($type eq 'perl') {
+		open(RESULTS, "./$test |") || (print "can't run.\n"); }
+	    else { 
+		open(RESULTS, "./perl -I../lib ../utils/perlcc ./$test -run -verbose dcf -log ../compilelog |") or print "can't compile.\n";
+	    }
+	}
+	else {
+	    open(SCRIPT,"$test") or die "Can't run $test.\n";
+	    $_ = <SCRIPT>;
+	    close(SCRIPT);
+	    if (/#!..perl(.*)/) {
+		$switch = $1;
+		if ($^O eq 'VMS') {
+		    # Must protect uppercase switches with "" on command line
+		    $switch =~ s/-([A-Z]\S*)/"-$1"/g;
+		}
+	    }
+	    else {
+		$switch = '';
+	    }
+
+	    if ($type eq 'perl') {
+		open(RESULTS,"./perl$switch -I../lib -Mutf8 $test |") || (print "can't run.\n");
+	    }
+	    else {
+		open(RESULTS, "./perl -I../lib ../utils/perlcc -Mutf8 ./$test -run -verbose dcf -log ../compilelog |") or print "can't compile.\n";
+	    }
+	}
+	$ok = 0;
+	$next = 0;
+	while (<RESULTS>) {
+	    if ($verbose) {
+		print $_;
+	    }
+	    unless (/^#/) {
+		if (/^1\.\.([0-9]+)/) {
+		    $max = $1;
+		    $totmax += $max;
+		    $files += 1;
+		    $next = 1;
+		    $ok = 1;
+		}
+		else {
+		    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+		    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
+			$next = $next + 1;
+		    }
+		    else {
+			$ok = 0;
+		    }
+		}
+	    }
+	}
+	close RESULTS;
+	$next = $next - 1;
+	if ($ok && $next == $max) {
+	    if ($max) {
+		print "ok\n";
+		$good = $good + 1;
+	    }
+	    else {
+		print "skipping test on this platform\n";
+		$files -= 1;
+	    }
+	}
+	else {
+	    $next += 1;
+	    print "FAILED at test $next\n";
+	    $bad = $bad + 1;
+	    $_ = $test;
+	    if (/^base/) {
+		die "Failed a basic test--cannot continue.\n";
+	    }
+	}
+    }
+
+    if ($bad == 0) {
+	if ($ok) {
+	    print "All tests successful.\n";
+	    # XXX add mention of 'perlbug -ok' ?
+	}
+	else {
+	    die "FAILED--no tests were run for some reason.\n";
+	}
+    }
+    else {
+	$pct = sprintf("%.2f", $good / $total * 100);
+	if ($bad == 1) {
+	    warn "Failed 1 test script out of $total, $pct% okay.\n";
+	}
+	else {
+	    warn "Failed $bad test scripts out of $total, $pct% okay.\n";
+	}
+	warn <<'SHRDLU';
+   ### Since not all tests were successful, you may want to run some
+   ### of them individually and examine any diagnostic messages they
+   ### produce.  See the INSTALL document's section on "make test".
+   ### If you are testing the compiler, then ignore this message 
+   ### and run 
+   ###      ./perl harness
+   ### in the directory ./t.
+SHRDLU
+	warn <<'SHRDLU' if $good / $total > 0.8;
+   ###
+   ### Since most tests were successful, you have a good chance to
+   ### get information with better granularity by running
+   ###     ./perl harness 
+   ### in directory ./t.
+SHRDLU
+    }
+    ($user,$sys,$cuser,$csys) = times;
+    print sprintf("u=%g  s=%g  cu=%g  cs=%g  scripts=%d  tests=%d\n",
+	$user,$sys,$cuser,$csys,$files,$totmax);
+}
+exit ($bad != 0);
diff --git a/gnu/usr.bin/perl/t/base/rs.t b/gnu/usr.bin/perl/t/base/rs.t
index 52a957260fd..021d699e2e8 100644
--- a/gnu/usr.bin/perl/t/base/rs.t
+++ b/gnu/usr.bin/perl/t/base/rs.t
@@ -24,7 +24,7 @@ $bar = <TESTFILE>;
 if ($bar eq "12\n") {print "ok 2\n";} else {print "not ok 2\n";}
 
 # Try a non line terminator
-$/ = "3";
+$/ = 3;
 $bar = <TESTFILE>;
 if ($bar eq "123") {print "ok 3\n";} else {print "not ok 3\n";}
 
@@ -122,8 +122,7 @@ if ($^O eq 'VMS') {
   if ($bar eq "z\n") {print "ok 14\n";} else {print "not ok 14\n";}
 
   close TESTFILE;
-  unlink "./foo.bar";
-  unlink "./foo.com";  
+  1 while unlink qw(foo.bar foo.com foo.fdl);
 } else {
   # Nobody else does this at the moment (well, maybe OS/390, but they can
   # put their own tests in) so we just punt
diff --git a/gnu/usr.bin/perl/t/comp/bproto.t b/gnu/usr.bin/perl/t/comp/bproto.t
new file mode 100644
index 00000000000..01efb8401cc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/comp/bproto.t
@@ -0,0 +1,44 @@
+#!./perl
+#
+# check if builtins behave as prototyped
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+print "1..10\n";
+
+my $i = 1;
+
+sub foo {}
+my $bar = "bar";
+
+sub test_too_many {
+    eval $_[0];
+    print "not " unless $@ =~ /^Too many arguments/;
+    printf "ok %d\n",$i++;
+}
+
+sub test_no_error {
+    eval $_[0];
+    print "not " if $@;
+    printf "ok %d\n",$i++;
+}
+
+test_too_many($_) for split /\n/,
+q[	defined(&foo, $bar);
+	undef(&foo, $bar);
+	uc($bar,$bar);
+];
+
+test_no_error($_) for split /\n/,
+q[	scalar(&foo,$bar);
+	defined &foo, &foo, &foo;
+	undef &foo, $bar;
+	uc $bar,$bar;
+	grep(not($bar), $bar);
+	grep(not($bar, $bar), $bar);
+	grep((not $bar, $bar, $bar), $bar);
+];
diff --git a/gnu/usr.bin/perl/t/io/nargv.t b/gnu/usr.bin/perl/t/io/nargv.t
new file mode 100644
index 00000000000..fb138576185
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/nargv.t
@@ -0,0 +1,63 @@
+#!./perl
+
+print "1..5\n";
+
+my $j = 1;
+for $i ( 1,2,5,4,3 ) {
+    $file = mkfiles($i);
+    open(FH, "> $file") || die "can't create $file: $!";
+    print FH "not ok " . $j++ . "\n";
+    close(FH) || die "Can't close $file: $!";
+}
+
+
+{
+    local *ARGV;
+    local $^I = '.bak';
+    local $_;
+    @ARGV = mkfiles(1..3);
+    $n = 0;
+    while (<>) {
+	print STDOUT "# initial \@ARGV: [@ARGV]\n";
+	if ($n++ == 2) {
+	    other();
+	}
+	show();
+    }
+}
+
+$^I = undef;
+@ARGV = mkfiles(1..3);
+$n = 0;
+while (<>) {
+    print STDOUT "#final \@ARGV: [@ARGV]\n";
+    if ($n++ == 2) {
+	other();
+    }
+    show();
+}
+
+sub show {
+    #warn "$ARGV: $_";
+    s/^not //;
+    print;
+}
+
+sub other {
+    print STDOUT "# Calling other\n";
+    local *ARGV;
+    local *ARGVOUT;
+    local $_;
+    @ARGV = mkfiles(5, 4);
+    while (<>) {
+	print STDOUT "# inner \@ARGV: [@ARGV]\n";
+	show();
+    }
+}
+
+sub mkfiles {
+    my @files = map { "scratch$_" } @_;
+    return wantarray ? @files : $files[-1];
+}
+
+END { unlink map { ($_, "$_.bak") } mkfiles(1..5) }
diff --git a/gnu/usr.bin/perl/t/io/open.t b/gnu/usr.bin/perl/t/io/open.t
new file mode 100644
index 00000000000..30db5988b6a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/open.t
@@ -0,0 +1,282 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}    
+
+# $RCSfile$    
+$|  = 1;
+use warnings;
+$Is_VMS = $^O eq 'VMS';
+
+print "1..66\n";
+
+my $test = 1;
+
+sub ok { print "ok $test\n"; $test++ }
+
+# my $file tests
+
+# 1..9
+{
+    unlink("afile") if -f "afile";     
+    print "$!\nnot " unless open(my $f,"+>afile");
+    ok;
+    binmode $f;
+    print "not " unless -f "afile";     
+    ok;
+    print "not " unless print $f "SomeData\n";
+    ok;
+    print "not " unless tell($f) == 9;
+    ok;
+    print "not " unless seek($f,0,0);
+    ok;
+    $b = <$f>;
+    print "not " unless $b eq "SomeData\n";
+    ok;
+    print "not " unless -f $f;     
+    ok;
+    eval  { die "Message" };   
+    # warn $@;
+    print "not " unless $@ =~ /<\$f> line 1/;
+    ok;
+    print "not " unless close($f);
+    ok;
+    unlink("afile");     
+}
+
+# 10..12
+{
+    print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile');
+    ok;
+    print $f "a row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' < 10;
+    ok;
+}
+
+# 13..15
+{
+    print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile');
+    ok;
+    print $f "a row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' > 10;
+    ok;
+}
+
+# 16..18
+{
+    print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile');
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    print "not " unless close($f);
+    ok;
+}
+
+# 19..23
+{
+    print "not " unless -s 'afile' < 20;
+    ok;
+    print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile');
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    seek $f, 0, 1;
+    print $f "yet another row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' > 20;
+    ok;
+
+    unlink("afile");     
+}
+
+# 24..26
+if ($Is_VMS) {
+    for (24..26) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+}
+else {
+    print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC');
+    ./perl -e "print qq(a row\n); print qq(another row\n)"
+EOC
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    print "not " unless close($f);
+    ok;
+}
+
+# 27..30
+if ($Is_VMS) {
+    for (27..30) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+}
+else {
+    print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC');
+    ./perl -pe "s/^not //"
+EOC
+    ok;
+    @rows = <$f>;
+    print $f "not ok $test\n"; $test++;
+    print $f "not ok $test\n"; $test++;
+    print "#\nnot " unless close($f);
+    sleep 1;
+    ok;
+}
+
+# 31..32
+eval <<'EOE' and print "not ";
+open my $f, '<&', 'afile';
+1;
+EOE
+ok;
+$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
+ok;
+
+# local $file tests
+
+# 33..41
+{
+    unlink("afile") if -f "afile";     
+    print "$!\nnot " unless open(local $f,"+>afile");
+    ok;
+    binmode $f;
+    print "not " unless -f "afile";     
+    ok;
+    print "not " unless print $f "SomeData\n";
+    ok;
+    print "not " unless tell($f) == 9;
+    ok;
+    print "not " unless seek($f,0,0);
+    ok;
+    $b = <$f>;
+    print "not " unless $b eq "SomeData\n";
+    ok;
+    print "not " unless -f $f;     
+    ok;
+    eval  { die "Message" };   
+    # warn $@;
+    print "not " unless $@ =~ /<\$f> line 1/;
+    ok;
+    print "not " unless close($f);
+    ok;
+    unlink("afile");     
+}
+
+# 42..44
+{
+    print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile');
+    ok;
+    print $f "a row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' < 10;
+    ok;
+}
+
+# 45..47
+{
+    print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile');
+    ok;
+    print $f "a row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' > 10;
+    ok;
+}
+
+# 48..50
+{
+    print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile');
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    print "not " unless close($f);
+    ok;
+}
+
+# 51..55
+{
+    print "not " unless -s 'afile' < 20;
+    ok;
+    print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile');
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    seek $f, 0, 1;
+    print $f "yet another row\n";
+    print "not " unless close($f);
+    ok;
+    print "not " unless -s 'afile' > 20;
+    ok;
+
+    unlink("afile");     
+}
+
+# 56..58
+if ($Is_VMS) {
+    for (56..58) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+}
+else {
+    print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC');
+    ./perl -e "print qq(a row\n); print qq(another row\n)"
+EOC
+    ok;
+    @rows = <$f>;
+    print "not " unless @rows == 2;
+    ok;
+    print "not " unless close($f);
+    ok;
+}
+
+# 59..62
+if ($Is_VMS) {
+    for (59..62) { print "ok $_ # skipped: not Unix fork\n"; $test++;}
+}
+else {
+    print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC');
+    ./perl -pe "s/^not //"
+EOC
+    ok;
+    @rows = <$f>;
+    print $f "not ok $test\n"; $test++;
+    print $f "not ok $test\n"; $test++;
+    print "#\nnot " unless close($f);
+    sleep 1;
+    ok;
+}
+
+# 63..64
+eval <<'EOE' and print "not ";
+open local $f, '<&', 'afile';
+1;
+EOE
+ok;
+$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not ";
+ok;
+
+# 65..66
+{
+    local *F;
+    for (1..2) {
+        open(F, "echo #foo|") or print "not ";
+	print <F>;
+	close F;
+    }
+    ok;
+    for (1..2) {
+	open(F, "-|", "echo #foo") or print "not ";
+	print <F>;
+	close F;
+    }
+    ok;
+}
diff --git a/gnu/usr.bin/perl/t/io/openpid.t b/gnu/usr.bin/perl/t/io/openpid.t
new file mode 100644
index 00000000000..80c6bde5d1f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/io/openpid.t
@@ -0,0 +1,86 @@
+#!./perl
+
+#####################################################################
+#
+# Test for process id return value from open
+# Ronald Schmidt (The Software Path) RonaldWS@software-path.com
+#
+#####################################################################
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    if ($^O eq 'dos') {
+        print "1..0 # Skip: no multitasking\n";
+        exit 0;
+    }
+}
+
+
+use FileHandle;
+use Config;
+autoflush STDOUT 1;
+$SIG{PIPE} = 'IGNORE';
+
+print "1..10\n";
+
+$perl = qq[$^X "-I../lib"];
+
+#
+# commands run 4 perl programs.  Two of these programs write a
+# short message to STDOUT and exit.  Two of these programs
+# read from STDIN.  One reader never exits and must be killed.
+# 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;"/;
+$cmd3 = qq/$perl -e "print <>;"/; # hangs waiting for end of STDIN
+$cmd4 = qq/$perl -e "print scalar <>;"/;
+
+#warn "#$cmd1\n#$cmd2\n#$cmd3\n#$cmd4\n";
+
+# start the processes
+$pid1 = open(FH1, "$cmd1 |") or print "not ";
+print "ok 1\n";
+$pid2 = open(FH2, "$cmd2 |") or print "not ";
+print "ok 2\n";
+$pid3 = open(FH3, "| $cmd3") or print "not ";
+print "ok 3\n";
+$pid4 = open(FH4, "| $cmd4") or print "not ";
+print "ok 4\n";
+
+print "# pids were $pid1, $pid2, $pid3, $pid4\n";
+
+my $killsig = 'HUP';
+$killsig = 1 unless $Config{sig_name} =~ /\bHUP\b/;
+
+# get message from first process and kill it
+chomp($from_pid1 = scalar(<FH1>));
+print "# child1 returned [$from_pid1]\nnot "
+    unless $from_pid1 eq 'first process';
+print "ok 5\n";
+$kill_cnt = kill $killsig, $pid1;
+print "not " unless $kill_cnt == 1;
+print "ok 6\n";
+
+# get message from second process and kill second process and reader process
+chomp($from_pid2 = scalar(<FH2>));
+print "# child2 returned [$from_pid2]\nnot "
+    unless $from_pid2 eq 'second process';
+print "ok 7\n";
+$kill_cnt = kill $killsig, $pid2, $pid3;
+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;
+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 "
+    unless $reap_pid == $pid4;         
+print "ok 10\n";
diff --git a/gnu/usr.bin/perl/t/lib/ansicolor.t b/gnu/usr.bin/perl/t/lib/ansicolor.t
new file mode 100644
index 00000000000..3e16dce653a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/ansicolor.t
@@ -0,0 +1,73 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+# Test suite for the Term::ANSIColor Perl module.  Before `make install' is
+# performed this script should be runnable with `make test'.  After `make
+# install' it should work as `perl test.pl'.
+
+############################################################################
+# Ensure module can be loaded
+############################################################################
+
+BEGIN { $| = 1; print "1..7\n" }
+END   { print "not ok 1\n" unless $loaded }
+use Term::ANSIColor qw(:constants color colored);
+$loaded = 1;
+print "ok 1\n";
+
+
+############################################################################
+# Test suite
+############################################################################
+
+# Test simple color attributes.
+if (color ('blue on_green', 'bold') eq "\e[34;42;1m") {
+    print "ok 2\n";
+} else {
+    print "not ok 2\n";
+}
+
+# Test colored.
+if (colored ("testing", 'blue', 'bold') eq "\e[34;1mtesting\e[0m") {
+    print "ok 3\n";
+} else {
+    print "not ok 3\n";
+}
+
+# Test the constants.
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting") {
+    print "ok 4\n";
+} else {
+    print "not ok 4\n";
+}
+
+# Test AUTORESET.
+$Term::ANSIColor::AUTORESET = 1;
+if (BLUE BOLD "testing" eq "\e[34m\e[1mtesting\e[0m\e[0m") {
+    print "ok 5\n";
+} else {
+    print "not ok 5\n";
+}
+
+# Test EACHLINE.
+$Term::ANSIColor::EACHLINE = "\n";
+if (colored ("test\n\ntest", 'bold')
+    eq "\e[1mtest\e[0m\n\n\e[1mtest\e[0m") {
+    print "ok 6\n";
+} else {
+    print colored ("test\n\ntest", 'bold'), "\n";
+    print "not ok 6\n";
+}
+
+# Test EACHLINE with multiple trailing delimiters.
+$Term::ANSIColor::EACHLINE = "\r\n";
+if (colored ("test\ntest\r\r\n\r\n", 'bold')
+    eq "\e[1mtest\ntest\r\e[0m\r\n\r\n") {
+    print "ok 7\n";
+} else {
+    print "not ok 7\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/attrs.t b/gnu/usr.bin/perl/t/lib/attrs.t
new file mode 100644
index 00000000000..eb8c8c4a1aa
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/attrs.t
@@ -0,0 +1,138 @@
+#!./perl
+
+# Regression tests for attrs.pm and the C<sub x : attrs> syntax.
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    eval 'require attrs; 1' or do {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+sub NTESTS () ;
+
+my $test, $ntests;
+BEGIN {$ntests=0}
+$test=0;
+my $failed = 0;
+
+print "1..".NTESTS."\n";
+
+eval 'sub t1 ($) { use attrs "locked"; $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t2 { use attrs "locked"; $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t3 ($) : locked ;';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub t4 : locked ;';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon1;
+eval '$anon1 = sub ($) { use attrs qw(locked method); $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon2;
+eval '$anon2 = sub { use attrs qw(locked method); $_[0]++ }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my $anon3;
+eval '$anon3 = sub { use attrs "method"; $_[0]->[1] }';
+(print "not "), $failed=1 if $@;
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+my @attrs = attrs::get($anon3 ? $anon3 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+@attrs = sort +attrs::get($anon2 ? $anon2 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "locked method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+@attrs = sort +attrs::get($anon1 ? $anon1 : \&ns);
+(print "not "), $failed=1 unless "@attrs" eq "locked method";
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e1 ($) : plugh ;';
+unless ($@ && $@ =~ m/^Invalid CODE attribute: ["']?plugh["']? at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
+unless ($@ && $@ =~ m/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
+unless ($@ && $@ =~ m/Unterminated attribute parameter in attribute list at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+eval 'sub e4 ($) : plugh + xyzzy ;';
+unless ($@ && $@ =~ m/Invalid separator character '[+]' in attribute list at/) {
+    my $x = $@;
+    $x =~ s/\n.*\z//s;
+    print "# $x\n";
+    print "not ";
+    $failed = 1;
+}
+print "ok ",++$test,"\n";
+BEGIN {++$ntests}
+
+{
+    my $w = "" ;
+    local $SIG{__WARN__} = sub {$w = @_[0]} ;
+    eval 'sub w1 ($) { use warnings "deprecated"; use attrs "locked"; $_[0]++ }';
+    (print "not "), $failed=1 if $@;
+    print "ok ",++$test,"\n";
+    BEGIN {++$ntests}
+    (print "not "), $failed=1 
+	if $w !~ /^pragma "attrs" is deprecated, use "sub NAME : ATTRS" instead at/;
+    print "ok ",++$test,"\n";
+    BEGIN {++$ntests}
+}
+
+
+# Other tests should be added above this line
+
+sub NTESTS () { $ntests }
+
+exit $failed;
diff --git a/gnu/usr.bin/perl/t/lib/bigfloat.t b/gnu/usr.bin/perl/t/lib/bigfloat.t
new file mode 100644
index 00000000000..8e0a0ef7245
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/bigfloat.t
@@ -0,0 +1,408 @@
+#!./perl
+
+BEGIN { @INC = '../lib' }
+require "bigfloat.pl";
+
+$test = 0;
+$| = 1;
+print "1..355\n";
+while (<DATA>) {
+	chop;
+	if (/^&/) {
+		$f = $_;
+	} elsif (/^\$.*/) {
+		eval "$_;";
+	} else {
+		++$test;
+		@args = split(/:/,$_,99);
+		$ans = pop(@args);
+		$try = "$f('" . join("','", @args) . "');";
+		if (($ans1 = eval($try)) eq $ans) {
+			print "ok $test\n";
+		} else {
+			print "not ok $test\n";
+			print "# '$try' expected: '$ans' got: '$ans1'\n";
+		}
+	}
+} 
+__END__
+&fnorm
+abc:NaN
+   1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+0:+0E+0
++0:+0E+0
++00:+0E+0
++0 0 0:+0E+0
+000000  0000000   00000:+0E+0
+-0:+0E+0
+-0000:+0E+0
++1:+1E+0
++01:+1E+0
++001:+1E+0
++00000100000:+1E+5
+123456789:+123456789E+0
+-1:-1E+0
+-01:-1E+0
+-001:-1E+0
+-123456789:-123456789E+0
+-00000100000:-1E+5
+123.456a:NaN
+123.456:+123456E-3
+0.01:+1E-2
+.002:+2E-3
+-0.0003:-3E-4
+-.0000000004:-4E-10
+123456E2:+123456E+2
+123456E-2:+123456E-2
+-123456E2:-123456E+2
+-123456E-2:-123456E-2
+1e1:+1E+1
+2e-11:+2E-11
+-3e111:-3E+111
+-4e-1111:-4E-1111
+&fneg
+abd:NaN
++0:+0E+0
++1:-1E+0
+-1:+1E+0
++123456789:-123456789E+0
+-123456789:+123456789E+0
++123.456789:-123456789E-6
+-123456.789:+123456789E-3
+&fabs
+abc:NaN
++0:+0E+0
++1:+1E+0
+-1:+1E+0
++123456789:+123456789E+0
+-123456789:+123456789E+0
++123.456789:+123456789E-6
+-123456.789:+123456789E-3
+&fround
+$bigfloat::rnd_mode = 'trunc'
++10123456789:5:+10123E+6
+-10123456789:5:-10123E+6
++10123456789:9:+101234567E+2
+-10123456789:9:-101234567E+2
++101234500:6:+101234E+3
+-101234500:6:-101234E+3
+$bigfloat::rnd_mode = 'zero'
++20123456789:5:+20123E+6
+-20123456789:5:-20123E+6
++20123456789:9:+201234568E+2
+-20123456789:9:-201234568E+2
++201234500:6:+201234E+3
+-201234500:6:-201234E+3
+$bigfloat::rnd_mode = '+inf'
++30123456789:5:+30123E+6
+-30123456789:5:-30123E+6
++30123456789:9:+301234568E+2
+-30123456789:9:-301234568E+2
++301234500:6:+301235E+3
+-301234500:6:-301234E+3
+$bigfloat::rnd_mode = '-inf'
++40123456789:5:+40123E+6
+-40123456789:5:-40123E+6
++40123456789:9:+401234568E+2
+-40123456789:9:-401234568E+2
++401234500:6:+401234E+3
+-401234500:6:-401235E+3
+$bigfloat::rnd_mode = 'odd'
++50123456789:5:+50123E+6
+-50123456789:5:-50123E+6
++50123456789:9:+501234568E+2
+-50123456789:9:-501234568E+2
++501234500:6:+501235E+3
+-501234500:6:-501235E+3
+$bigfloat::rnd_mode = 'even'
++60123456789:5:+60123E+6
+-60123456789:5:-60123E+6
++60123456789:9:+601234568E+2
+-60123456789:9:-601234568E+2
++601234500:6:+601234E+3
+-601234500:6:-601234E+3
+&ffround
+$bigfloat::rnd_mode = 'trunc'
++1.23:-1:+12E-1
+-1.23:-1:-12E-1
++1.27:-1:+12E-1
+-1.27:-1:-12E-1
++1.25:-1:+12E-1
+-1.25:-1:-12E-1
++1.35:-1:+13E-1
+-1.35:-1:-13E-1
+-0.006:-1:+0E+0
+-0.006:-2:+0E+0
+$bigfloat::rnd_mode = 'zero'
++2.23:-1:+22E-1
+-2.23:-1:-22E-1
++2.27:-1:+23E-1
+-2.27:-1:-23E-1
++2.25:-1:+22E-1
+-2.25:-1:-22E-1
++2.35:-1:+23E-1
+-2.35:-1:-23E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '+inf'
++3.23:-1:+32E-1
+-3.23:-1:-32E-1
++3.27:-1:+33E-1
+-3.27:-1:-33E-1
++3.25:-1:+33E-1
+-3.25:-1:-32E-1
++3.35:-1:+34E-1
+-3.35:-1:-33E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = '-inf'
++4.23:-1:+42E-1
+-4.23:-1:-42E-1
++4.27:-1:+43E-1
+-4.27:-1:-43E-1
++4.25:-1:+42E-1
+-4.25:-1:-43E-1
++4.35:-1:+43E-1
+-4.35:-1:-44E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'odd'
++5.23:-1:+52E-1
+-5.23:-1:-52E-1
++5.27:-1:+53E-1
+-5.27:-1:-53E-1
++5.25:-1:+53E-1
+-5.25:-1:-53E-1
++5.35:-1:+53E-1
+-5.35:-1:-53E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-7E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+$bigfloat::rnd_mode = 'even'
++6.23:-1:+62E-1
+-6.23:-1:-62E-1
++6.27:-1:+63E-1
+-6.27:-1:-63E-1
++6.25:-1:+62E-1
+-6.25:-1:-62E-1
++6.35:-1:+64E-1
+-6.35:-1:-64E-1
+-0.0065:-1:+0E+0
+-0.0065:-2:-1E-2
+-0.0065:-3:-6E-3
+-0.0065:-4:-65E-4
+-0.0065:-5:-65E-4
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&fadd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:+1E+0
++1:+1:+2E+0
+-1:+0:-1E+0
++0:-1:-1E+0
+-1:-1:-2E+0
+-1:+1:+0E+0
++1:-1:+0E+0
++9:+1:+1E+1
++99:+1:+1E+2
++999:+1:+1E+3
++9999:+1:+1E+4
++99999:+1:+1E+5
++999999:+1:+1E+6
++9999999:+1:+1E+7
++99999999:+1:+1E+8
++999999999:+1:+1E+9
++9999999999:+1:+1E+10
++99999999999:+1:+1E+11
++10:-1:+9E+0
++100:-1:+99E+0
++1000:-1:+999E+0
++10000:-1:+9999E+0
++100000:-1:+99999E+0
++1000000:-1:+999999E+0
++10000000:-1:+9999999E+0
++100000000:-1:+99999999E+0
++1000000000:-1:+999999999E+0
++10000000000:-1:+9999999999E+0
++123456789:+987654321:+111111111E+1
+-123456789:+987654321:+864197532E+0
+-123456789:-987654321:-111111111E+1
++123456789:-987654321:-864197532E+0
+&fsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++1:+0:+1E+0
++0:+1:-1E+0
++1:+1:+0E+0
+-1:+0:-1E+0
++0:-1:+1E+0
+-1:-1:+0E+0
+-1:+1:-2E+0
++1:-1:+2E+0
++9:+1:+8E+0
++99:+1:+98E+0
++999:+1:+998E+0
++9999:+1:+9998E+0
++99999:+1:+99998E+0
++999999:+1:+999998E+0
++9999999:+1:+9999998E+0
++99999999:+1:+99999998E+0
++999999999:+1:+999999998E+0
++9999999999:+1:+9999999998E+0
++99999999999:+1:+99999999998E+0
++10:-1:+11E+0
++100:-1:+101E+0
++1000:-1:+1001E+0
++10000:-1:+10001E+0
++100000:-1:+100001E+0
++1000000:-1:+1000001E+0
++10000000:-1:+10000001E+0
++100000000:-1:+100000001E+0
++1000000000:-1:+1000000001E+0
++10000000000:-1:+10000000001E+0
++123456789:+987654321:-864197532E+0
+-123456789:+987654321:-111111111E+1
+-123456789:-987654321:+864197532E+0
++123456789:-987654321:+111111111E+1
+&fmul
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0E+0
++0:+1:+0E+0
++1:+0:+0E+0
++0:-1:+0E+0
+-1:+0:+0E+0
++123456789123456789:+0:+0E+0
++0:+123456789123456789:+0E+0
+-1:-1:+1E+0
+-1:+1:-1E+0
++1:-1:-1E+0
++1:+1:+1E+0
++2:+3:+6E+0
+-2:+3:-6E+0
++2:-3:-6E+0
+-2:-3:+6E+0
++111:+111:+12321E+0
++10101:+10101:+102030201E+0
++1001001:+1001001:+1002003002001E+0
++100010001:+100010001:+10002000300020001E+0
++10000100001:+10000100001:+100002000030000200001E+0
++11111111111:+9:+99999999999E+0
++22222222222:+9:+199999999998E+0
++33333333333:+9:+299999999997E+0
++44444444444:+9:+399999999996E+0
++55555555555:+9:+499999999995E+0
++66666666666:+9:+599999999994E+0
++77777777777:+9:+699999999993E+0
++88888888888:+9:+799999999992E+0
++99999999999:+9:+899999999991E+0
+&fdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0E+0
++1:+0:NaN
++0:-1:+0E+0
+-1:+0:NaN
++1:+1:+1E+0
+-1:-1:+1E+0
++1:-1:-1E+0
+-1:+1:-1E+0
++1:+2:+5E-1
++2:+1:+2E+0
++10:+5:+2E+0
++100:+4:+25E+0
++1000:+8:+125E+0
++10000:+16:+625E+0
++10000:-16:-625E+0
++999999999999:+9:+111111111111E+0
++999999999999:+99:+10101010101E+0
++999999999999:+999:+1001001001E+0
++999999999999:+9999:+100010001E+0
++999999999999999:+99999:+10000100001E+0
++1000000000:+9:+1111111111111111111111111111111111111111E-31
++2000000000:+9:+2222222222222222222222222222222222222222E-31
++3000000000:+9:+3333333333333333333333333333333333333333E-31
++4000000000:+9:+4444444444444444444444444444444444444444E-31
++5000000000:+9:+5555555555555555555555555555555555555556E-31
++6000000000:+9:+6666666666666666666666666666666666666667E-31
++7000000000:+9:+7777777777777777777777777777777777777778E-31
++8000000000:+9:+8888888888888888888888888888888888888889E-31
++9000000000:+9:+1E+9
++35500000:+113:+3141592920353982300884955752212389380531E-34
++71000000:+226:+3141592920353982300884955752212389380531E-34
++106500000:+339:+3141592920353982300884955752212389380531E-34
++1000000000:+3:+3333333333333333333333333333333333333333E-31
+$bigfloat::div_scale = 20
++1000000000:+9:+11111111111111111111E-11
++2000000000:+9:+22222222222222222222E-11
++3000000000:+9:+33333333333333333333E-11
++4000000000:+9:+44444444444444444444E-11
++5000000000:+9:+55555555555555555556E-11
++6000000000:+9:+66666666666666666667E-11
++7000000000:+9:+77777777777777777778E-11
++8000000000:+9:+88888888888888888889E-11
++9000000000:+9:+1E+9
++35500000:+113:+314159292035398230088E-15
++71000000:+226:+314159292035398230088E-15
++106500000:+339:+31415929203539823009E-14
++1000000000:+3:+33333333333333333333E-11
+$bigfloat::div_scale = 40
+&fsqrt
++0:+0E+0
+-1:NaN
+-2:NaN
+-16:NaN
+-123.456:NaN
++1:+1E+0
++1.44:+12E-1
++2:+141421356237309504880168872420969807857E-38
++4:+2E+0
++16:+4E+0
++100:+1E+1
++123.456:+1111107555549866648462149404118219234119E-38
++15241.383936:+123456E-3
diff --git a/gnu/usr.bin/perl/t/lib/bigfltpm.t b/gnu/usr.bin/perl/t/lib/bigfltpm.t
new file mode 100644
index 00000000000..5d97f1b4f65
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/bigfltpm.t
@@ -0,0 +1,463 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Math::BigFloat;
+
+$test = 0;
+$| = 1;
+print "1..362\n";
+while (<DATA>) {
+       chop;
+       if (s/^&//) {
+               $f = $_;
+	} elsif (/^\$.*/) {
+		eval "$_;";
+       } else {
+               ++$test;
+	       if (m|^(.*?):(/.+)$|) {
+	           $ans = $2;
+                   @args = split(/:/,$1,99);
+	       }
+	       else {
+                   @args = split(/:/,$_,99);
+                   $ans = pop(@args);
+	       }
+               $try = "\$x = new Math::BigFloat \"$args[0]\";";
+               if ($f eq "fnorm"){
+                   $try .= "\$x+0;";
+               } elsif ($f eq "fneg") {
+                   $try .= "-\$x;";
+               } elsif ($f eq "fabs") {
+                   $try .= "abs \$x;";
+               } elsif ($f eq "fround") {
+                   $try .= "0+\$x->fround($args[1]);";
+               } elsif ($f eq "ffround") {
+                   $try .= "0+\$x->ffround($args[1]);";
+               } elsif ($f eq "fsqrt") {
+                   $try .= "0+\$x->fsqrt;";
+               } else {
+                   $try .= "\$y = new Math::BigFloat \"$args[1]\";";
+                   if ($f eq "fcmp") {
+                       $try .= "\$x <=> \$y;";
+                   } elsif ($f eq "fadd") {
+                       $try .= "\$x + \$y;";
+                   } elsif ($f eq "fsub") {
+                       $try .= "\$x - \$y;";
+                   } elsif ($f eq "fmul") {
+                       $try .= "\$x * \$y;";
+                   } elsif ($f eq "fdiv") {
+                       $try .= "\$x / \$y;";
+                   } else { warn "Unknown op"; }
+               }
+               #print ">>>",$try,"<<<\n";
+               $ans1 = eval $try;
+	       if ($ans =~ m|^/(.*)$|) {
+	           my $pat = $1;
+		   if ($ans1 =~ /$pat/) {
+                       print "ok $test\n";
+		   }
+		   else {
+                       print "not ok $test\n";
+                       print "# '$try' expected: /$pat/ got: '$ans1'\n";
+		   }
+	       }
+               elsif ("$ans1" eq $ans) { #bug!
+                       print "ok $test\n";
+               } else {
+                       print "not ok $test\n";
+                       print "# '$try' expected: '$ans' got: '$ans1'\n";
+               }
+       }
+} 
+__END__
+&fnorm
+abc:NaN.
+   1 a:NaN.
+1bcd2:NaN.
+11111b:NaN.
++1z:NaN.
+-1z:NaN.
+0:0.
++0:0.
++00:0.
++0 0 0:0.
+000000  0000000   00000:0.
+-0:0.
+-0000:0.
++1:1.
++01:1.
++001:1.
++00000100000:100000.
+123456789:123456789.
+-1:-1.
+-01:-1.
+-001:-1.
+-123456789:-123456789.
+-00000100000:-100000.
+123.456a:NaN.
+123.456:123.456
+0.01:.01
+.002:.002
+-0.0003:-.0003
+-.0000000004:-.0000000004
+123456E2:12345600.
+123456E-2:1234.56
+-123456E2:-12345600.
+-123456E-2:-1234.56
+1e1:10.
+2e-11:.00000000002
+-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000.
+-4e-1111:-.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
+&fneg
+abd:NaN.
++0:0.
++1:-1.
+-1:1.
++123456789:-123456789.
+-123456789:123456789.
++123.456789:-123.456789
+-123456.789:123456.789
+&fabs
+abc:NaN.
++0:0.
++1:1.
+-1:1.
++123456789:123456789.
+-123456789:123456789.
++123.456789:123.456789
+-123456.789:123456.789
+&fround
+$Math::BigFloat::rnd_mode = 'trunc'
++10123456789:5:10123000000
+-10123456789:5:-10123000000
++10123456789:9:10123456700
+-10123456789:9:-10123456700
++101234500:6:101234000
+-101234500:6:-101234000
+$Math::BigFloat::rnd_mode = 'zero'
++20123456789:5:20123000000
+-20123456789:5:-20123000000
++20123456789:9:20123456800
+-20123456789:9:-20123456800
++201234500:6:201234000
+-201234500:6:-201234000
+$Math::BigFloat::rnd_mode = '+inf'
++30123456789:5:30123000000
+-30123456789:5:-30123000000
++30123456789:9:30123456800
+-30123456789:9:-30123456800
++301234500:6:301235000
+-301234500:6:-301234000
+$Math::BigFloat::rnd_mode = '-inf'
++40123456789:5:40123000000
+-40123456789:5:-40123000000
++40123456789:9:40123456800
+-40123456789:9:-40123456800
++401234500:6:401234000
+-401234500:6:-401235000
+$Math::BigFloat::rnd_mode = 'odd'
++50123456789:5:50123000000
+-50123456789:5:-50123000000
++50123456789:9:50123456800
+-50123456789:9:-50123456800
++501234500:6:501235000
+-501234500:6:-501235000
+$Math::BigFloat::rnd_mode = 'even'
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601234000
+-601234500:6:-601234000
+&ffround
+$Math::BigFloat::rnd_mode = 'trunc'
++1.23:-1:1.2
+-1.23:-1:-1.2
++1.27:-1:1.2
+-1.27:-1:-1.2
++1.25:-1:1.2
+-1.25:-1:-1.2
++1.35:-1:1.3
+-1.35:-1:-1.3
+-0.006:-1:0
+-0.006:-2:0
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+$Math::BigFloat::rnd_mode = 'zero'
++2.23:-1:/2.2(?:0{5}\d+)?
+-2.23:-1:/-2.2(?:0{5}\d+)?
++2.27:-1:/2.(?:3|29{5}\d+)
+-2.27:-1:/-2.(?:3|29{5}\d+)
++2.25:-1:/2.2(?:0{5}\d+)?
+-2.25:-1:/-2.2(?:0{5}\d+)?
++2.35:-1:/2.(?:3|29{5}\d+)
+-2.35:-1:/-2.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+$Math::BigFloat::rnd_mode = '+inf'
++3.23:-1:/3.2(?:0{5}\d+)?
+-3.23:-1:/-3.2(?:0{5}\d+)?
++3.27:-1:/3.(?:3|29{5}\d+)
+-3.27:-1:/-3.(?:3|29{5}\d+)
++3.25:-1:/3.(?:3|29{5}\d+)
+-3.25:-1:/-3.2(?:0{5}\d+)?
++3.35:-1:/3.(?:4|39{5}\d+)
+-3.35:-1:/-3.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+$Math::BigFloat::rnd_mode = '-inf'
++4.23:-1:/4.2(?:0{5}\d+)?
+-4.23:-1:/-4.2(?:0{5}\d+)?
++4.27:-1:/4.(?:3|29{5}\d+)
+-4.27:-1:/-4.(?:3|29{5}\d+)
++4.25:-1:/4.2(?:0{5}\d+)?
+-4.25:-1:/-4.(?:3|29{5}\d+)
++4.35:-1:/4.(?:3|29{5}\d+)
+-4.35:-1:/-4.(?:4|39{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+$Math::BigFloat::rnd_mode = 'odd'
++5.23:-1:/5.2(?:0{5}\d+)?
+-5.23:-1:/-5.2(?:0{5}\d+)?
++5.27:-1:/5.(?:3|29{5}\d+)
+-5.27:-1:/-5.(?:3|29{5}\d+)
++5.25:-1:/5.(?:3|29{5}\d+)
+-5.25:-1:/-5.(?:3|29{5}\d+)
++5.35:-1:/5.(?:3|29{5}\d+)
+-5.35:-1:/-5.(?:3|29{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.007|-7e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+$Math::BigFloat::rnd_mode = 'even'
++6.23:-1:/6.2(?:0{5}\d+)?
+-6.23:-1:/-6.2(?:0{5}\d+)?
++6.27:-1:/6.(?:3|29{5}\d+)
+-6.27:-1:/-6.(?:3|29{5}\d+)
++6.25:-1:/6.2(?:0{5}\d+)?
+-6.25:-1:/-6.2(?:0{5}\d+)?
++6.35:-1:/6.(?:4|39{5}\d+)
+-6.35:-1:/-6.(?:4|39{5}\d+)
+-0.0065:-1:0
+-0.0065:-2:/-0\.01|-1e-02
+-0.0065:-3:/-0\.006|-6e-03
+-0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+-0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03
+&fcmp
+abc:abc:
+abc:+0:
++0:abc:
++0:+0:0
+-1:+0:-1
++0:-1:1
++1:+0:1
++0:+1:-1
+-1:+1:-1
++1:-1:1
+-1:-1:0
++1:+1:0
+-1.1:0:-1
++0:-1.1:1
++1.1:+0:1
++0:+1.1:-1
++123:+123:0
++123:+12:1
++12:+123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
++123:+124:-1
++124:+123:1
+-123:-124:1
+-124:-123:-1
+&fadd
+abc:abc:NaN.
+abc:+0:NaN.
++0:abc:NaN.
++0:+0:0.
++1:+0:1.
++0:+1:1.
++1:+1:2.
+-1:+0:-1.
++0:-1:-1.
+-1:-1:-2.
+-1:+1:0.
++1:-1:0.
++9:+1:10.
++99:+1:100.
++999:+1:1000.
++9999:+1:10000.
++99999:+1:100000.
++999999:+1:1000000.
++9999999:+1:10000000.
++99999999:+1:100000000.
++999999999:+1:1000000000.
++9999999999:+1:10000000000.
++99999999999:+1:100000000000.
++10:-1:9.
++100:-1:99.
++1000:-1:999.
++10000:-1:9999.
++100000:-1:99999.
++1000000:-1:999999.
++10000000:-1:9999999.
++100000000:-1:99999999.
++1000000000:-1:999999999.
++10000000000:-1:9999999999.
++123456789:+987654321:1111111110.
+-123456789:+987654321:864197532.
+-123456789:-987654321:-1111111110.
++123456789:-987654321:-864197532.
+&fsub
+abc:abc:NaN.
+abc:+0:NaN.
++0:abc:NaN.
++0:+0:0.
++1:+0:1.
++0:+1:-1.
++1:+1:0.
+-1:+0:-1.
++0:-1:1.
+-1:-1:0.
+-1:+1:-2.
++1:-1:2.
++9:+1:8.
++99:+1:98.
++999:+1:998.
++9999:+1:9998.
++99999:+1:99998.
++999999:+1:999998.
++9999999:+1:9999998.
++99999999:+1:99999998.
++999999999:+1:999999998.
++9999999999:+1:9999999998.
++99999999999:+1:99999999998.
++10:-1:11.
++100:-1:101.
++1000:-1:1001.
++10000:-1:10001.
++100000:-1:100001.
++1000000:-1:1000001.
++10000000:-1:10000001.
++100000000:-1:100000001.
++1000000000:-1:1000000001.
++10000000000:-1:10000000001.
++123456789:+987654321:-864197532.
+-123456789:+987654321:-1111111110.
+-123456789:-987654321:864197532.
++123456789:-987654321:1111111110.
+&fmul
+abc:abc:NaN.
+abc:+0:NaN.
++0:abc:NaN.
++0:+0:0.
++0:+1:0.
++1:+0:0.
++0:-1:0.
+-1:+0:0.
++123456789123456789:+0:0.
++0:+123456789123456789:0.
+-1:-1:1.
+-1:+1:-1.
++1:-1:-1.
++1:+1:1.
++2:+3:6.
+-2:+3:-6.
++2:-3:-6.
+-2:-3:6.
++111:+111:12321.
++10101:+10101:102030201.
++1001001:+1001001:1002003002001.
++100010001:+100010001:10002000300020001.
++10000100001:+10000100001:100002000030000200001.
++11111111111:+9:99999999999.
++22222222222:+9:199999999998.
++33333333333:+9:299999999997.
++44444444444:+9:399999999996.
++55555555555:+9:499999999995.
++66666666666:+9:599999999994.
++77777777777:+9:699999999993.
++88888888888:+9:799999999992.
++99999999999:+9:899999999991.
+&fdiv
+abc:abc:NaN.
+abc:+1:abc:NaN.
++1:abc:NaN.
++0:+0:NaN.
++0:+1:0.
++1:+0:NaN.
++0:-1:0.
+-1:+0:NaN.
++1:+1:1.
+-1:-1:1.
++1:-1:-1.
+-1:+1:-1.
++1:+2:.5
++2:+1:2.
++10:+5:2.
++100:+4:25.
++1000:+8:125.
++10000:+16:625.
++10000:-16:-625.
++999999999999:+9:111111111111.
++999999999999:+99:10101010101.
++999999999999:+999:1001001001.
++999999999999:+9999:100010001.
++999999999999999:+99999:10000100001.
++1000000000:+9:111111111.1111111111111111111111111111111
++2000000000:+9:222222222.2222222222222222222222222222222
++3000000000:+9:333333333.3333333333333333333333333333333
++4000000000:+9:444444444.4444444444444444444444444444444
++5000000000:+9:555555555.5555555555555555555555555555556
++6000000000:+9:666666666.6666666666666666666666666666667
++7000000000:+9:777777777.7777777777777777777777777777778
++8000000000:+9:888888888.8888888888888888888888888888889
++9000000000:+9:1000000000.
++35500000:+113:314159.2920353982300884955752212389380531
++71000000:+226:314159.2920353982300884955752212389380531
++106500000:+339:314159.2920353982300884955752212389380531
++1000000000:+3:333333333.3333333333333333333333333333333
+$Math::BigFloat::div_scale = 20
++1000000000:+9:111111111.11111111111
++2000000000:+9:222222222.22222222222
++3000000000:+9:333333333.33333333333
++4000000000:+9:444444444.44444444444
++5000000000:+9:555555555.55555555556
++6000000000:+9:666666666.66666666667
++7000000000:+9:777777777.77777777778
++8000000000:+9:888888888.88888888889
++9000000000:+9:1000000000.
++35500000:+113:314159.292035398230088
++71000000:+226:314159.292035398230088
++106500000:+339:314159.29203539823009
++1000000000:+3:333333333.33333333333
+$Math::BigFloat::div_scale = 40
+&fsqrt
++0:0
+-1:/^(?i:0|\?|NaNQ?)$
+-2:/^(?i:0|\?|NaNQ?)$
+-16:/^(?i:0|\?|NaNQ?)$
+-123.456:/^(?i:0|\?|NaNQ?)$
++1:1.
++1.44:1.2
++2:1.41421356237309504880168872420969807857
++4:2.
++16:4.
++100:10.
++123.456:11.11107555549866648462149404118219234119
++15241.383936:123.456
diff --git a/gnu/usr.bin/perl/t/lib/charnames.t b/gnu/usr.bin/perl/t/lib/charnames.t
new file mode 100644
index 00000000000..76433901267
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/charnames.t
@@ -0,0 +1,74 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	unshift @INC, '../lib' if -d '../lib';
+    }
+}
+
+$| = 1;
+print "1..12\n";
+
+use charnames ':full';
+
+print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?";
+print "ok 1\n";
+
+{
+  use bytes;			# UTEST can switch utf8 on
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames ":full";
+"Here: \N{CYRILLIC SMALL LETTER BE}!";
+1
+EOE
+      or $@ !~ /above 0xFF/;
+  print "ok 2\n";
+  # print "# \$res=$res \$\@='$@'\n";
+
+  print "# \$res=$res \$\@='$@'\nnot "
+    if $res = eval <<'EOE'
+use charnames 'cyrillic';
+"Here: \N{Be}!";
+1
+EOE
+      or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/;
+  print "ok 3\n";
+}
+
+# If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt
+$encoded_be = "\320\261";
+$encoded_alpha = "\316\261";
+$encoded_bet = "\327\221";
+{
+  use charnames ':full';
+
+  print "not " unless "\N{CYRILLIC SMALL LETTER BE}" eq $encoded_be;
+  print "ok 4\n";
+
+  use charnames qw(cyrillic greek :short);
+
+  print "not " unless "\N{be},\N{alpha},\N{hebrew:bet}" 
+    eq "$encoded_be,$encoded_alpha,$encoded_bet";
+  print "ok 5\n";
+}
+
+{
+    use charnames ':full';
+    print "not " unless "\x{263a}" eq "\N{WHITE SMILING FACE}";
+    print "ok 6\n";
+    print "not " unless length("\x{263a}") == 1;
+    print "ok 7\n";
+    print "not " unless length("\N{WHITE SMILING FACE}") == 1;
+    print "ok 8\n";
+    print "not " unless sprintf("%vx", "\x{263a}") eq "263a";
+    print "ok 9\n";
+    print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
+    print "ok 10\n";
+    print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 11\n";
+    print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 12\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/dprof.t b/gnu/usr.bin/perl/t/lib/dprof.t
new file mode 100644
index 00000000000..4d6f7823c3c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof.t
@@ -0,0 +1,80 @@
+#!perl
+
+BEGIN {
+    chdir( 't' ) if -d 't';
+    unshift @INC, '../lib';
+}
+
+END {
+    unlink 'tmon.out', 'err';
+}
+
+use Benchmark qw( timediff timestr );
+use Getopt::Std 'getopts';
+use Config '%Config';
+getopts('vI:p:');
+
+# -v   Verbose
+# -I   Add to @INC
+# -p   Name of perl binary
+
+@tests = @ARGV ? @ARGV : sort <lib/dprof/*_t lib/dprof/*_v>;  # glob-sort, for OS/2
+
+$path_sep = $Config{path_sep} || ':';
+$perl5lib = $opt_I || join( $path_sep, @INC );
+$perl = $opt_p || $^X;
+
+if( $opt_v ){
+	print "tests: @tests\n";
+	print "perl: $perl\n";
+	print "perl5lib: $perl5lib\n";
+}
+if( $perl =~ m|^\./| ){
+	# turn ./perl into ../perl, because of chdir(t) above.
+	$perl = ".$perl";
+}
+if( ! -f $perl ){ die "Where's Perl?" }
+
+sub profile {
+	my $test = shift;
+	my @results;
+	local $ENV{PERL5LIB} = $perl5lib;
+	my $opt_d = '-d:DProf';
+
+	my $t_start = new Benchmark;
+	open( R, "$perl $opt_d $test |" ) || warn "$0: Can't run. $!\n";
+	@results = <R>;
+	close R;
+	my $t_total = timediff( new Benchmark, $t_start );
+
+	if( $opt_v ){
+		print "\n";
+		print @results
+	}
+
+	print timestr( $t_total, 'nop' ), "\n";
+}
+
+
+sub verify {
+	my $test = shift;
+
+	system $perl, '-I../lib', '-I./lib/dprof', $test,
+		$opt_v?'-v':'', '-p', $perl;
+}
+
+
+$| = 1;
+print "1..18\n";
+while( @tests ){
+	$test = shift @tests;
+	if( $test =~ /_t$/i ){
+		print "# $test" . '.' x (20 - length $test);
+		profile $test;
+	}
+	else{
+		verify $test;
+	}
+}
+
+unlink("tmon.out");
diff --git a/gnu/usr.bin/perl/t/lib/dprof/V.pm b/gnu/usr.bin/perl/t/lib/dprof/V.pm
new file mode 100644
index 00000000000..7e34da5d47c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/V.pm
@@ -0,0 +1,59 @@
+package V;
+
+use Getopt::Std 'getopts';
+getopts('vp:d:');
+
+require Exporter;
+@ISA = 'Exporter';
+
+@EXPORT = qw( dprofpp $opt_v $results $expected report @results );
+@EXPORT_OK = qw( notok ok $num );
+
+$num = 0;
+$results = $expected = '';
+$perl = $opt_p || $^X;
+$dpp = $opt_d || '../utils/dprofpp';
+
+print "\nperl: $perl\n" if $opt_v;
+if( ! -f $perl ){ die "Where's Perl?" }
+if( ! -f $dpp ){ die "Where's dprofpp?" }
+
+sub dprofpp {
+	my $switches = shift;
+
+	open( D, "$perl -I../lib $dpp $switches 2> err |" ) || warn "$0: Can't run. $!\n";
+	@results = <D>;
+	close D;
+
+	open( D, "<err" ) || warn "$0: Can't open: $!\n";
+	@err = <D>;
+	close D;
+	push( @results, @err ) if @err;
+
+	$results = qq{@results};
+	# ignore Loader (Dyna/Auto etc), leave newline
+	$results =~ s/^\w+Loader::import//;
+	$results =~ s/\n /\n/gm;
+	$results;
+}
+
+sub report {
+	$num = shift;
+	my $sub = shift;
+	my $x;
+
+	$x = &$sub;
+	$x ? &ok : &notok;
+}
+
+sub ok {
+	print "ok $num\n";
+}
+
+sub notok {
+	print "not ok $num\n";
+	print "\nResult\n{$results}\n";
+	print "Expected\n{$expected}\n";
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test1_t b/gnu/usr.bin/perl/t/lib/dprof/test1_t
new file mode 100644
index 00000000000..d504cd55365
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test1_t
@@ -0,0 +1,18 @@
+sub foo {
+	print "in sub foo\n";
+	bar();
+}
+
+sub bar {
+	print "in sub bar\n";
+}
+
+sub baz {
+	print "in sub baz\n";
+	bar();
+	foo();
+}
+
+bar();
+baz();
+foo();
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test1_v b/gnu/usr.bin/perl/t/lib/dprof/test1_v
new file mode 100644
index 00000000000..542a503414e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test1_v
@@ -0,0 +1,24 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected = 
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 1, sub { $expected eq $results };
+
+dprofpp('-TF');
+report 2, sub { $expected eq $results };
+
+dprofpp( '-t' );
+report 3, sub { $expected eq $results };
+
+dprofpp('-tF');
+report 4, sub { $expected eq $results };
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test2_t b/gnu/usr.bin/perl/t/lib/dprof/test2_t
new file mode 100644
index 00000000000..edc46c527e6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test2_t
@@ -0,0 +1,21 @@
+sub foo {
+	print "in sub foo\n";
+	bar();
+}
+
+sub bar {
+	print "in sub bar\n";
+}
+
+sub baz {
+	print "in sub baz\n";
+	bar();
+	bar();
+	bar();
+	foo();
+}
+
+bar();
+bar();
+baz();
+foo();
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test2_v b/gnu/usr.bin/perl/t/lib/dprof/test2_v
new file mode 100644
index 00000000000..8b775b31315
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test2_v
@@ -0,0 +1,36 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::bar
+main::bar
+main::baz
+   main::bar
+   main::bar
+   main::bar
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 5, sub { $expected eq $results };
+
+dprofpp('-TF');
+report 6, sub { $expected eq $results };
+
+dprofpp( '-t' );
+$expected =
+qq{main::bar (2x)
+main::baz
+   main::bar (3x)
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 7, sub { $expected eq $results };
+
+dprofpp('-tF');
+report 8, sub { $expected eq $results };
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test3_t b/gnu/usr.bin/perl/t/lib/dprof/test3_t
new file mode 100644
index 00000000000..a5327f4d7ad
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test3_t
@@ -0,0 +1,19 @@
+sub foo {
+	print "in sub foo\n";
+	exit(0);
+	bar();
+}
+
+sub bar {
+	print "in sub bar\n";
+}
+
+sub baz {
+	print "in sub baz\n";
+	bar();
+	foo();
+}
+
+bar();
+baz();
+foo();
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test3_v b/gnu/usr.bin/perl/t/lib/dprof/test3_v
new file mode 100644
index 00000000000..df7543e2b80
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test3_v
@@ -0,0 +1,29 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$e1 = $expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+};
+report 9, sub { $expected eq $results };
+
+dprofpp('-TF');
+$e2 = $expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+};
+report 10, sub { $expected eq $results };
+
+dprofpp( '-t' );
+$expected = $e1;
+report 11, sub { 1 };
+
+dprofpp('-tF');
+$expected = $e2;
+report 12, sub { $expected eq $results };
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test4_t b/gnu/usr.bin/perl/t/lib/dprof/test4_t
new file mode 100644
index 00000000000..729968270aa
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test4_t
@@ -0,0 +1,24 @@
+sub foo {
+	print "in sub foo\n";
+	bar();
+}
+
+sub bar {
+	print "in sub bar\n";
+}
+
+sub baz {
+	print "in sub baz\n";
+	bar();
+	bar();
+	bar();
+	foo();
+}
+
+bar();
+
+eval { fork };
+
+bar();
+baz();
+foo();
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test4_v b/gnu/usr.bin/perl/t/lib/dprof/test4_v
new file mode 100644
index 00000000000..d9677ff7853
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test4_v
@@ -0,0 +1,36 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::bar
+main::bar
+main::baz
+   main::bar
+   main::bar
+   main::bar
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 13, sub { $expected eq $results };
+
+dprofpp('-TF');
+report 14, sub { $expected eq $results };
+
+dprofpp( '-t' );
+$expected =
+qq{main::bar (2x)
+main::baz
+   main::bar (3x)
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 15, sub { $expected eq $results };
+
+dprofpp('-tF');
+report 16, sub { $expected eq $results };
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test5_t b/gnu/usr.bin/perl/t/lib/dprof/test5_t
new file mode 100644
index 00000000000..0b1113757fd
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test5_t
@@ -0,0 +1,25 @@
+# Test that dprof doesn't break
+#    &bar;  used as &bar(@_);
+
+sub foo1 {
+	print "in foo1(@_)\n";
+	bar(@_);
+}
+sub foo2 {
+	print "in foo2(@_)\n";
+	&bar;
+}
+sub bar {
+	print "in bar(@_)\n";
+	if( @_ > 0 ){
+		&yeppers;
+	}
+}
+sub yeppers {
+	print "rest easy\n";
+}
+
+
+&foo1( A );
+&foo2( B );
+
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test5_v b/gnu/usr.bin/perl/t/lib/dprof/test5_v
new file mode 100644
index 00000000000..9e9298c6896
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test5_v
@@ -0,0 +1,15 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::foo1
+   main::bar
+      main::yeppers
+main::foo2
+   main::bar
+      main::yeppers
+};
+report 17, sub { $expected eq $results };
+
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test6_t b/gnu/usr.bin/perl/t/lib/dprof/test6_t
new file mode 100644
index 00000000000..7b8bf4a722b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test6_t
@@ -0,0 +1,29 @@
+sub foo {
+	my $x;
+	my $y;
+	print "in sub foo\n";
+	for( $x = 1; $x < 100; ++$x ){
+		bar();
+		for( $y = 1; $y < 100; ++$y ){
+		}
+	}
+}
+
+sub bar {
+	my $x;
+	print "in sub bar\n";
+	for( $x = 1; $x < 100; ++$x ){
+	}
+	die "bar exiting";
+}
+
+sub baz {
+	print "in sub baz\n";
+	eval { bar(); };
+	eval { foo(); };
+}
+
+eval { bar(); };
+baz();
+eval { foo(); };
+
diff --git a/gnu/usr.bin/perl/t/lib/dprof/test6_v b/gnu/usr.bin/perl/t/lib/dprof/test6_v
new file mode 100644
index 00000000000..2f651ea7945
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof/test6_v
@@ -0,0 +1,16 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 18, sub { $expected eq $results };
+
diff --git a/gnu/usr.bin/perl/t/lib/env-array.t b/gnu/usr.bin/perl/t/lib/env-array.t
new file mode 100644
index 00000000000..d90d89226f7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/env-array.t
@@ -0,0 +1,100 @@
+#!./perl
+
+$| = 1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+if ($^O eq 'VMS') {
+    print "1..11\n";
+    foreach (1..11) { print "ok $_ # skipped for VMS\n"; }
+    exit 0;
+}
+
+use Env  qw(@FOO);
+use vars qw(@BAR);
+
+sub array_equal
+{
+    my ($a, $b) = @_;
+    return 0 unless scalar(@$a) == scalar(@$b);
+    for my $i (0..scalar(@$a) - 1) {
+	return 0 unless $a->[$i] eq $b->[$i];
+    }
+    return 1;
+}
+
+sub test
+{
+    my ($desc, $code) = @_;
+
+    &$code;
+
+    print "# $desc...\n";
+    print "#    FOO = (", join(", ", @FOO), ")\n";
+    print "#    BAR = (", join(", ", @BAR), ")\n";
+
+    if (defined $check) { print "not " unless &$check; }
+    else { print "not " unless array_equal(\@FOO, \@BAR); }
+
+    print "ok ", ++$i, "\n";
+}
+
+print "1..11\n";
+
+test "Assignment", sub {
+    @FOO = qw(a B c);
+    @BAR = qw(a B c);
+};
+
+test "Storing", sub {
+    $FOO[1] = 'b';
+    $BAR[1] = 'b';
+};
+
+test "Truncation", sub {
+    $#FOO = 0;
+    $#BAR = 0;
+};
+
+test "Push", sub {
+    push @FOO, 'b', 'c';
+    push @BAR, 'b', 'c';
+};
+
+test "Pop", sub {
+    pop @FOO;
+    pop @BAR;
+};
+
+test "Shift", sub {
+    shift @FOO;
+    shift @BAR;
+};
+
+test "Push", sub {
+    push @FOO, 'c';
+    push @BAR, 'c';
+};
+
+test "Unshift", sub {
+    unshift @FOO, 'a';
+    unshift @BAR, 'a';
+};
+
+test "Reverse", sub {
+    @FOO = reverse @FOO;
+    @BAR = reverse @BAR;
+};
+
+test "Sort", sub {
+    @FOO = sort @FOO;
+    @BAR = sort @BAR;
+};
+
+test "Splice", sub {
+    splice @FOO, 1, 1, 'B';
+    splice @BAR, 1, 1, 'B';
+};
diff --git a/gnu/usr.bin/perl/t/lib/filefunc.t b/gnu/usr.bin/perl/t/lib/filefunc.t
new file mode 100644
index 00000000000..46a1e35774a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/filefunc.t
@@ -0,0 +1,17 @@
+#!./perl
+
+BEGIN {
+    $^O = '';
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+print "1..1\n";
+
+use File::Spec::Functions;
+
+if (catfile('a','b','c') eq 'a/b/c') {
+    print "ok 1\n";
+} else {
+    print "not ok 1\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/glob-basic.t b/gnu/usr.bin/perl/t/lib/glob-basic.t
new file mode 100644
index 00000000000..47280831a9e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/glob-basic.t
@@ -0,0 +1,119 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..9\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob ':glob';
+use Cwd ();
+$loaded = 1;
+print "ok 1\n";
+
+sub array {
+    return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
+}
+
+# look for the contents of the current directory
+$ENV{PATH} = "/bin";
+delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
+@correct = ();
+if (opendir(D, ".")) {
+   @correct = grep { !/^\.\.?$/ } sort readdir(D);
+   closedir D;
+}
+@a = File::Glob::glob("*", 0);
+@a = sort @a;
+if ("@a" ne "@correct" || GLOB_ERROR) {
+    print "# |@a| ne |@correct|\nnot ";
+}
+print "ok 2\n";
+
+# look up the user's home directory
+# should return a list with one item, and not set ERROR
+if ($^O ne 'MSWin32' || $^O ne 'VMS') {
+  eval {
+    ($name, $home) = (getpwuid($>))[0,7];
+    1;
+  } and do {
+    @a = File::Glob::glob("~$name", GLOB_TILDE);
+    if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
+	print "not ";
+    }
+  };
+}
+print "ok 3\n";
+
+# check backslashing
+# should return a list with one item, and not set ERROR
+@a = File::Glob::glob('TEST', GLOB_QUOTE);
+if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
+    local $/ = "][";
+    print "# [@a]\n";
+    print "not ";
+}
+print "ok 4\n";
+
+# check nonexistent checks
+# should return an empty list
+# XXX since errfunc is NULL on win32, this test is not valid there
+@a = File::Glob::glob("asdfasdf", 0);
+if ($^O ne 'MSWin32' and scalar @a != 0) {
+    print "# |@a|\nnot ";
+}
+print "ok 5\n";
+
+# check bad protections
+# should return an empty list, and set ERROR
+if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or $^O eq 'VMS'
+    or $^O eq 'cygwin' or Cwd::cwd() =~ m#^/afs#s or not $>)
+{
+    print "ok 6 # skipped\n";
+}
+else {
+    $dir = "PtEeRsLt.dir";
+    mkdir $dir, 0;
+    @a = File::Glob::glob("$dir/*", GLOB_ERR);
+    #print "\@a = ", array(@a);
+    rmdir $dir;
+    if (scalar(@a) != 0 || GLOB_ERROR == 0) {
+	print "not ";
+    }
+    print "ok 6\n";
+}
+
+# check for csh style globbing
+@a = File::Glob::glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
+unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
+    print "not ";
+}
+print "ok 7\n";
+
+@a = File::Glob::glob(
+    '{TES*,doesntexist*,a,b}',
+    GLOB_BRACE | GLOB_NOMAGIC
+);
+unless (@a == 3
+        and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
+        and $a[1] eq 'a'
+        and $a[2] eq 'b')
+{
+    print "not ";
+}
+print "ok 8\n";
+
+# "~" should expand to $ENV{HOME}
+$ENV{HOME} = "sweet home";
+@a = File::Glob::glob('~', GLOB_TILDE | GLOB_NOMAGIC);
+unless (@a == 1 and $a[0] eq $ENV{HOME}) {
+    print "not ";
+}
+print "ok 9\n";
diff --git a/gnu/usr.bin/perl/t/lib/glob-case.t b/gnu/usr.bin/perl/t/lib/glob-case.t
new file mode 100644
index 00000000000..32719b2d9ac
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/glob-case.t
@@ -0,0 +1,53 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..7\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob qw(:glob csh_glob);
+$loaded = 1;
+print "ok 1\n";
+
+# Test the actual use of the case sensitivity tags, via csh_glob()
+import File::Glob ':nocase';
+@a = csh_glob("lib/G*.t"); # At least glob-basic.t glob-case.t glob-global.t
+print "not " unless @a >= 3;
+print "ok 2\n";
+
+# This may fail on systems which are not case-PRESERVING
+import File::Glob ':case';
+@a = csh_glob("lib/G*.t"); # None should be uppercase
+print "not " unless @a == 0;
+print "ok 3\n";
+
+# Test the explicit use of the GLOB_NOCASE flag
+@a = File::Glob::glob("lib/G*.t", GLOB_NOCASE);
+print "not " unless @a >= 3;
+print "ok 4\n";
+
+# Test Win32 backslash nastiness...
+if ($^O ne 'MSWin32') {
+    print "ok 5\nok 6\nok 7\n";
+}
+else {
+    @a = File::Glob::glob("lib\\g*.t");
+    print "not " unless @a >= 3;
+    print "ok 5\n";
+    mkdir "[]", 0;
+    @a = File::Glob::glob("\\[\\]", GLOB_QUOTE);
+    rmdir "[]";
+    print "# returned @a\nnot " unless @a == 1;
+    print "ok 6\n";
+    @a = File::Glob::glob("lib\\*", GLOB_QUOTE);
+    print "not " if @a == 0;
+    print "ok 7\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/glob-global.t b/gnu/usr.bin/perl/t/lib/glob-global.t
new file mode 100644
index 00000000000..9d273bd1ed1
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/glob-global.t
@@ -0,0 +1,110 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..10\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+
+BEGIN {
+    *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
+}
+
+BEGIN {
+    if ("Just another Perl hacker," ne (<*>)[0]) {
+        die <<EOMessage;
+Your version of perl ($]) doesn't seem to allow extensions to override
+the core glob operator.
+EOMessage
+    }
+}
+
+use File::Glob ':globally';
+$loaded = 1;
+print "ok 1\n";
+
+$_ = "lib/*.t";
+my @r = glob;
+print "not " if $_ ne 'lib/*.t';
+print "ok 2\n";
+
+# we should have at least basic.t, global.t, taint.t
+print "# |@r|\nnot " if @r < 3;
+print "ok 3\n";
+
+# check if <*/*> works
+@r = <*/*.t>;
+# at least t/global.t t/basic.t, t/taint.t
+print "not " if @r < 3;
+print "ok 4\n";
+my $r = scalar @r;
+
+# check if scalar context works
+@r = ();
+while (defined($_ = <*/*.t>)) {
+    #print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# check if array context works
+@r = ();
+for (<*/*.t>) {
+    #print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+while (<*/*.t>) {
+    #print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 7\n";
+
+# test if explicit glob() gets assign magic too
+my @s = ();
+while (glob '*/*.t') {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 8\n";
+
+# how about in a different package, like?
+package Foo;
+use File::Glob ':globally';
+@s = ();
+while (glob '*/*.t') {
+    #print "# $_\n";
+    push @s, $_;
+}
+print "not " if "@r" ne "@s";
+print "ok 9\n";
+
+# test if different glob ops maintain independent contexts
+@s = ();
+my $i = 0;
+while (<*/*.t>) {
+    #print "# $_ <";
+    push @s, $_;
+    while (<bas*/*.t>) {
+        #print " $_";
+        $i++;
+    }
+    #print " >\n";
+}
+print "not " if "@r" ne "@s" or not $i;
+print "ok 10\n";
diff --git a/gnu/usr.bin/perl/t/lib/glob-taint.t b/gnu/usr.bin/perl/t/lib/glob-taint.t
new file mode 100644
index 00000000000..a8dc2138530
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/glob-taint.t
@@ -0,0 +1,26 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
+        print "1..0\n";
+        exit 0;
+    }
+    print "1..2\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob;
+$loaded = 1;
+print "ok 1\n";
+
+# all filenames should be tainted
+@a = File::Glob::glob("*");
+eval { $a = join("",@a), kill 0; 1 };
+unless ($@ =~ /Insecure dependency/) {
+    print "not ";
+}
+print "ok 2\n";
diff --git a/gnu/usr.bin/perl/t/lib/gol-basic.t b/gnu/usr.bin/perl/t/lib/gol-basic.t
new file mode 100644
index 00000000000..4b25322336f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gol-basic.t
@@ -0,0 +1,24 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+use Getopt::Long 2.17;
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("no_ignore_case");
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if GetOptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/gnu/usr.bin/perl/t/lib/gol-compat.t b/gnu/usr.bin/perl/t/lib/gol-compat.t
new file mode 100644
index 00000000000..a4f807c7dd4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gol-compat.t
@@ -0,0 +1,25 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+require "newgetopt.pl";
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+$newgetopt::ignorecase = 0;
+$newgetopt::ignorecase = 0;
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if NGetOpt ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/gnu/usr.bin/perl/t/lib/gol-linkage.t b/gnu/usr.bin/perl/t/lib/gol-linkage.t
new file mode 100644
index 00000000000..a1b2c05be37
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/gol-linkage.t
@@ -0,0 +1,37 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+use Getopt::Long;
+
+print "1..18\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("no_ignore_case");
+%lnk = ();
+print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s");
+print ((defined $lnk{foo})   ? "" : "not ", "ok 2\n");
+print (($lnk{foo} == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 4\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 7\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 8\n");
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("default","no_ignore_case");
+%lnk = ();
+my $foo;
+print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s");
+print ((defined $foo)        ? "" : "not ", "ok 10\n");
+print (($foo == 1)           ? "" : "not ", "ok 11\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 12\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 14\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");
diff --git a/gnu/usr.bin/perl/t/lib/io_const.t b/gnu/usr.bin/perl/t/lib/io_const.t
new file mode 100644
index 00000000000..48cb6b5dc83
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_const.t
@@ -0,0 +1,33 @@
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	unshift @INC, '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+        if ($Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
+	    print "1..0\n";
+	    exit 0;
+        }
+    }
+}
+
+use IO::Handle;
+
+print "1..6\n";
+my $i = 1;
+foreach (qw(SEEK_SET SEEK_CUR SEEK_END     _IOFBF    _IOLBF    _IONBF)) {
+    my $d1 = defined(&{"IO::Handle::" . $_}) ? 1 : 0;
+    my $v1 = $d1 ? &{"IO::Handle::" . $_}() : undef;
+    my $v2 = IO::Handle::constant($_);
+    my $d2 = defined($v2);
+
+    print "not "
+	if($d1 != $d2 || ($d1 && ($v1 != $v2)));
+    print "ok ",$i++,"\n";
+}
diff --git a/gnu/usr.bin/perl/t/lib/io_dir.t b/gnu/usr.bin/perl/t/lib/io_dir.t
new file mode 100644
index 00000000000..11ec8bcbf92
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_dir.t
@@ -0,0 +1,66 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        unshift @INC, '../lib' if -d '../lib';
+    }
+    require Config; import Config;
+    if ($] < 5.00326 || not $Config{'d_readdir'}) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+use IO::Dir qw(DIR_UNLINK);
+
+print "1..10\n";
+
+$dot = new IO::Dir ".";
+print defined($dot) ? "ok" : "not ok", " 1\n";
+
+@a = sort <*>;
+do { $first = $dot->read } while defined($first) && $first =~ /^\./;
+print +(grep { $_ eq $first } @a) ? "ok" : "not ok", " 2\n";
+
+@b = sort($first, (grep {/^[^.]/} $dot->read));
+print +(join("\0", @a) eq join("\0", @b)) ? "ok" : "not ok", " 3\n";
+
+$dot->rewind;
+@c = sort grep {/^[^.]/} $dot->read;
+print +(join("\0", @b) eq join("\0", @c)) ? "ok" : "not ok", " 4\n";
+
+$dot->close;
+$dot->rewind;
+print defined($dot->read) ? "not ok" : "ok", " 5\n";
+
+open(FH,'>X') || die "Can't create x";
+print FH "X";
+close(FH);
+
+tie %dir, IO::Dir, ".";
+my @files = keys %dir;
+
+# I hope we do not have an empty dir :-)
+print @files ? "ok" : "not ok", " 6\n";
+
+my $stat = $dir{'X'};
+print defined($stat) && UNIVERSAL::isa($stat,'File::stat') && $stat->size == 1
+	? "ok" : "not ok", " 7\n";
+
+delete $dir{'X'};
+
+print -f 'X' ? "ok" : "not ok", " 8\n";
+
+tie %dirx, IO::Dir, ".", DIR_UNLINK;
+
+my $statx = $dirx{'X'};
+print defined($statx) && UNIVERSAL::isa($statx,'File::stat') && $statx->size == 1
+	? "ok" : "not ok", " 9\n";
+
+delete $dirx{'X'};
+
+print -f 'X' ? "not ok" : "ok", " 10\n";
diff --git a/gnu/usr.bin/perl/t/lib/io_linenum.t b/gnu/usr.bin/perl/t/lib/io_linenum.t
new file mode 100644
index 00000000000..35032152014
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_linenum.t
@@ -0,0 +1,80 @@
+#!./perl
+
+# test added 29th April 1999 by Paul Johnson (pjcj@transeda.com)
+# updated    28th May   1999 by Paul Johnson
+
+my $File;
+
+BEGIN
+{
+  $File = __FILE__;
+  if (-d 't')
+  {
+    chdir 't';
+    $File =~ s/^t\W+//;                                 # Remove first directory
+  }
+  unshift @INC, '../lib' if -d '../lib';
+  require strict; import strict;
+}
+
+use Test;
+
+BEGIN { plan tests => 12 }
+
+use IO::File;
+
+sub lineno
+{
+  my ($f) = @_;
+  my $l;
+  $l .= "$. ";
+  $l .= $f->input_line_number;
+  $l .= " $.";                     # check $. before and after input_line_number
+  $l;
+}
+
+my $t;
+
+open (F, $File) or die $!;
+my $io = IO::File->new($File) or die $!;
+
+<F> for (1 .. 10);
+ok(lineno($io), "10 0 10");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "5 5 5");
+
+<F>;
+ok(lineno($io), "11 5 11");
+
+$io->getline;
+ok(lineno($io), "6 6 6");
+
+$t = tell F;                                        # tell F; provokes a warning
+ok(lineno($io), "11 6 11");
+
+<F>;
+ok(lineno($io), "12 6 12");
+
+select F;
+ok(lineno($io), "12 6 12");
+
+<F> for (1 .. 10);
+ok(lineno($io), "22 6 22");
+
+$io->getline for (1 .. 5);
+ok(lineno($io), "11 11 11");
+
+$t = tell F;
+# We used to have problems here before local $. worked.
+# input_line_number() used to use select and tell.  When we did the
+# same, that mechanism broke.  It should work now.
+ok(lineno($io), "22 11 22");
+
+{
+  local $.;
+  $io->getline for (1 .. 5);
+  ok(lineno($io), "16 16 16");
+}
+
+ok(lineno($io), "22 16 22");
diff --git a/gnu/usr.bin/perl/t/lib/io_multihomed.t b/gnu/usr.bin/perl/t/lib/io_multihomed.t
new file mode 100644
index 00000000000..7337a5f8d6b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_multihomed.t
@@ -0,0 +1,124 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+	chdir 't' if -d 't';
+	unshift @INC, '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+	my $reason;
+	if (! $Config{'d_fork'}) {
+	    $reason = 'no fork';
+	}
+	elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+	    $reason = 'Socket extension unavailable';
+	}
+	elsif ($Config{'extensions'} !~ /\bIO\b/) {
+	    $reason = 'IO extension unavailable';
+	}
+	if ($reason) {
+	    print "1..0 # Skip: $reason\n";
+	    exit 0;
+        }
+    }
+}
+
+$| = 1;
+
+print "1..8\n";
+
+
+package Multi;
+require IO::Socket::INET;
+@ISA=qw(IO::Socket::INET);
+
+use Socket qw(inet_aton inet_ntoa unpack_sockaddr_in);
+
+sub _get_addr
+{
+    my($sock,$addr_str, $multi) = @_;
+    #print "_get_addr($sock, $addr_str, $multi)\n";
+
+    print "not " unless $multi;
+    print "ok 2\n";
+
+    (
+     # private IP-addresses which I hope does not work anywhere :-)
+     inet_aton("10.250.230.10"),
+     inet_aton("10.250.230.12"),
+     inet_aton("127.0.0.1")        # loopback
+    )
+}
+
+sub connect
+{
+    my $self = shift;
+    if (@_ == 1) {
+	my($port, $addr) = unpack_sockaddr_in($_[0]);
+	$addr = inet_ntoa($addr);
+	#print "connect($self, $port, $addr)\n";
+	if($addr eq "10.250.230.10") {
+	    print "ok 3\n";
+	    return 0;
+	}
+	if($addr eq "10.250.230.12") {
+	    print "ok 4\n";
+	    return 0;
+	}
+    }
+    $self->SUPER::connect(@_);
+}
+
+
+
+package main;
+
+use IO::Socket;
+
+$listen = IO::Socket::INET->new(Listen => 2,
+				Proto => 'tcp',
+				Timeout => 5,
+			       ) or die "$!";
+
+print "ok 1\n";
+
+$port = $listen->sockport;
+
+if($pid = fork()) {
+
+    $sock = $listen->accept() or die "$!";
+    print "ok 5\n";
+
+    print $sock->getline();
+    print $sock "ok 7\n";
+
+    waitpid($pid,0);
+
+    $sock->close;
+
+    print "ok 8\n";
+
+} elsif(defined $pid) {
+
+    $sock = Multi->new(PeerPort => $port,
+		       Proto => 'tcp',
+		       PeerAddr => 'localhost',
+		       MultiHomed => 1,
+		       Timeout => 1,
+		      ) or die "$!";
+
+    print $sock "ok 6\n";
+    sleep(1); # race condition
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+    die;
+}
diff --git a/gnu/usr.bin/perl/t/lib/io_poll.t b/gnu/usr.bin/perl/t/lib/io_poll.t
new file mode 100644
index 00000000000..68ad7b74cba
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_poll.t
@@ -0,0 +1,77 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        unshift @INC, '../lib' if -d '../lib';
+    }
+}
+
+if ($^O eq 'mpeix') {
+    print "1..0 # Skip: broken on MPE/iX\n";
+    exit 0;
+}
+
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
+
+print "1..8\n";
+
+use IO::Handle;
+use IO::Poll qw(/POLL/);
+
+my $poll = new IO::Poll;
+
+my $stdout = \*STDOUT;
+my $dupout = IO::Handle->new_from_fd(fileno($stdout),"w");
+
+$poll->mask($stdout => POLLOUT);
+
+print "not "
+	unless $poll->mask($stdout) == POLLOUT;
+print "ok 1\n";
+
+$poll->mask($dupout => POLLPRI);
+
+print "not "
+	unless $poll->mask($dupout) == POLLPRI;
+print "ok 2\n";
+
+$poll->poll(0.1);
+
+if ($^O eq 'MSWin32') {
+print "ok 3 # skipped, doesn't work on non-socket fds\n";
+print "ok 4 # skipped, doesn't work on non-socket fds\n";
+}
+else {
+print "not "
+	unless $poll->events($stdout) == POLLOUT;
+print "ok 3\n";
+
+print "not "
+	if $poll->events($dupout);
+print "ok 4\n";
+}
+
+my @h = $poll->handles;
+print "not "
+	unless @h == 2;
+print "ok 5\n";
+
+$poll->remove($stdout);
+
+@h = $poll->handles;
+
+print "not "
+	unless @h == 1;
+print "ok 6\n";
+
+print "not "
+	if $poll->mask($stdout);
+print "ok 7\n";
+
+$poll->poll(0.1);
+
+print "not "
+	if $poll->events($stdout);
+print "ok 8\n";
diff --git a/gnu/usr.bin/perl/t/lib/io_unix.t b/gnu/usr.bin/perl/t/lib/io_unix.t
new file mode 100644
index 00000000000..247647a7029
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/io_unix.t
@@ -0,0 +1,89 @@
+#!./perl
+
+BEGIN {
+    unless(grep /blib/, @INC) {
+        chdir 't' if -d 't';
+        unshift @INC, '../lib' if -d '../lib';
+    }
+}
+
+use Config;
+
+BEGIN {
+    if(-d "lib" && -f "TEST") {
+	my $reason;
+	if (! $Config{'d_fork'}) {
+	    $reason = 'no fork';
+	}
+	elsif ($Config{'extensions'} !~ /\bSocket\b/) {
+	    $reason = 'Socket extension unavailable';
+	}
+	elsif ($Config{'extensions'} !~ /\bIO\b/) {
+	    $reason = 'IO extension unavailable';
+	}
+	elsif ($^O eq 'os2') {
+	    require IO::Socket;
+
+	    eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+	      or $@ !~ /not implemented/ or
+		$reason = 'compiled without TCP/IP stack v4';
+	} elsif ($^O eq 'qnx') {
+	    $reason = 'Not implemented';
+	}
+	undef $reason if $^O eq 'VMS' and $Config{d_socket};
+	if ($reason) {
+	    print "1..0 # Skip: $reason\n";
+	    exit 0;
+        }
+    }
+}
+
+$PATH = "/tmp/sock-$$";
+
+# Test if we can create the file within the tmp directory
+if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {
+    print "1..0 # Skip: cannot open '$PATH' for write\n";
+    exit 0;
+}
+close(TEST);
+unlink($PATH) or $^O eq 'os2' or die "Can't unlink $PATH: $!";
+
+# Start testing
+$| = 1;
+print "1..5\n";
+
+use IO::Socket;
+
+$listen = IO::Socket::UNIX->new(Local=>$PATH, Listen=>0) || die "$!";
+print "ok 1\n";
+
+if($pid = fork()) {
+
+    $sock = $listen->accept();
+    print "ok 2\n";
+
+    print $sock->getline();
+
+    print $sock "ok 4\n";
+
+    $sock->close;
+
+    waitpid($pid,0);
+    unlink($PATH) || $^O eq 'os2' || warn "Can't unlink $PATH: $!";
+
+    print "ok 5\n";
+
+} elsif(defined $pid) {
+
+    $sock = IO::Socket::UNIX->new(Peer => $PATH) or die "$!";
+
+    print $sock "ok 3\n";
+
+    print $sock->getline();
+
+    $sock->close;
+
+    exit;
+} else {
+ die;
+}
diff --git a/gnu/usr.bin/perl/t/lib/syslfs.t b/gnu/usr.bin/perl/t/lib/syslfs.t
new file mode 100644
index 00000000000..28571209428
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/syslfs.t
@@ -0,0 +1,221 @@
+# NOTE: this file tests how large files (>2GB) work with raw system IO.
+# stdio: open(), tell(), seek(), print(), read() is tested in t/op/lfs.t.
+# If you modify/add tests here, remember to update also t/op/lfs.t.
+
+BEGIN {
+	chdir 't' if -d 't';
+	unshift @INC, '../lib';
+	require Config; import Config;
+	# Don't bother if there are no quad offsets.
+	if ($Config{lseeksize} < 8) {
+		print "1..0\n# no 64-bit file offsets\n";
+		exit(0);
+	}
+	require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
+}
+
+sub zap {
+    close(BIG);
+    unlink("big");
+    unlink("big1");
+    unlink("big2");
+}
+
+sub bye {
+    zap(); 
+    exit(0);
+}
+
+sub explain {
+    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.)
+#
+# Perl may still be able to support large files, once you have
+# such a process, enough quota, and such a (file) system.
+#
+EOM
+}
+
+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";
+    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";
+    bye();
+}
+
+# Then try heuristically to deduce whether we have sparse files.
+
+# We'll start off by creating a one megabyte file which has
+# only three "true" bytes.  If we have sparseness, we should
+# consume less blocks than one megabyte (assuming nobody has
+# one megabyte blocks...)
+
+sysopen(BIG, "big1", O_WRONLY|O_CREAT|O_TRUNC) or
+    do { warn "sysopen big1 failed: $!\n"; bye };
+sysseek(BIG, 1_000_000, SEEK_SET) or
+    do { warn "sysseek big1 failed: $!\n"; bye };
+syswrite(BIG, "big") or
+    do { warn "syswrite big1 failed; $!\n"; bye };
+close(BIG) or
+    do { warn "close big1 failed: $!\n"; bye };
+
+my @s1 = stat("big1");
+
+print "# s1 = @s1\n";
+
+sysopen(BIG, "big2", O_WRONLY|O_CREAT|O_TRUNC) or
+    do { warn "sysopen big2 failed: $!\n"; bye };
+sysseek(BIG, 2_000_000, SEEK_SET) or
+    do { warn "sysseek big2 failed: $!\n"; bye };
+syswrite(BIG, "big") or
+    do { warn "syswrite big2 failed; $!\n"; bye };
+close(BIG) or
+    do { warn "close big2 failed: $!\n"; bye };
+
+my @s2 = stat("big2");
+
+print "# s2 = @s2\n";
+
+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";
+	bye;
+}
+
+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.
+
+$ENV{LC_ALL} = "C";
+
+sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or
+	do { warn "sysopen 'big' failed: $!\n"; bye };
+my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET);
+unless (defined $sysseek && $sysseek == 5_000_000_000) {
+    print "1..0\n# seeking past 2GB failed: $! (sysseek returned ",
+          defined $sysseek ? $sysseek : 'undef', ")\n";
+    explain();
+    bye();
+}
+
+# The syswrite will fail if there are are filesize limitations (process or fs).
+my $syswrite = syswrite(BIG, "big");
+print "# syswrite failed: $! (syswrite returned ",
+      defined $syswrite ? $syswrite : 'undef', ")\n"
+    unless defined $syswrite && $syswrite == 3;
+my $close     = close BIG;
+print "# close failed: $!\n" unless $close;
+unless($syswrite && $close) {
+    if ($! =~/too large/i) {
+	print "1..0\n# writing past 2GB failed: process limits?\n";
+    } elsif ($! =~ /quota/i) {
+	print "1..0\n# filesystem quota limits?\n";
+    }
+    explain();
+    bye();
+}
+
+@s = stat("big");
+
+print "# @s\n";
+
+unless ($s[7] == 5_000_000_003) {
+    print "1..0\n# not configured to use large files?\n";
+    explain();
+    bye();
+}
+
+sub fail () {
+    print "not ";
+    $fail++;
+}
+
+print "1..17\n";
+
+my $fail = 0;
+
+fail unless $s[7] == 5_000_000_003;	# exercizes pp_stat
+print "ok 1\n";
+
+fail unless -s "big" == 5_000_000_003;	# exercizes pp_ftsize
+print "ok 2\n";
+
+fail unless -e "big";
+print "ok 3\n";
+
+fail unless -f "big";
+print "ok 4\n";
+
+sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
+
+fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
+print "ok 5\n";
+
+fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+print "ok 6\n";
+
+fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
+print "ok 7\n";
+
+fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
+print "ok 8\n";
+
+fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
+print "ok 9\n";
+
+fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+print "ok 10\n";
+
+fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
+print "ok 11\n";
+
+fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
+print "ok 12\n";
+
+my $big;
+
+fail unless sysread(BIG, $big, 3) == 3;
+print "ok 13\n";
+
+fail unless $big eq "big";
+print "ok 14\n";
+
+# 705_032_704 = (I32)5_000_000_000
+fail unless seek(BIG, 705_032_704, SEEK_SET);
+print "ok 15\n";
+
+my $zero;
+
+fail unless read(BIG, $zero, 3) == 3;
+print "ok 16\n";
+
+fail unless $zero eq "\0\0\0";
+print "ok 17\n";
+
+explain if $fail;
+
+bye(); # does the necessary cleanup
+
+END {
+   unlink "big"; # be paranoid about leaving 5 gig files lying around
+}
+
+# eof
diff --git a/gnu/usr.bin/perl/t/lib/thr5005.t b/gnu/usr.bin/perl/t/lib/thr5005.t
new file mode 100644
index 00000000000..6b3c800f9bc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/thr5005.t
@@ -0,0 +1,118 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require Config; import Config;
+    if (! $Config{'use5005threads'}) {
+	print "1..0 # Skip: not use5005threads\n";
+	exit 0;
+    }
+
+    # XXX known trouble with global destruction
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+$| = 1;
+print "1..21\n";
+use Thread 'yield';
+print "ok 1\n";
+
+sub content
+{
+ print shift;
+ return shift;
+}
+
+# create a thread passing args and immedaietly wait for it.
+my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
+print $t->join;
+
+# check that lock works ...
+{lock $foo;
+ $t = new Thread sub { lock $foo; print "ok 5\n" };
+ print "ok 4\n";
+}
+$t->join;
+
+sub dorecurse
+{
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&dorecurse, @_);
+   $ret->join;
+  }
+}
+
+$t = new Thread \&dorecurse, map { "ok $_\n" } 6..10;
+$t->join;
+
+# test that sleep lets other thread run
+$t = new Thread \&dorecurse,"ok 11\n";
+sleep 6;
+print "ok 12\n";
+$t->join;
+
+sub islocked : locked {
+ my $val = shift;
+ my $ret;
+ print $val;
+ if (@_)
+  {
+   $ret = Thread->new(\&islocked, shift);
+  }
+ $ret;
+}
+
+$t = Thread->new(\&islocked, "ok 13\n", "ok 14\n");
+$t->join->join;
+
+{
+    package Loch::Ness;
+    sub new { bless [], shift }
+    sub monster : locked : method {
+	my($s, $m) = @_;
+	print "ok $m\n";
+    }
+    sub gollum { &monster }
+}
+Loch::Ness->monster(15);
+Loch::Ness->new->monster(16);
+Loch::Ness->gollum(17);
+Loch::Ness->new->gollum(18);
+
+my $short = "This is a long string that goes on and on.";
+my $shorte = " a long string that goes on and on.";
+my $long  = "This is short.";
+my $longe  = " short.";
+my $thr1 = new Thread \&threaded, $short, $shorte, "19";
+my $thr2 = new Thread \&threaded, $long, $longe, "20";
+
+sub threaded {
+  my ($string, $string_end, $testno) = @_;
+
+  # Do the match, saving the output in appropriate variables
+  $string =~ /(.*)(is)(.*)/;
+  # Yield control, allowing the other thread to fill in the match variables
+  yield();
+  # Examine the match variable contents; on broken perls this fails
+  if ($3 eq $string_end) {
+    print "ok $testno\n";
+  }
+  else {
+    warn <<EOT;
+
+#
+# This is a KNOWN FAILURE, and one of the reasons why threading
+# is still an experimental feature.  It is here to stop people
+# from deploying threads in production. ;-)
+#
+EOT
+    print "not ok $testno # other thread filled in match variables\n";
+  }
+}
+$thr1->join;
+$thr2->join;
+print "ok 21\n";
diff --git a/gnu/usr.bin/perl/t/lib/tie-stdhandle.t b/gnu/usr.bin/perl/t/lib/tie-stdhandle.t
new file mode 100644
index 00000000000..cf3a1831d0d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/tie-stdhandle.t
@@ -0,0 +1,47 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+use Tie::Handle;
+tie *tst,Tie::StdHandle;
+
+$f = 'tst';
+
+print "1..13\n";   
+
+# my $file tests
+
+unlink("afile.new") if -f "afile";     
+print "$!\nnot " unless open($f,"+>afile");
+print "ok 1\n";
+print "$!\nnot " unless binmode($f);
+print "ok 2\n";
+print "not " unless -f "afile";     
+print "ok 3\n";
+print "not " unless print $f "SomeData\n";
+print "ok 4\n";
+print "not " unless tell($f) == 9;
+print "ok 5\n";
+print "not " unless printf $f "Some %d value\n",1234;
+print "ok 6\n";
+print "not " unless seek($f,0,0);
+print "ok 7\n";
+$b = <$f>;
+print "not " unless $b eq "SomeData\n";
+print "ok 8\n";
+print "not " if eof($f);
+print "ok 9\n";
+read($f,($b=''),4);
+print "'$b' not " unless $b eq 'Some';
+print "ok 10\n";
+print "not " unless getc($f) eq ' ';
+print "ok 11\n";
+$b = <$f>;
+print "not " unless eof($f);
+print "ok 12\n";
+print "not " unless close($f);
+print "ok 13\n";
+unlink("afile");     
diff --git a/gnu/usr.bin/perl/t/op/64bitint.t b/gnu/usr.bin/perl/t/op/64bitint.t
new file mode 100644
index 00000000000..60f72c3536e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/64bitint.t
@@ -0,0 +1,242 @@
+#./perl
+
+BEGIN {
+	eval { my $q = pack "q", 0 };
+	if ($@) {
+		print "1..0\n# no 64-bit types\n";
+		exit(0);
+	}
+	chdir 't' if -d 't';
+	unshift @INC, '../lib';
+}
+
+# This could use a lot of more tests.
+
+# so that using > 0xfffffff constants and
+# 32+ bit integers don't cause noise
+no warnings qw(overflow portable);
+
+print "1..48\n";
+
+my $q = 12345678901;
+my $r = 23456789012;
+my $f = 0xffffffff;
+my $x;
+my $y;
+
+$x = unpack "q", pack "q", $q;
+print "not " unless $x == $q && $x > $f;
+print "ok 1\n";
+
+
+$x = sprintf("%lld", 12345678901);
+print "not " unless $x eq $q && $x > $f;
+print "ok 2\n";
+
+
+$x = sprintf("%lld", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 3\n";
+
+$x = sprintf("%Ld", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 4\n";
+
+$x = sprintf("%qd", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 5\n";
+
+
+$x = sprintf("%llx", $q);
+print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
+print "ok 6\n";
+
+$x = sprintf("%Lx", $q);
+print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
+print "ok 7\n";
+
+$x = sprintf("%qx", $q);
+print "not " unless hex($x) == 0x2dfdc1c35 && hex($x) > $f;
+print "ok 8\n";
+
+
+$x = sprintf("%llo", $q);
+print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
+print "ok 9\n";
+
+$x = sprintf("%Lo", $q);
+print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
+print "ok 10\n";
+
+$x = sprintf("%qo", $q);
+print "not " unless oct("0$x") == 0133767016065 && oct($x) > $f;
+print "ok 11\n";
+
+
+$x = sprintf("%llb", $q);
+print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
+                    oct("0b$x") > $f;
+print "ok 12\n";
+
+$x = sprintf("%Lb", $q);
+print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
+                                   oct("0b$x") > $f;
+print "ok 13\n";
+
+$x = sprintf("%qb", $q);
+print "not " unless oct("0b$x") == 0b1011011111110111000001110000110101 &&
+                    oct("0b$x") > $f;
+print "ok 14\n";
+
+
+$x = sprintf("%llu", $q);
+print "not " unless $x eq $q && $x > $f;
+print "ok 15\n";
+
+$x = sprintf("%Lu", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 16\n";
+
+$x = sprintf("%qu", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 17\n";
+
+
+$x = sprintf("%D", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 18\n";
+
+$x = sprintf("%U", $q);
+print "not " unless $x == $q && $x eq $q && $x > $f;
+print "ok 19\n";
+
+$x = sprintf("%O", $q);
+print "not " unless oct($x) == $q && oct($x) > $f;
+print "ok 20\n";
+
+
+$x = $q + $r;
+print "not " unless $x == 35802467913 && $x > $f;
+print "ok 21\n";
+
+$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";
+
+
+$x = '';
+print "not " unless (vec($x, 1, 64) = $q) == $q;
+print "ok 38\n";
+
+print "not " unless vec($x, 1, 64) == $q && vec($x, 1, 64) > $f;
+print "ok 39\n";
+
+print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0;
+print "ok 40\n";
+
+
+print "not " unless ~0 == 0xffffffffffffffff;
+print "ok 41\n";
+
+print "not " unless (0xffffffff<<32) == 0xffffffff00000000;
+print "ok 42\n";
+
+print "not " unless ((0xffffffff)<<32)>>32 == 0xffffffff;
+print "ok 43\n";
+
+print "not " unless 1<<63 == 0x8000000000000000;
+print "ok 44\n";
+
+print "not " unless (sprintf "%#Vx", 1<<63) eq '0x8000000000000000';
+print "ok 45\n";
+
+print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001;
+print "ok 46\n";
+
+print "not " unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000;
+print "ok 47\n";
+
+print "not " unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0;
+print "ok 48\n";
+
+# eof
diff --git a/gnu/usr.bin/perl/t/op/args.t b/gnu/usr.bin/perl/t/op/args.t
new file mode 100644
index 00000000000..48bf5afec09
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/args.t
@@ -0,0 +1,54 @@
+#!./perl
+
+print "1..8\n";
+
+# test various operations on @_
+
+my $ord = 0;
+sub new1 { bless \@_ }
+{
+    my $x = new1("x");
+    my $y = new1("y");
+    ++$ord;
+    print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y";
+    print "ok $ord\n";
+    ++$ord;
+    print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x";
+    print "ok $ord\n";
+}
+
+sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ }
+{
+    my $x = new2("x");
+    my $y = new2("y");
+    ++$ord;
+    print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x";
+    print "ok $ord\n";
+    ++$ord;
+    print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y";
+    print "ok $ord\n";
+}
+
+sub new3 { goto &new1 }
+{
+    my $x = new3("x");
+    my $y = new3("y");
+    ++$ord;
+    print "# got [@$y], expected [y]\nnot " unless "@$y" eq "y";
+    print "ok $ord\n";
+    ++$ord;
+    print "# got [@$x], expected [x]\nnot " unless "@$x" eq "x";
+    print "ok $ord\n";
+}
+
+sub new4 { goto &new2 }
+{
+    my $x = new4("x");
+    my $y = new4("y");
+    ++$ord;
+    print "# got [@$x], expected [a b c x]\nnot " unless "@$x" eq "a b c x";
+    print "ok $ord\n";
+    ++$ord;
+    print "# got [@$y], expected [a b c y]\nnot " unless "@$y" eq "a b c y";
+    print "ok $ord\n";
+}
diff --git a/gnu/usr.bin/perl/t/op/attrs.t b/gnu/usr.bin/perl/t/op/attrs.t
new file mode 100644
index 00000000000..615e4d33430
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/attrs.t
@@ -0,0 +1,176 @@
+#!./perl -w
+
+# Regression tests for attributes.pm and the C< : attrs> syntax.
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+sub NTESTS () ;
+
+my ($test, $ntests);
+BEGIN {$ntests=0}
+$test=0;
+my $failed = 0;
+
+print "1..".NTESTS."\n";
+
+$SIG{__WARN__} = sub { die @_ };
+
+sub mytest {
+    if (!$@ ne !$_[0] || $_[0] && $@ !~ $_[0]) {
+	if ($@) {
+	    my $x = $@;
+	    $x =~ s/\n.*\z//s;
+	    print "# Got: $x\n"
+	}
+	else {
+	    print "# Got unexpected success\n";
+	}
+	if ($_[0]) {
+	    print "# Expected: $_[0]\n";
+	}
+	else {
+	    print "# Expected success\n";
+	}
+	$failed = 1;
+	print "not ";
+    }
+    elsif (@_ == 3 && $_[1] ne $_[2]) {
+	print "# Got: $_[1]\n";
+	print "# Expected: $_[2]\n";
+	$failed = 1;
+	print "not ";
+    }
+    print "ok ",++$test,"\n";
+}
+
+eval 'sub t1 ($) : locked { $_[0]++ }';
+mytest;
+BEGIN {++$ntests}
+
+eval 'sub t2 : locked { $_[0]++ }';
+mytest;
+BEGIN {++$ntests}
+
+eval 'sub t3 ($) : locked ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'sub t4 : locked ;';
+mytest;
+BEGIN {++$ntests}
+
+my $anon1;
+eval '$anon1 = sub ($) : locked:method { $_[0]++ }';
+mytest;
+BEGIN {++$ntests}
+
+my $anon2;
+eval '$anon2 = sub : locked : method { $_[0]++ }';
+mytest;
+BEGIN {++$ntests}
+
+my $anon3;
+eval '$anon3 = sub : method { $_[0]->[1] }';
+mytest;
+BEGIN {++$ntests}
+
+eval 'sub e1 ($) : plugh ;';
+mytest qr/^Invalid CODE attributes?: ["']?plugh["']? at/;
+BEGIN {++$ntests}
+
+eval 'sub e2 ($) : plugh(0,0) xyzzy ;';
+mytest qr/^Invalid CODE attributes: ["']?plugh\(0,0\)["']? /;
+BEGIN {++$ntests}
+
+eval 'sub e3 ($) : plugh(0,0 xyzzy ;';
+mytest qr/Unterminated attribute parameter in attribute list at/;
+BEGIN {++$ntests}
+
+eval 'sub e4 ($) : plugh + xyzzy ;';
+mytest qr/Invalid separator character '[+]' in attribute list at/;
+BEGIN {++$ntests}
+
+eval 'my main $x : = 0;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my $x : = 0;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my $x ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x) : = 0;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x) ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x) : ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x,$y) : = 0;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x,$y) ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x,$y) : ;';
+mytest;
+BEGIN {++$ntests}
+
+eval 'my ($x,$y) : plugh;';
+mytest qr/^Invalid SCALAR attribute: ["']?plugh["']? at/;
+BEGIN {++$ntests}
+
+sub A::MODIFY_SCALAR_ATTRIBUTES { return }
+eval 'my A $x : plugh;';
+mytest qr/^SCALAR package attribute may clash with future reserved word: ["']?plugh["']? at/;
+BEGIN {++$ntests}
+
+eval 'my A $x : plugh plover;';
+mytest qr/^SCALAR package attributes may clash with future reserved words: ["']?plugh["']? /;
+BEGIN {++$ntests}
+
+sub X::MODIFY_CODE_ATTRIBUTES { die "$_[0]" }
+sub X::foo { 1 }
+*Y::bar = \&X::foo;
+*Y::bar = \&X::foo;	# second time for -w
+eval 'package Z; sub Y::bar : locked';
+mytest qr/^X at /;
+BEGIN {++$ntests}
+
+my @attrs = eval 'attributes::get \&Y::bar';
+mytest '', "@attrs", "locked";
+BEGIN {++$ntests}
+
+@attrs = eval 'attributes::get $anon1';
+mytest '', "@attrs", "locked method";
+BEGIN {++$ntests}
+
+sub Z::DESTROY { }
+sub Z::FETCH_CODE_ATTRIBUTES { return 'Z' }
+my $thunk = eval 'bless +sub : method locked { 1 }, "Z"';
+mytest '', ref($thunk), "Z";
+BEGIN {++$ntests}
+
+@attrs = eval 'attributes::get $thunk';
+mytest '', "@attrs", "locked method Z";
+BEGIN {++$ntests}
+
+
+# Other tests should be added above this line
+
+sub NTESTS () { $ntests }
+
+exit $failed;
diff --git a/gnu/usr.bin/perl/t/op/avhv.t b/gnu/usr.bin/perl/t/op/avhv.t
index 55cc992e63c..cd7c957619d 100644
--- a/gnu/usr.bin/perl/t/op/avhv.t
+++ b/gnu/usr.bin/perl/t/op/avhv.t
@@ -1,8 +1,8 @@
 #!./perl
-      
+
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
 
 require Tie::Array;
@@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
-print "1..12\n";
+print "1..28\n";
 
 $sch = {
     'abc' => 1,
@@ -108,3 +108,71 @@ f($a->{key});
 print "not " unless $a->[1] eq 'b';
 print "ok 12\n";
 
+# check if exists() is behaving properly
+$avhv = [{foo=>1,bar=>2,pants=>3}];
+print "not " if exists $avhv->{bar};
+print "ok 13\n";
+
+$avhv->{pants} = undef;
+print "not " unless exists $avhv->{pants};
+print "ok 14\n";
+print "not " if exists $avhv->{bar};
+print "ok 15\n";
+
+$avhv->{bar} = 10;
+print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10;
+print "ok 16\n";
+
+$v = delete $avhv->{bar};
+print "not " unless $v == 10;
+print "ok 17\n";
+
+print "not " if exists $avhv->{bar};
+print "ok 18\n";
+
+$avhv->{foo} = 'xxx';
+$avhv->{bar} = 'yyy';
+$avhv->{pants} = 'zzz';
+@x = delete @{$avhv}{'foo','pants'};
+print "# @x\nnot " unless "@x" eq "xxx zzz";
+print "ok 19\n";
+
+print "not " unless "$avhv->{bar}" eq "yyy";
+print "ok 20\n";
+
+# hash assignment
+%$avhv = ();
+print "not " unless ref($avhv->[0]) eq 'HASH';
+print "ok 21\n";
+
+%hv = %$avhv;
+print "not " if grep defined, values %hv;
+print "ok 22\n";
+print "not " if grep ref, keys %hv;
+print "ok 23\n";
+
+%$avhv = (foo => 29, pants => 2, bar => 0);
+print "not " unless "@$avhv[1..3]" eq '29 0 2';
+print "ok 24\n";
+
+my $extra;
+my @extra;
+($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo';
+print "ok 25\n";
+
+%$avhv = ();
+(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra;
+print "ok 26\n";
+
+@extra = qw(whatever and stuff);
+%$avhv = ();
+(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0;
+print "ok 27\n";
+
+%$avhv = ();
+(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless ref $avhv->[0] eq 'HASH' and @extra == 6;
+print "ok 28\n";
diff --git a/gnu/usr.bin/perl/t/op/chars.t b/gnu/usr.bin/perl/t/op/chars.t
new file mode 100644
index 00000000000..efdea027bb4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/chars.t
@@ -0,0 +1,74 @@
+#!./perl
+
+print "1..33\n";
+
+# because of ebcdic.c these should be the same on asciiish 
+# and ebcdic machines.
+# Peter Prymmer <pvhp@best.com>.
+
+my $c = "\c@";
+print +((ord($c) == 0) ? "" : "not "),"ok 1\n";
+$c = "\cA";
+print +((ord($c) == 1) ? "" : "not "),"ok 2\n";
+$c = "\cB";
+print +((ord($c) == 2) ? "" : "not "),"ok 3\n";
+$c = "\cC";
+print +((ord($c) == 3) ? "" : "not "),"ok 4\n";
+$c = "\cD";
+print +((ord($c) == 4) ? "" : "not "),"ok 5\n";
+$c = "\cE";
+print +((ord($c) == 5) ? "" : "not "),"ok 6\n";
+$c = "\cF";
+print +((ord($c) == 6) ? "" : "not "),"ok 7\n";
+$c = "\cG";
+print +((ord($c) == 7) ? "" : "not "),"ok 8\n";
+$c = "\cH";
+print +((ord($c) == 8) ? "" : "not "),"ok 9\n";
+$c = "\cI";
+print +((ord($c) == 9) ? "" : "not "),"ok 10\n";
+$c = "\cJ";
+print +((ord($c) == 10) ? "" : "not "),"ok 11\n";
+$c = "\cK";
+print +((ord($c) == 11) ? "" : "not "),"ok 12\n";
+$c = "\cL";
+print +((ord($c) == 12) ? "" : "not "),"ok 13\n";
+$c = "\cM";
+print +((ord($c) == 13) ? "" : "not "),"ok 14\n";
+$c = "\cN";
+print +((ord($c) == 14) ? "" : "not "),"ok 15\n";
+$c = "\cO";
+print +((ord($c) == 15) ? "" : "not "),"ok 16\n";
+$c = "\cP";
+print +((ord($c) == 16) ? "" : "not "),"ok 17\n";
+$c = "\cQ";
+print +((ord($c) == 17) ? "" : "not "),"ok 18\n";
+$c = "\cR";
+print +((ord($c) == 18) ? "" : "not "),"ok 19\n";
+$c = "\cS";
+print +((ord($c) == 19) ? "" : "not "),"ok 20\n";
+$c = "\cT";
+print +((ord($c) == 20) ? "" : "not "),"ok 21\n";
+$c = "\cU";
+print +((ord($c) == 21) ? "" : "not "),"ok 22\n";
+$c = "\cV";
+print +((ord($c) == 22) ? "" : "not "),"ok 23\n";
+$c = "\cW";
+print +((ord($c) == 23) ? "" : "not "),"ok 24\n";
+$c = "\cX";
+print +((ord($c) == 24) ? "" : "not "),"ok 25\n";
+$c = "\cY";
+print +((ord($c) == 25) ? "" : "not "),"ok 26\n";
+$c = "\cZ";
+print +((ord($c) == 26) ? "" : "not "),"ok 27\n";
+$c = "\c[";
+print +((ord($c) == 27) ? "" : "not "),"ok 28\n";
+$c = "\c\\";
+print +((ord($c) == 28) ? "" : "not "),"ok 29\n";
+$c = "\c]";
+print +((ord($c) == 29) ? "" : "not "),"ok 30\n";
+$c = "\c^";
+print +((ord($c) == 30) ? "" : "not "),"ok 31\n";
+$c = "\c_";
+print +((ord($c) == 31) ? "" : "not "),"ok 32\n";
+$c = "\c?";
+print +((ord($c) == 127) ? "" : "not "),"ok 33\n";
diff --git a/gnu/usr.bin/perl/t/op/defins.t b/gnu/usr.bin/perl/t/op/defins.t
index 33c74ea28e8..9e714a718bc 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';
-    @INC = '../lib';
+    unshift @INC, '../lib';
     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
     print "1..14\n";
 }
diff --git a/gnu/usr.bin/perl/t/op/die.t b/gnu/usr.bin/perl/t/op/die.t
index d473ed6b7f7..cf4f8b05551 100644
--- a/gnu/usr.bin/perl/t/op/die.t
+++ b/gnu/usr.bin/perl/t/op/die.t
@@ -4,7 +4,7 @@ print "1..10\n";
 
 $SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
 
-$err = "ok 1\n";
+$err = "#[\000]\nok 1\n";
 eval {
     die $err;
 };
diff --git a/gnu/usr.bin/perl/t/op/die_exit.t b/gnu/usr.bin/perl/t/op/die_exit.t
index 26b477a8c94..cb0478b9b2e 100644
--- a/gnu/usr.bin/perl/t/op/die_exit.t
+++ b/gnu/usr.bin/perl/t/op/die_exit.t
@@ -7,8 +7,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib' if -e '../lib';
+    unshift @INC, '../lib' if -e '../lib';
 }
+
+if ($^O eq 'mpeix') {
+    print "1..0 # Skip: broken on MPE/iX\n";
+    exit 0;
+}
+
 my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl';
 
 use strict;
@@ -31,7 +37,7 @@ my %tests = (
 	15 => [ 255,   1],
 	16 => [ 255, 256],
 	# see if implicit close preserves $?
-	17 => [  0,  512, '{ local *F; open F, q[TEST]; close F } die;'],
+	17 => [  0,  512, '{ local *F; open F, q[TEST]; close F; $!=0 } die;'],
 );
 
 my $max = keys %tests;
diff --git a/gnu/usr.bin/perl/t/op/exists_sub.t b/gnu/usr.bin/perl/t/op/exists_sub.t
new file mode 100644
index 00000000000..3363dfd837a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/exists_sub.t
@@ -0,0 +1,46 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+print "1..9\n";
+
+sub t1;
+sub t2 : locked;
+sub t3 ();
+sub t4 ($);
+sub t5 {1;}
+{
+    package P1;
+    sub tmc {1;}
+    package P2;
+    @ISA = 'P1';
+}
+
+print "not " unless exists &t1 && not defined &t1;
+print "ok 1\n";
+print "not " unless exists &t2 && not defined &t2;
+print "ok 2\n";
+print "not " unless exists &t3 && not defined &t3;
+print "ok 3\n";
+print "not " unless exists &t4 && not defined &t4;
+print "ok 4\n";
+print "not " unless exists &t5 && defined &t5;
+print "ok 5\n";
+P2::->tmc;
+print "not " unless not exists &P2::tmc && not defined &P2::tmc;
+print "ok 6\n";
+my $ref;
+$ref->{A}[0] = \&t4;
+print "not " unless exists &{$ref->{A}[0]} && not defined &{$ref->{A}[0]};
+print "ok 7\n";
+undef &P1::tmc;
+print "not " unless exists &P1::tmc && not defined &P1::tmc;
+print "ok 8\n";
+eval 'exists &t5()';
+print "not " unless $@;
+print "ok 9\n";
+
+exit 0;
diff --git a/gnu/usr.bin/perl/t/op/fh.t b/gnu/usr.bin/perl/t/op/fh.t
new file mode 100644
index 00000000000..86e405a992a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/fh.t
@@ -0,0 +1,26 @@
+#!./perl
+
+print "1..5\n";
+
+my $test = 0;
+
+# symbolic filehandles should only result in glob entries with FH constructors
+
+$|=1;
+my $a = "SYM000";
+print "not " if defined(fileno($a)) or defined *{$a};
+++$test; print "ok $test\n";
+
+select select $a;
+print "not " unless defined *{$a};
+++$test; print "ok $test\n";
+
+$a++;
+print "not " if close $a or defined *{$a};
+++$test; print "ok $test\n";
+
+print "not " unless open($a, ">&STDOUT") and defined *{$a};
+++$test; print $a "ok $test\n";
+
+print "not " unless close $a;
+++$test; print $a "not "; print "ok $test\n";
diff --git a/gnu/usr.bin/perl/t/op/filetest.t b/gnu/usr.bin/perl/t/op/filetest.t
new file mode 100644
index 00000000000..e00d5fb7b06
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/filetest.t
@@ -0,0 +1,71 @@
+#!./perl
+
+# There are few filetest operators that are portable enough to test.
+# See pod/perlport.pod for details.
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib' if -d '../lib';
+}
+
+use Config;
+print "1..10\n";
+
+print "not " unless -d 'op';
+print "ok 1\n";
+
+print "not " unless -f 'TEST';
+print "ok 2\n";
+
+print "not " if -f 'op';
+print "ok 3\n";
+
+print "not " if -d 'TEST';
+print "ok 4\n";
+
+print "not " unless -r 'TEST';
+print "ok 5\n";
+
+# make sure TEST is r-x
+eval { chmod 0555, 'TEST' };
+$bad_chmod = $@;
+
+$oldeuid = $>;		# root can read and write anything
+eval '$> = 1';		# so switch uid (may not be implemented)
+
+print "# oldeuid = $oldeuid, euid = $>\n";
+
+if (!$Config{d_seteuid}) {
+    print "ok 6 #skipped, no seteuid\n";
+}
+elsif ($bad_chmod) {
+    print "#[$@]\nok 6 #skipped\n";
+}
+else {
+    print "not " if -w 'TEST';
+    print "ok 6\n";
+}
+
+# Scripts are not -x everywhere so cannot test that.
+
+eval '$> = $oldeuid';	# switch uid back (may not be implemented)
+
+# this would fail for the euid 1
+# (unless we have unpacked the source code as uid 1...)
+print "not " unless -r 'op';
+print "ok 7\n";
+
+# this would fail for the euid 1
+# (unless we have unpacked the source code as uid 1...)
+if ($Config{d_seteuid}) {
+    print "not " unless -w 'op';
+    print "ok 8\n";
+} else {
+    print "ok 8 #skipped, no seteuid\n";
+}
+
+print "not " unless -x 'op'; # Hohum.  Are directories -x everywhere?
+print "ok 9\n";
+
+print "not " unless "@{[grep -r, qw(foo io noo op zoo)]}" eq "io op";
+print "ok 10\n";
diff --git a/gnu/usr.bin/perl/t/op/grent.t b/gnu/usr.bin/perl/t/op/grent.t
new file mode 100644
index 00000000000..761d8b9cf60
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/grent.t
@@ -0,0 +1,139 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, "../lib" if -d "../lib";
+    eval {my @n = getgrgid 0};
+    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+	print "1..0 # Skip: $1\n";
+	exit 0;
+    }
+    eval { require Config; import Config; };
+    my $reason;
+    if ($Config{'i_grp'} ne 'define') {
+	$reason = '$Config{i_grp} not defined';
+    }
+    elsif (not -f "/etc/group" ) { # Play safe.
+	$reason = 'no /etc/group file';
+    }
+
+    if (not defined $where) {	# Try NIS.
+	foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
+	    if (-x $ypcat &&
+		open(GR, "$ypcat group 2>/dev/null |") &&
+		defined(<GR>)) {
+		$where = "NIS group";
+		undef $reason;
+		last;
+	    }
+	}
+    }
+
+    if (not defined $where) {	# Try NetInfo.
+	foreach my $nidump (qw(/usr/bin/nidump)) {
+	    if (-x $nidump &&
+		open(GR, "$nidump group . 2>/dev/null |") &&
+		defined(<GR>)) {
+		$where = "NetInfo group";
+		undef $reason;
+		last;
+	    }
+	}
+    }
+
+    if (not defined $where) {	# Try local.
+	my $GR = "/etc/group";
+	if (-f $GR && open(GR, $GR) && defined(<GR>)) {
+	    undef $reason;
+	    $where = $GR;
+	}
+    }
+    if ($reason) {
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+# By now GR filehandle should be open and full of juicy group entries.
+
+print "1..1\n";
+
+# Go through at most this many groups.
+# (note that the first entry has been read away by now)
+my $max = 25;
+
+my $n   = 0;
+my $tst = 1;
+my %perfect;
+my %seen;
+
+while (<GR>) {
+    chomp;
+    my @s = split /:/;
+    my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
+    if (@s) {
+	push @{ $seen{$name_s} }, $.;
+    } else {
+	warn "# Your $where line $. is empty.\n";
+	next;
+    }
+    if ($n == $max) {
+	local $/;
+	my $junk = <GR>;
+	last;
+    }
+    # In principle we could whine if @s != 4 but do we know enough
+    # of group file formats everywhere?
+    if (@s == 4) {
+	$members_s =~ s/\s*,\s*/,/g;
+	$members_s =~ s/\s+$//;
+	$members_s =~ s/^\s+//;
+	@n = getgrgid($gid_s);
+	# 'nogroup' et al.
+	next unless @n;
+	my ($name,$passwd,$gid,$members) = @n;
+	# Protect against one-to-many and many-to-one mappings.
+	if ($name_s ne $name) {
+	    @n = getgrnam($name_s);
+	    ($name,$passwd,$gid,$members) = @n;
+	    next if $name_s ne $name;
+	}
+	# NOTE: group names *CAN* contain whitespace.
+	$members =~ s/\s+/,/g;
+	# what about different orders of members?
+	$perfect{$name_s}++
+	    if $name    eq $name_s    and
+# Do not compare passwords: think shadow passwords.
+# Not that group passwords are used much but better not assume anything.
+               $gid     eq $gid_s     and
+               $members eq $members_s;
+    }
+    $n++;
+}
+
+if (keys %perfect == 0) {
+    $max++;
+    print <<EOEX;
+#
+# The failure of op/grent test is not necessarily serious.
+# It may fail due to local group administration conventions.
+# If you are for example using both NIS and local groups,
+# test failure is possible.  Any distributed group scheme
+# can cause such failures.
+#
+# What the grent test is doing is that it compares the $max first
+# entries of $where
+# with the results of getgrgid() and getgrnam() call.  If it finds no
+# matches at all, it suspects something is wrong.
+# 
+EOEX
+    print "not ";
+    $not = 1;
+} else {
+    $not = 0;
+}
+print "ok ", $tst++;
+print "\t# (not necessarily serious: run t/op/grent.t by itself)" if $not;
+print "\n";
+
+close(GR);
diff --git a/gnu/usr.bin/perl/t/op/grep.t b/gnu/usr.bin/perl/t/op/grep.t
index 45d0e25a27c..3a7f8ad9842 100644
--- a/gnu/usr.bin/perl/t/op/grep.t
+++ b/gnu/usr.bin/perl/t/op/grep.t
@@ -4,7 +4,7 @@
 # grep() and map() tests
 #
 
-print "1..3\n";
+print "1..27\n";
 
 $test = 1;
 
@@ -29,3 +29,71 @@ sub ok {
    $test++;
 }
 
+{
+   print map({$_} ("ok $test\n"));
+   $test++;
+   print map
+            ({$_} ("ok $test\n"));
+   $test++;
+   print((map({a => $_}, ("ok $test\n")))[0]->{a});
+   $test++;
+   print((map
+            ({a=>$_},
+	     ("ok $test\n")))[0]->{a});
+   $test++;
+   print map { $_ } ("ok $test\n");
+   $test++;
+   print map
+            { $_ } ("ok $test\n");
+   $test++;
+   print((map {a => $_}, ("ok $test\n"))[0]->{a});
+   $test++;
+   print((map
+            {a=>$_},
+	     ("ok $test\n"))[0]->{a});
+   $test++;
+   my $x = "ok \xFF\xFF\n";
+   print map($_&$x,("ok $test\n"));
+   $test++;
+   print map
+            ($_ & $x, ("ok $test\n"));
+   $test++;
+   print map { $_ & $x } ("ok $test\n");
+   $test++;
+   print map
+             { $_&$x } ("ok $test\n");
+   $test++;
+
+   print grep({$_} ("ok $test\n"));
+   $test++;
+   print grep
+            ({$_} ("ok $test\n"));
+   $test++;
+   print grep({a => $_}->{a}, ("ok $test\n"));
+   $test++;
+   print grep
+	     ({a => $_}->{a},
+	     ("ok $test\n"));
+   $test++;
+   print grep { $_ } ("ok $test\n");
+   $test++;
+   print grep
+             { $_ } ("ok $test\n");
+   $test++;
+   print grep {a => $_}->{a}, ("ok $test\n");
+   $test++;
+   print grep
+	     {a => $_}->{a},
+	     ("ok $test\n");
+   $test++;
+   print grep($_&"X",("ok $test\n"));
+   $test++;
+   print grep
+            ($_&"X", ("ok $test\n"));
+   $test++;
+   print grep { $_ & "X" } ("ok $test\n");
+   $test++;
+   print grep
+             { $_ & "X" } ("ok $test\n");
+   $test++;
+}
diff --git a/gnu/usr.bin/perl/t/op/hashwarn.t b/gnu/usr.bin/perl/t/op/hashwarn.t
index 6343a2a8d57..9182273ec3c 100644
--- a/gnu/usr.bin/perl/t/op/hashwarn.t
+++ b/gnu/usr.bin/perl/t/op/hashwarn.t
@@ -2,19 +2,18 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
 
 use strict;
+use warnings;
 
 use vars qw{ @warnings };
 
 BEGIN {
-    $^W |= 1;		# Insist upon warnings
-    # ...and save 'em as we go
     $SIG{'__WARN__'} = sub { push @warnings, @_ };
     $| = 1;
-    print "1..7\n";
+    print "1..9\n";
 }
 
 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
@@ -66,6 +65,13 @@ my $ref_msg = '/^Reference found where even-sized list expected/';
     %hash = sub { print "ok" };
     test_warning 6, shift @warnings, $odd_msg;
 
+    my $avhv = [{x=>1,y=>2}];
+    %$avhv = (x=>13,'y');
+    test_warning 7, shift @warnings, $odd_msg;
+
+    %$avhv = 'x';
+    test_warning 8, shift @warnings, $odd_msg;
+
     $_ = { 1..10 };
-    test 7, ! @warnings, "Unexpected warning";
+    test 9, ! @warnings, "Unexpected warning";
 }
diff --git a/gnu/usr.bin/perl/t/op/lex_assign.t b/gnu/usr.bin/perl/t/op/lex_assign.t
new file mode 100644
index 00000000000..2fb059d8d87
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/lex_assign.t
@@ -0,0 +1,324 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; 
+
+umask 0;
+$xref = \ "";
+$runme = ($^O eq 'VMS' ? 'MCR ' : '') . $^X;
+@a = (1..5);
+%h = (1..6);
+$aref = \@a;
+$href = \%h;
+open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|};
+$chopit = 'aaaaaa';
+@chopar = (113 .. 119);
+$posstr = '123456';
+$cstr = 'aBcD.eF';
+pos $posstr = 3;
+$nn = $n = 2;
+sub subb {"in s"}
+
+@INPUT = <DATA>;
+@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
+print "1..", (10 + @INPUT + @simple_input), "\n";
+$ord = 0;
+
+sub wrn {"@_"}
+
+# Check correct optimization of ucfirst etc
+$ord++;
+my $a = "AB";
+my $b = "\u\L$a";
+print "not " unless $b eq 'Ab';
+print "ok $ord\n";
+
+# Check correct destruction of objects:
+my $dc = 0;
+sub A::DESTROY {$dc += 1}
+$a=8;
+my $b;
+{ my $c = 6; $b = bless \$c, "A"}
+
+$ord++;
+print "not " unless $dc == 0;
+print "ok $ord\n";
+
+$b = $a+5;
+
+$ord++;
+print "not " unless $dc == 1;
+print "ok $ord\n";
+
+$ord++;
+my $xxx = 'b';
+$xxx = 'c' . ($xxx || 'e');
+print "not " unless $xxx eq 'cb';
+print "ok $ord\n";
+
+{				# Check calling STORE
+  my $sc = 0;
+  sub B::TIESCALAR {bless [11], 'B'}
+  sub B::FETCH { -(shift->[0]) }
+  sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
+
+  my $m;
+  tie $m, 'B';
+  $m = 100;
+
+  $ord++;
+  print "not " unless $sc == 1;
+  print "ok $ord\n";
+
+  my $t = 11;
+  $m = $t + 89;
+  
+  $ord++;
+  print "not " unless $sc == 2;
+  print "ok $ord\n";
+
+  $ord++;
+  print "# $m\nnot " unless $m == -117;
+  print "ok $ord\n";
+
+  $m += $t;
+
+  $ord++;
+  print "not " unless $sc == 3;
+  print "ok $ord\n";
+
+  $ord++;
+  print "# $m\nnot " unless $m == 89;
+  print "ok $ord\n";
+
+}
+
+# Chains of assignments
+
+my ($l1, $l2, $l3, $l4);
+my $zzzz = 12;
+$zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
+
+$ord++;
+print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
+  unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
+  and $l2 == 13 and $l3 == 13 and $l4 == 13;
+print "ok $ord\n";
+
+for (@INPUT) {
+  $ord++;
+  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+  $comment = $op unless defined $comment;
+  $op = "$op==$op" unless $op =~ /==/;
+  ($op, $expectop) = $op =~ /(.*)==(.*)/;
+  
+  $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
+	  ? "skip" : "not";
+  $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
+  (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
+  
+  eval <<EOE;
+  local \$SIG{__WARN__} = \\&wrn;
+  my \$a = 'fake';
+  $integer;
+  \$a = $op;
+  \$b = $expectop;
+  if (\$a ne \$b) {
+    print "# \$comment: got `\$a', expected `\$b'\n";
+    print "\$skip " if \$a ne \$b or \$skip eq 'skip';
+  }
+  print "ok \$ord\\n";
+EOE
+  if ($@) {
+    if ($@ =~ /is unimplemented/) {
+      print "# skipping $comment: unimplemented:\nok $ord\n";
+    } else {
+      warn $@;
+      print "not ok $ord\n";
+    }
+  }
+}
+
+for (@simple_input) {
+  $ord++;
+  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+  $comment = $op unless defined $comment;
+  ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
+  eval <<EOE;
+  local \$SIG{__WARN__} = \\&wrn;
+  my \$$variable = "Ac# Ca\\nxxx";
+  \$$variable = $operator \$$variable;
+  \$toself = \$$variable;
+  \$direct = $operator "Ac# Ca\\nxxx";
+  print "# \\\$$variable = $operator \\\$$variable\\nnot "
+    unless \$toself eq \$direct;
+  print "ok \$ord\\n";
+EOE
+  if ($@) {
+    if ($@ =~ /is unimplemented/) {
+      print "# skipping $comment: unimplemented:\nok $ord\n";
+    } elsif ($@ =~ /Can't (modify|take log of 0)/) {
+      print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
+    } else {
+      warn $@;
+      print "not ok $ord\n";
+    }
+  }
+}
+__END__
+ref $xref			# ref
+ref $cstr			# ref nonref
+`$runme -e "print qq[1\n]"`				# backtick skip(MSWin32)
+`$undefed`			# backtick undef skip(MSWin32)
+<*>				# glob
+<OP>				# readline
+'faked'				# rcatline
+(@z = (1 .. 3))			# aassign
+chop $chopit			# chop
+(chop (@x=@chopar))		# schop
+chomp $chopit			# chomp
+(chop (@x=@chopar))		# schomp
+pos $posstr			# pos
+pos $chopit			# pos returns undef
+$nn++==2			# postinc
+$nn++==3			# i_postinc
+$nn--==4			# postdec
+$nn--==3			# i_postdec
+$n ** $n			# pow
+$n * $n				# multiply
+$n * $n				# i_multiply
+$n / $n				# divide
+$n / $n				# i_divide
+$n % $n				# modulo
+$n % $n				# i_modulo
+$n x $n				# repeat
+$n + $n				# add
+$n + $n				# i_add
+$n - $n				# subtract
+$n - $n				# i_subtract
+$n . $n				# concat
+$n . $a=='2fake'		# concat with self
+"3$a"=='3fake'			# concat with self in stringify
+"$n"				# stringify
+$n << $n			# left_shift
+$n >> $n			# right_shift
+$n <=> $n			# ncmp
+$n <=> $n			# i_ncmp
+$n cmp $n			# scmp
+$n & $n				# bit_and
+$n ^ $n				# bit_xor
+$n | $n				# bit_or
+-$n				# negate
+-$n				# i_negate
+~$n				# complement
+atan2 $n,$n			# atan2
+sin $n				# sin
+cos $n				# cos
+'???'				# rand
+exp $n				# exp
+log $n				# log
+sqrt $n				# sqrt
+int $n				# int
+hex $n				# hex
+oct $n				# oct
+abs $n				# abs
+length $posstr			# length
+substr $posstr, 2, 2		# substr
+vec("abc",2,8)			# vec
+index $posstr, 2		# index
+rindex $posstr, 2		# rindex
+sprintf "%i%i", $n, $n		# sprintf
+ord $n				# ord
+chr $n				# chr
+crypt $n, $n			# crypt
+ucfirst ($cstr . "a")		# ucfirst padtmp
+ucfirst $cstr			# ucfirst
+lcfirst $cstr			# lcfirst
+uc $cstr			# uc
+lc $cstr			# lc
+quotemeta $cstr			# quotemeta
+@$aref				# rv2av
+@$undefed			# rv2av undef
+each %h==1			# each
+values %h			# values
+keys %h				# keys
+%$href				# rv2hv
+pack "C2", $n,$n		# pack
+split /a/, "abad"		# split
+join "a"; @a			# join
+push @a,3==6			# push
+unshift @aaa			# unshift
+reverse	@a			# reverse
+reverse	$cstr			# reverse - scal
+grep $_, 1,0,2,0,3		# grepwhile
+map "x$_", 1,0,2,0,3		# mapwhile
+subb()				# entersub
+caller				# caller
+warn "ignore this\n"		# warn
+'faked'				# die
+open BLAH, "<non-existent"	# open
+fileno STDERR			# fileno
+umask 0				# umask
+select STDOUT			# sselect
+select "","","",0		# select
+getc OP				# getc
+'???'				# read
+'???'				# sysread
+'???'				# syswrite
+'???'				# send
+'???'				# recv
+'???'				# tell
+'???'				# fcntl
+'???'				# ioctl
+'???'				# flock
+'???'				# accept
+'???'				# shutdown
+'???'				# ftsize
+'???'				# ftmtime
+'???'				# ftatime
+'???'				# ftctime
+chdir 'non-existent'		# chdir
+'???'				# chown
+'???'				# chroot
+unlink 'non-existent'		# unlink
+chmod 'non-existent'		# chmod
+utime 'non-existent'		# utime
+rename 'non-existent', 'non-existent1'	# rename
+link 'non-existent', 'non-existent1' # link
+'???'				# symlink
+readlink 'non-existent', 'non-existent1' # readlink
+'???'				# mkdir
+'???'				# rmdir
+'???'				# telldir
+'???'				# fork
+'???'				# wait
+'???'				# waitpid
+system "$runme -e 0"		# system skip(VMS)
+'???'				# exec
+'???'				# kill
+getppid				# getppid
+getpgrp				# getpgrp
+'???'				# setpgrp
+getpriority $$, $$		# getpriority
+'???'				# setpriority
+time				# time
+localtime $^T			# localtime
+gmtime $^T			# gmtime
+sleep 1				# sleep
+'???'				# alarm
+'???'				# shmget
+'???'				# shmctl
+'???'				# shmread
+'???'				# shmwrite
+'???'				# msgget
+'???'				# msgctl
+'???'				# msgsnd
+'???'				# msgrcv
+'???'				# semget
+'???'				# semctl
+'???'				# semop
+'???'				# getlogin
+'???'				# syscall
diff --git a/gnu/usr.bin/perl/t/op/lfs.t b/gnu/usr.bin/perl/t/op/lfs.t
new file mode 100644
index 00000000000..e704f6f57b6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/lfs.t
@@ -0,0 +1,226 @@
+# NOTE: this file tests how large files (>2GB) work with perlio (stdio/sfio).
+# sysopen(), sysseek(), syswrite(), sysread() are tested in t/lib/syslfs.t.
+# If you modify/add tests here, remember to update also t/lib/syslfs.t.
+
+BEGIN {
+	chdir 't' if -d 't';
+	unshift @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";
+		exit(0);
+	}
+}
+
+sub zap {
+    close(BIG);
+    unlink("big");
+    unlink("big1");
+    unlink("big2");
+}
+
+sub bye {
+    zap();	
+    exit(0);
+}
+
+sub explain {
+    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.)
+#
+# Perl may still be able to support large files, once you have
+# such a process, enough quota, and such a (file) system.
+#
+EOM
+}
+
+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";
+    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";
+    bye();
+}
+
+# Then try to heuristically deduce whether we have sparse files.
+
+# Let's not depend on Fcntl or any other extension.
+
+my ($SEEK_SET, $SEEK_CUR, $SEEK_END) = (0, 1, 2);
+
+# We'll start off by creating a one megabyte file which has
+# only three "true" bytes.  If we have sparseness, we should
+# consume less blocks than one megabyte (assuming nobody has
+# one megabyte blocks...)
+
+open(BIG, ">big1") or
+    do { warn "open big1 failed: $!\n"; bye };
+binmode(BIG) or
+    do { warn "binmode big1 failed: $!\n"; bye };
+seek(BIG, 1_000_000, $SEEK_SET) or
+    do { warn "seek big1 failed: $!\n"; bye };
+print BIG "big" or
+    do { warn "print big1 failed: $!\n"; bye };
+close(BIG) or
+    do { warn "close big1 failed: $!\n"; bye };
+
+my @s1 = stat("big1");
+
+print "# s1 = @s1\n";
+
+open(BIG, ">big2") or
+    do { warn "open big2 failed: $!\n"; bye };
+binmode(BIG) or
+    do { warn "binmode big2 failed: $!\n"; bye };
+seek(BIG, 2_000_000, $SEEK_SET) or
+    do { warn "seek big2 failed; $!\n"; bye };
+print BIG "big" or
+    do { warn "print big2 failed; $!\n"; bye };
+close(BIG) or
+    do { warn "close big2 failed; $!\n"; bye };
+
+my @s2 = stat("big2");
+
+print "# s2 = @s2\n";
+
+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";
+	bye;
+}
+
+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.
+
+$ENV{LC_ALL} = "C";
+
+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();
+    bye();
+}
+
+# Either the print or (more likely, thanks to buffering) the close will
+# fail if there are are filesize limitations (process or fs).
+my $print = print BIG "big";
+print "# print failed: $!\n" unless $print;
+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";
+    } elsif ($! =~ /quota/i) {
+	print "1..0\n# filesystem quota limits?\n";
+    }
+    explain();
+    bye();
+}
+
+@s = stat("big");
+
+print "# @s\n";
+
+unless ($s[7] == 5_000_000_003) {
+    print "1..0\n# not configured to use large files?\n";
+    explain();
+    bye();
+}
+
+sub fail () {
+    print "not ";
+    $fail++;
+}
+
+print "1..17\n";
+
+my $fail = 0;
+
+fail unless $s[7] == 5_000_000_003;	# exercizes pp_stat
+print "ok 1\n";
+
+fail unless -s "big" == 5_000_000_003;	# exercizes pp_ftsize
+print "ok 2\n";
+
+fail unless -e "big";
+print "ok 3\n";
+
+fail unless -f "big";
+print "ok 4\n";
+
+open(BIG, "big") or do { warn "open failed: $!\n"; bye };
+binmode BIG;
+
+fail unless seek(BIG, 4_500_000_000, $SEEK_SET);
+print "ok 5\n";
+
+fail unless 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;
+print "ok 8\n";
+
+fail unless seek(BIG, -1, $SEEK_CUR);
+print "ok 9\n";
+
+fail unless 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;
+print "ok 12\n";
+
+my $big;
+
+fail unless read(BIG, $big, 3) == 3;
+print "ok 13\n";
+
+fail unless $big eq "big";
+print "ok 14\n";
+
+# 705_032_704 = (I32)5_000_000_000
+fail unless seek(BIG, 705_032_704, $SEEK_SET);
+print "ok 15\n";
+
+my $zero;
+
+fail unless read(BIG, $zero, 3) == 3;
+print "ok 16\n";
+
+fail unless $zero eq "\0\0\0";
+print "ok 17\n";
+
+explain if $fail;
+
+bye(); # does the necessary cleanup
+
+END {
+   unlink "big"; # be paranoid about leaving 5 gig files lying around
+}
+
+# eof
diff --git a/gnu/usr.bin/perl/t/op/lop.t b/gnu/usr.bin/perl/t/op/lop.t
new file mode 100644
index 00000000000..f15201ff096
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/lop.t
@@ -0,0 +1,44 @@
+#!./perl
+
+#
+# test the logical operators '&&', '||', '!', 'and', 'or', 'not'
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+print "1..7\n";
+
+my $test = 0;
+for my $i (undef, 0 .. 2, "", "0 but true") {
+    my $true = 1;
+    my $false = 0;
+    for my $j (undef, 0 .. 2, "", "0 but true") {
+	$true &&= !(
+	    ((!$i || !$j) != !($i && $j))
+	    or (!($i || $j) != (!$i && !$j))
+	    or (!!($i || $j) != !(!$i && !$j))
+	    or (!(!$i || !$j) != !!($i && $j))
+	);
+	$false ||= (
+	    ((!$i || !$j) == !!($i && $j))
+	    and (!!($i || $j) == (!$i && !$j))
+	    and ((!$i || $j) == ($i && !$j))
+	    and (($i || !$j) != (!$i && $j))
+	);
+    }
+    if (not $true) {
+	print "not ";
+    } elsif ($false) {
+	print "not ";
+    }
+    print "ok ", ++$test, "\n";
+}
+
+# $test == 6
+my $i = 0;
+(($i ||= 1) &&= 3) += 4;
+print "not " unless $i == 7;
+print "ok ", ++$test, "\n";
diff --git a/gnu/usr.bin/perl/t/op/nothr5005.t b/gnu/usr.bin/perl/t/op/nothr5005.t
new file mode 100644
index 00000000000..fd36e2e89ab
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/nothr5005.t
@@ -0,0 +1,35 @@
+#!./perl
+
+# NOTE: Please don't add tests to this file unless they *need* to be run in
+# separate executable and can't simply use eval.
+
+BEGIN
+ {
+  chdir 't' if -d 't';
+  unshift @INC, "../lib";
+  require Config;
+  import Config;
+  if ($Config{'use5005threads'})
+   {
+    print "1..0 # Skip: this perl is threaded\n";
+    exit 0;
+   }
+ }
+
+
+$|=1;
+
+print "1..9\n";
+$t = 1;
+sub foo { local(@_) = ('p', 'q', 'r'); }
+sub bar { unshift @_, 'D'; @_ }
+sub baz { push @_, 'E'; return @_ }
+for (1..3) 
+ { 
+   print "not " unless join('',foo('a', 'b', 'c')) eq 'pqr';
+   print "ok ",$t++,"\n";
+   print "not" unless join('',bar('d')) eq 'Dd';
+   print "ok ",$t++,"\n";
+   print "not" unless join('',baz('e')) eq 'eE';
+   print "ok ",$t++,"\n";
+ } 
diff --git a/gnu/usr.bin/perl/t/op/numconvert.t b/gnu/usr.bin/perl/t/op/numconvert.t
new file mode 100644
index 00000000000..8eb9b6e3418
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/numconvert.t
@@ -0,0 +1,186 @@
+#!./perl
+
+#
+# test the conversion operators
+#
+# Notations:
+#
+# "N p i N vs N N":  Apply op-N, then op-p, then op-i, then reporter-N
+# Compare with application of op-N, then reporter-N
+# Right below are descriptions of different ops and reporters.
+
+# We do not use these subroutines any more, sub overhead makes a "switch"
+# solution better:
+
+# obviously, 0, 1 and 2, 3 are destructive.  (XXXX 64-bit? 4 destructive too)
+
+# *0 = sub {--$_[0]};		# -
+# *1 = sub {++$_[0]};		# +
+
+# # Converters
+# *2 = sub { $_[0] = $max_uv & $_[0]}; # U
+# *3 = sub { use integer; $_[0] += $zero}; # I
+# *4 = sub { $_[0] += $zero};	# N
+# *5 = sub { $_[0] = "$_[0]" };	# P
+
+# # Side effects
+# *6 = sub { $max_uv & $_[0]};	# u
+# *7 = sub { use integer; $_[0] + $zero};	# i
+# *8 = sub { $_[0] + $zero};	# n
+# *9 = sub { $_[0] . "" };	# p
+
+# # Reporters
+# sub a2 { sprintf "%u", $_[0] }	# U
+# sub a3 { sprintf "%d", $_[0] }	# I
+# sub a4 { sprintf "%g", $_[0] }	# N
+# sub a5 { "$_[0]" }		# P
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use strict 'vars';
+
+my $max_chain = $ENV{PERL_TEST_NUMCONVERTS} || 2;
+
+# Bulk out if unsigned type is hopelessly wrong:
+my $max_uv1 = ~0;
+my $max_uv2 = sprintf "%u", $max_uv1 ** 6; # 6 is an arbitrary number here
+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";
+  exit 0;
+}
+
+my $st_t = 4*4;			# We try 4 initializers and 4 reporters
+
+my $num = 0;
+$num += 10**$_ - 4**$_ for 1.. $max_chain;
+$num *= $st_t;
+print "1..$num\n";		# In fact 15 times more subsubtests...
+
+my $max_uv = ~0;
+my $max_iv = int($max_uv/2);
+my $zero = 0;
+
+my $l_uv = length $max_uv;
+my $l_iv = length $max_iv;
+
+# Hope: the first digits are good
+my $larger_than_uv = substr 97 x 100, 0, $l_uv;
+my $smaller_than_iv = substr 12 x 100, 0, $l_iv;
+my $yet_smaller_than_iv = substr 97 x 100, 0, ($l_iv - 1);
+
+my @list = (1, $yet_smaller_than_iv, $smaller_than_iv, $max_iv, $max_iv + 1,
+	    $max_uv, $max_uv + 1);
+unshift @list, (reverse map -$_, @list), 0; # 15 elts
+@list = map "$_", @list; # Normalize
+
+# print "@list\n";
+
+
+my @opnames = split //, "-+UINPuinp";
+
+# @list = map { 2->($_), 3->($_), 4->($_), 5->($_),  } @list; # Prepare input
+
+#print "@list\n";
+#print "'@ops'\n";
+
+my $test = 1;
+my $nok;
+for my $num_chain (1..$max_chain) {
+  my @ops = map [split //], grep /[4-9]/,
+    map { sprintf "%0${num_chain}d", $_ }  0 .. 10**$num_chain - 1;
+
+  #@ops = ([]) unless $num_chain;
+  #@ops = ([6, 4]);
+
+  # print "'@ops'\n";
+  for my $op (@ops) {
+    for my $first (2..5) {
+      for my $last (2..5) {
+	$nok = 0;
+	my @otherops = grep $_ <= 3, @$op;
+	my @curops = ($op,\@otherops);
+
+	for my $num (@list) {
+	  my $inpt;
+	  my @ans;
+
+	  for my $short (0, 1) {
+	    # undef $inpt;	# Forget all we had - some bugs were masked
+
+	    $inpt = $num;	# Try to not contaminate $num...
+	    $inpt = "$inpt";
+	    if ($first == 2) {
+	      $inpt = $max_uv & $inpt; # U 2
+	    } elsif ($first == 3) {
+	      use integer; $inpt += $zero; # I 3
+	    } elsif ($first == 4) {
+	      $inpt += $zero;	# N 4
+	    } else {
+	      $inpt = "$inpt";	# P 5
+	    }
+
+	    # Saves 20% of time - not with this logic:
+	    #my $tmp = $inpt;
+	    #my $tmp1 = $num;
+	    #next if $num_chain > 1
+	    #  and "$tmp" ne "$tmp1"; # Already the coercion gives problems...
+
+	    for my $curop (@{$curops[$short]}) {
+	      if ($curop < 5) {
+		if ($curop < 3) {
+		  if ($curop == 0) {
+		    --$inpt;	# - 0
+		  } elsif ($curop == 1) {
+		    ++$inpt;	# + 1
+		  } else {
+		    $inpt = $max_uv & $inpt; # U 2
+		  }
+		} elsif ($curop == 3) {
+		  use integer; $inpt += $zero;
+		} else {
+		  $inpt += $zero; # N 4
+		}
+	      } elsif ($curop < 8) {
+		if ($curop == 5) {
+		  $inpt = "$inpt"; # P 5
+		} elsif ($curop == 6) {
+		  $max_uv & $inpt; # u 6
+		} else {
+		  use integer; $inpt + $zero;
+		}
+	      } elsif ($curop == 8) {
+		$inpt + $zero;	# n 8
+	      } else {
+		$inpt . "";	# p 9
+	      }
+	    }
+
+	    if ($last == 2) {
+	      $inpt = sprintf "%u", $inpt; # U 2
+	    } elsif ($last == 3) {
+	      $inpt = sprintf "%d", $inpt; # I 3
+	    } elsif ($last == 4) {
+	      $inpt = sprintf "%g", $inpt; # N 4
+	    } else {
+	      $inpt = "$inpt";	# P 5
+	    }
+	    push @ans, $inpt;
+	  }
+	  $nok++,
+	    print "# '$ans[0]' ne '$ans[1]',\t$num\t=> @opnames[$first,@{$curops[0]},$last] vs @opnames[$first,@{$curops[1]},$last]\n"
+	      if $ans[0] ne $ans[1];
+	}
+	print "not " if $nok;
+	print "ok $test\n";
+	#print $txt if $nok;
+	$test++;
+      }
+    }
+  }
+}
diff --git a/gnu/usr.bin/perl/t/op/pwent.t b/gnu/usr.bin/perl/t/op/pwent.t
new file mode 100644
index 00000000000..ca14a99eec4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/pwent.t
@@ -0,0 +1,137 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, "../lib" if -d "../lib";
+    eval {my @n = getpwuid 0};
+    if ($@ && $@ =~ /(The \w+ function is unimplemented)/) {
+	print "1..0 # Skip: $1\n";
+	exit 0;
+    }
+    eval { require Config; import Config; };
+    my $reason;
+    if ($Config{'i_pwd'} ne 'define') {
+	$reason = '$Config{i_pwd} undefined';
+    }
+    elsif (not -f "/etc/passwd" ) { # Play safe.
+	$reason = 'no /etc/passwd file';
+    }
+
+    if (not defined $where) {	# Try NIS.
+	foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
+	    if (-x $ypcat &&
+		open(PW, "$ypcat passwd 2>/dev/null |") &&
+		defined(<PW>)) {
+		$where = "NIS passwd";
+		undef $reason;
+		last;
+	    }
+	}
+    }
+
+    if (not defined $where) {	# Try NetInfo.
+	foreach my $nidump (qw(/usr/bin/nidump)) {
+	    if (-x $nidump &&
+		open(PW, "$nidump passwd . 2>/dev/null |") &&
+		defined(<PW>)) {
+		$where = "NetInfo passwd";
+		undef $reason;
+		last;
+	    }
+	}
+    }
+
+    if (not defined $where) {	# Try local.
+	my $PW = "/etc/passwd";
+	if (-f $PW && open(PW, $PW) && defined(<PW>)) {
+	    $where = $PW;
+	    undef $reason;
+	}
+    }
+
+    if ($reason) {	# Give up.
+	print "1..0 # Skip: $reason\n";
+	exit 0;
+    }
+}
+
+# By now PW filehandle should be open and full of juicy password entries.
+
+print "1..1\n";
+
+# Go through at most this many users.
+# (note that the first entry has been read away by now)
+my $max = 25;
+
+my $n = 0;
+my $tst = 1;
+my %perfect;
+my %seen;
+
+while (<PW>) {
+    chomp;
+    my @s = split /:/;
+    my ($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} }, $.;
+    } else {
+	warn "# Your $where line $. is empty.\n";
+	next;
+    }
+    if ($n == $max) {
+	local $/;
+	my $junk = <PW>;
+	last;
+    }
+    # In principle we could whine if @s != 7 but do we know enough
+    # of passwd file formats everywhere?
+    if (@s == 7) {
+	@n = getpwuid($uid_s);
+	# 'nobody' et al.
+	next unless @n;
+	my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+	# Protect against one-to-many and many-to-one mappings.
+	if ($name_s ne $name) {
+	    @n = getpwnam($name_s);
+	    ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
+	    next if $name_s ne $name;
+	}
+	$perfect{$name_s}++
+	    if $name    eq $name_s    and
+               $uid     eq $uid_s     and
+# Do not compare passwords: think shadow passwords.
+               $gid     eq $gid_s     and
+               $gcos    eq $gcos_s    and
+               $home    eq $home_s    and
+               $shell   eq $shell_s;
+    }
+    $n++;
+}
+
+if (keys %perfect == 0) {
+    $max++;
+    print <<EOEX;
+#
+# The failure of op/pwent test is not necessarily serious.
+# It may fail due to local password administration conventions.
+# If you are for example using both NIS and local passwords,
+# test failure is possible.  Any distributed password scheme
+# can cause such failures.
+#
+# What the pwent test is doing is that it compares the $max first
+# entries of $where
+# with the results of getpwuid() and getpwnam() call.  If it finds no
+# matches at all, it suspects something is wrong.
+# 
+EOEX
+    print "not ";
+    $not = 1;
+} else {
+    $not = 0;
+}
+print "ok ", $tst++;
+print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
+print "\n";
+
+close(PW);
diff --git a/gnu/usr.bin/perl/t/op/subst_amp.t b/gnu/usr.bin/perl/t/op/subst_amp.t
new file mode 100644
index 00000000000..e2e7c0e5428
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/subst_amp.t
@@ -0,0 +1,104 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib' if -d '../lib';
+    require Config; import Config;
+}
+
+print "1..13\n";
+
+$_ = 'x' x 20; 
+s/\d*|x/<$&>/g; 
+$foo = '<>' . ('<x><>' x 20) ;
+print ($_ eq $foo ? "ok 1\n" : "not ok 1\n#'$_'\n#'$foo'\n");
+
+$t = 'aaa';
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/xx/g;
+print "not " unless "$_ @res" eq 'axxxx aaa a aaa aa';
+print "ok 2\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/x/g;
+print "not " unless "$_ @res" eq 'axx aaa a aaa aa';
+print "ok 3\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/xx/;
+print "not " unless "$_ @res" eq 'axxa aaa a';
+print "ok 4\n";
+
+$_ = $t;
+@res = ();
+pos = 1;
+s/\Ga(?{push @res, $_, $`})/x/;
+print "not " unless "$_ @res" eq 'axa aaa a';
+print "ok 5\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/xx/g;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
+print "ok 6\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x/g;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
+print "ok 7\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/xx/;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
+print "ok 8\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x/;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
+print "ok 9\n";
+
+sub x2 {'xx'}
+sub x1 {'x'}
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x2/ge;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxxx aaa a aaa aa';
+print "ok 10\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x1/ge;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axx aaa a aaa aa';
+print "ok 11\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x2/e;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axxa aaa a';
+print "ok 12\n";
+
+$a = $t;
+@res = ();
+pos ($a) = 1;
+$a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
+print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
+print "ok 13\n";
+
diff --git a/gnu/usr.bin/perl/t/op/subst_wamp.t b/gnu/usr.bin/perl/t/op/subst_wamp.t
new file mode 100644
index 00000000000..b716b30915a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/subst_wamp.t
@@ -0,0 +1,11 @@
+#!./perl
+
+$dummy = defined $&;		# Now we have it...
+for $file ('op/subst.t', 't/op/subst.t') {
+  if (-r $file) {
+    do $file;
+    exit;
+  }
+}
+die "Cannot find op/subst.t or t/op/subst.t\n";
+
diff --git a/gnu/usr.bin/perl/t/op/tiearray.t b/gnu/usr.bin/perl/t/op/tiearray.t
index 8e78b2f76b0..25fda3fb034 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';
-    @INC = '../lib';
+    unshift @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 d7e6a78bafa..6ae3faaaecd 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';
-    @INC = '../lib';
+    unshift @INC, '../lib';
 }
 
 my @expect;
diff --git a/gnu/usr.bin/perl/t/op/tr.t b/gnu/usr.bin/perl/t/op/tr.t
index 3503c3cf12f..4e6667cd7fb 100644
--- a/gnu/usr.bin/perl/t/op/tr.t
+++ b/gnu/usr.bin/perl/t/op/tr.t
@@ -1,5 +1,10 @@
 # tr.t
 
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, "../lib";
+}
+
 print "1..4\n";
 
 $_ = "abcdefghijklmnopqrstuvwxyz";
@@ -22,12 +27,13 @@ print "ok 3\n";
 # In EBCDIC 'I' is \xc9 and 'J' is \0xd1, 'i' is \x89 and 'j' is \x91.
 # Yes, discontinuities.  Regardless, the \xca in the below should stay
 # untouched (and not became \x8a).
+{
+    no utf8;
+    $_ = "I\xcaJ";
 
-$_ = "I\xcaJ";
-
-tr/I-J/i-j/;
-
-print "not " unless $_ eq "i\xcaj";
-print "ok 4\n";
+    tr/I-J/i-j/;
 
+    print "not " unless $_ eq "i\xcaj";
+    print "ok 4\n";
+}
 #
diff --git a/gnu/usr.bin/perl/t/op/ver.t b/gnu/usr.bin/perl/t/op/ver.t
new file mode 100644
index 00000000000..b08849f53a4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/ver.t
@@ -0,0 +1,96 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, "../lib";
+}
+
+print "1..22\n";
+
+my $test = 1;
+
+use v5.5.640;
+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;
+
+# poetry optimization should also
+sub v77 { "ok" }
+$x = v77;
+print "$x $test\n"; ++$test;
+
+# but not when dots are involved
+$x = v77.78.79;
+print "not " unless $x eq "MNO";
+print "ok $test\n";  ++$test;
+
+print "not " unless v1.20.300.4000 eq "\x{1}\x{14}\x{12c}\x{fa0}";
+print "ok $test\n";  ++$test;
+
+#
+# now do the same without the "v"
+use 5.5.640;
+require 5.5.640;
+print "ok $test\n";  ++$test;
+
+# hash keys too
+$h{111.107.32} = "ok";
+print "$h{ok } $test\n"; ++$test;
+
+$x = 77.78.79;
+print "not " unless $x eq "MNO";
+print "ok $test\n";  ++$test;
+
+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';
+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';
+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';
+print "ok $test\n";  ++$test;
+
+print "not " unless sprintf("%*vb", "##", v1.22.333.4444)
+    eq '1##10110##101001101##1000101011100';
+print "ok $test\n";  ++$test;
+
+{
+    use bytes;
+    print "not " unless sprintf("%vd", "Perl") eq '80.101.114.108';
+    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';
+    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';
+    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;
+}
diff --git a/gnu/usr.bin/perl/t/pod/emptycmd.t b/gnu/usr.bin/perl/t/pod/emptycmd.t
new file mode 100644
index 00000000000..d348a9d278a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/emptycmd.t
@@ -0,0 +1,21 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+__END__
+
+=pod
+
+= this is a test
+of the emergency
+broadcast system
+
+=cut
diff --git a/gnu/usr.bin/perl/t/pod/emptycmd.xr b/gnu/usr.bin/perl/t/pod/emptycmd.xr
new file mode 100644
index 00000000000..f06d2dbb097
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/emptycmd.xr
@@ -0,0 +1,2 @@
+    = this is a test of the emergency broadcast system
+
diff --git a/gnu/usr.bin/perl/t/pod/for.t b/gnu/usr.bin/perl/t/pod/for.t
new file mode 100644
index 00000000000..b8a6ec5c739
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/for.t
@@ -0,0 +1,59 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This is a test
+
+=for theloveofpete
+You shouldn't see this
+or this
+or this
+
+=for text
+pod2text should see this
+and this
+and this
+
+and everything should see this!
+
+=begin text
+
+Similarly, this line ...
+
+and this one ...
+
+as well this one,
+
+should all be in pod2text output
+
+=end text
+
+Tweedley-deedley-dee, Im as happy as can be!
+Tweedley-deedley-dum, cuz youre my honey sugar plum!
+
+=begin atthebeginning
+
+But I expect to see neither hide ...
+
+nor tail ...
+
+of this text
+
+=end atthebeginning
+
+The rest of this should show up in everything.
+
diff --git a/gnu/usr.bin/perl/t/pod/for.xr b/gnu/usr.bin/perl/t/pod/for.xr
new file mode 100644
index 00000000000..5f6b8b2ce8c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/for.xr
@@ -0,0 +1,21 @@
+    This is a test
+
+    pod2text should see this
+    and this
+    and this
+
+    and everything should see this!
+
+Similarly, this line ...
+
+and this one ...
+
+as well this one,
+
+should all be in pod2text output
+
+    Tweedley-deedley-dee, Im as happy as can be! Tweedley-deedley-dum, cuz
+    youre my honey sugar plum!
+
+    The rest of this should show up in everything.
+
diff --git a/gnu/usr.bin/perl/t/pod/headings.t b/gnu/usr.bin/perl/t/pod/headings.t
new file mode 100644
index 00000000000..fc7b4b265b2
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/headings.t
@@ -0,0 +1,140 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+#################################################################
+  use Pod::Usage;
+  pod2usage( VERBOSE => 2, EXIT => 1 );
+
+=pod
+
+=head1 NAME
+
+B<rdb2pg> - insert an rdb table into a PostgreSQL database
+
+=head1 SYNOPSIS
+
+B<rdb2pg>  [I<param>=I<value> ...]
+
+=head1 PARAMETERS
+
+B<rdb2pg> uses an IRAF-compatible parameter interface.  
+A template parameter file is in F</proj/axaf/simul/lib/uparm/rdb2pg.par>.
+
+=over 4
+
+=item B<input> I<file>
+
+The B<RDB> file to insert into the database. If the given name
+is the string C<stdin>, it reads from the UNIX standard input stream.
+
+
+=back
+
+=head1 DESCRIPTION
+
+B<rdb2pg> will enter the data from an B<RDB> database into a
+PostgreSQL database table, optionally creating the database and the
+table if they do not exist.  It automatically determines the
+PostgreSQL data type from the column definition in the B<RDB> file,
+but may be overriden via a series of definition files or directly
+via one of its parameters.
+
+The target database and table are specified by the C<db> and C<table>
+parameters.  If they do not exist, and the C<createdb> parameter is
+set, they will be created.  Table field definitions are determined
+in the following order:
+
+=cut
+
+#################################################################
+
+results in:
+
+
+#################################################################
+
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+    rdb2pg [*param*=*value* ...]
+
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    The RDB file to insert into the database. If the given name is
+    the string `stdin', it reads from the UNIX standard input
+    stream.
+
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
+
+#################################################################
+
+while the original version of Text (using pod2text) gives
+
+#################################################################
+
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template
+    parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name
+        is the string `stdin', it reads from the UNIX standard input
+        stream.
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a
+    PostgreSQL database table, optionally creating the database and
+    the table if they do not exist. It automatically determines the
+    PostgreSQL data type from the column definition in the RDB file,
+    but may be overriden via a series of definition files or
+    directly via one of its parameters.
+
+    The target database and table are specified by the `db' and
+    `table' parameters. If they do not exist, and the `createdb'
+    parameter is set, they will be created. Table field definitions
+    are determined in the following order:
+
+
+#################################################################
+
+
+Thanks for any help.  If, as your email indicates, you've not much
+time to look at this, I can work around things by calling pod2text()
+directly using the official Text.pm.
+
+Diab
+
+-------------
+Diab Jerius
+djerius@cfa.harvard.edu
+
diff --git a/gnu/usr.bin/perl/t/pod/headings.xr b/gnu/usr.bin/perl/t/pod/headings.xr
new file mode 100644
index 00000000000..fb37a2b0cf6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/headings.xr
@@ -0,0 +1,26 @@
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template parameter
+    file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name is the
+        string `stdin', it reads from the UNIX standard input stream.
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a PostgreSQL
+    database table, optionally creating the database and the table if they
+    do not exist. It automatically determines the PostgreSQL data type from
+    the column definition in the RDB file, but may be overriden via a series
+    of definition files or directly via one of its parameters.
+
+    The target database and table are specified by the `db' and `table'
+    parameters. If they do not exist, and the `createdb' parameter is set,
+    they will be created. Table field definitions are determined in the
+    following order:
+
diff --git a/gnu/usr.bin/perl/t/pod/include.t b/gnu/usr.bin/perl/t/pod/include.t
new file mode 100644
index 00000000000..6d0b7e34e55
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/include.t
@@ -0,0 +1,36 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This file tries to demonstrate a simple =include directive
+for pods. It is used as follows:
+
+   =include filename
+
+where "filename" is expected to be an absolute pathname, or else
+reside be relative to the directory in which the current processed
+podfile resides, or be relative to the current directory.
+
+Lets try it out with the file "included.t" shall we.
+
+***THIS TEXT IS IMMEDIATELY BEFORE THE INCLUDE***
+
+=include included.t
+
+***THIS TEXT IS IMMEDIATELY AFTER THE INCLUDE***
+
+So how did we do???
diff --git a/gnu/usr.bin/perl/t/pod/include.xr b/gnu/usr.bin/perl/t/pod/include.xr
new file mode 100644
index 00000000000..624ee444474
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/include.xr
@@ -0,0 +1,22 @@
+    This file tries to demonstrate a simple =include directive for pods. It
+    is used as follows:
+
+       =include filename
+
+    where "filename" is expected to be an absolute pathname, or else reside
+    be relative to the directory in which the current processed podfile
+    resides, or be relative to the current directory.
+
+    Lets try it out with the file "included.t" shall we.
+
+    ***THIS TEXT IS IMMEDIATELY BEFORE THE INCLUDE***
+
+###### begin =include included.t #####
+    This is the text of the included file named "included.t". It should
+    appear in the final pod document from pod2xxx
+
+###### end =include included.t #####
+    ***THIS TEXT IS IMMEDIATELY AFTER THE INCLUDE***
+
+    So how did we do???
+
diff --git a/gnu/usr.bin/perl/t/pod/included.t b/gnu/usr.bin/perl/t/pod/included.t
new file mode 100644
index 00000000000..0e31a090fc7
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/included.t
@@ -0,0 +1,35 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+##------------------------------------------------------------
+# This file is =included by "include.t"
+#
+# This text should NOT be in the resultant pod document
+# because we havent seen an =xxx pod directive in this file!
+##------------------------------------------------------------
+
+=pod
+
+This is the text of the included file named "included.t".
+It should appear in the final pod document from pod2xxx
+
+=cut
+
+##------------------------------------------------------------
+# This text should NOT be in the resultant pod document
+# because it is *after* an =cut an no other pod directives
+# proceed it!
+##------------------------------------------------------------
diff --git a/gnu/usr.bin/perl/t/pod/included.xr b/gnu/usr.bin/perl/t/pod/included.xr
new file mode 100644
index 00000000000..54142fa0d32
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/included.xr
@@ -0,0 +1,3 @@
+    This is the text of the included file named "included.t". It should
+    appear in the final pod document from pod2xxx
+
diff --git a/gnu/usr.bin/perl/t/pod/lref.t b/gnu/usr.bin/perl/t/pod/lref.t
new file mode 100644
index 00000000000..e367d6dd66c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/lref.t
@@ -0,0 +1,66 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+Try out I<LOTS> of different ways of specifying references:
+
+Reference the L<manpage/section>
+
+Reference the L<manpage / section>
+
+Reference the L<manpage/ section>
+
+Reference the L<manpage /section>
+
+Reference the L<"manpage/section">
+
+Reference the L<"manpage"/section>
+
+Reference the L<manpage/"section">
+
+Reference the L<manpage/
+section>
+
+Reference the L<manpage
+/section>
+
+Now try it using the new "|" stuff ...
+
+Reference the L<thistext|manpage/section>
+
+Reference the L<thistext | manpage / section>
+
+Reference the L<thistext| manpage/ section>
+
+Reference the L<thistext |manpage /section>
+
+Reference the L<thistext|
+"manpage/section">
+
+Reference the L<thistext
+|"manpage"/section>
+
+Reference the L<thistext|manpage/"section">
+
+Reference the L<thistext|
+manpage/
+section>
+
+Reference the L<thistext
+|manpage
+/section>
+
diff --git a/gnu/usr.bin/perl/t/pod/lref.xr b/gnu/usr.bin/perl/t/pod/lref.xr
new file mode 100644
index 00000000000..297053b1ace
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/lref.xr
@@ -0,0 +1,40 @@
+    Try out *LOTS* of different ways of specifying references:
+
+    Reference the the section entry in the manpage manpage
+
+    Reference the the section entry in the manpage manpage
+
+    Reference the the section entry in the manpage manpage
+
+    Reference the the section entry in the manpage manpage
+
+    Reference the the section on "manpage/section"
+
+    Reference the the section entry in the "manpage" manpage
+
+    Reference the the section on "section" in the manpage manpage
+
+    Reference the the section entry in the manpage manpage
+
+    Reference the the section entry in the manpage manpage
+
+    Now try it using the new "|" stuff ...
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
+    Reference the thistext
+
diff --git a/gnu/usr.bin/perl/t/pod/multiline_items.t b/gnu/usr.bin/perl/t/pod/multiline_items.t
new file mode 100644
index 00000000000..37e8d530698
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/multiline_items.t
@@ -0,0 +1,31 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=head1 Test multiline item lists
+
+This is a test to ensure that multiline =item paragraphs
+get indented appropriately.
+
+=over 4 
+
+=item This 
+is
+a
+test.
+
+=back
+
+=cut
diff --git a/gnu/usr.bin/perl/t/pod/multiline_items.xr b/gnu/usr.bin/perl/t/pod/multiline_items.xr
new file mode 100644
index 00000000000..dddf05fe348
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/multiline_items.xr
@@ -0,0 +1,5 @@
+Test multiline item lists
+    This is a test to ensure that multiline =item paragraphs get indented
+    appropriately.
+
+    This is a test.
diff --git a/gnu/usr.bin/perl/t/pod/nested_items.t b/gnu/usr.bin/perl/t/pod/nested_items.t
new file mode 100644
index 00000000000..9c098018d13
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/nested_items.t
@@ -0,0 +1,64 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=head1 Test nested item lists
+
+This is a test to ensure the nested =item paragraphs
+get indented appropriately.
+
+=over 2
+
+=item 1
+
+First section.
+
+=over 2
+
+=item a
+
+this is item a
+
+=item b
+
+this is item b
+
+=back
+
+=item 2
+
+Second section.
+
+=over 2
+
+=item a
+
+this is item a
+
+=item b
+
+this is item b
+
+=item c
+
+=item d
+
+This is item c & d.
+
+=back
+
+=back
+
+=cut
diff --git a/gnu/usr.bin/perl/t/pod/nested_items.xr b/gnu/usr.bin/perl/t/pod/nested_items.xr
new file mode 100644
index 00000000000..dd1adac1272
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/nested_items.xr
@@ -0,0 +1,19 @@
+Test nested item lists
+    This is a test to ensure the nested =item paragraphs get indented
+    appropriately.
+
+    1 First section.
+
+      a this is item a
+
+      b this is item b
+
+    2 Second section.
+
+      a this is item a
+
+      b this is item b
+
+      c
+      d This is item c & d.
+
diff --git a/gnu/usr.bin/perl/t/pod/nested_seqs.t b/gnu/usr.bin/perl/t/pod/nested_seqs.t
new file mode 100644
index 00000000000..6a5405bf47f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/nested_seqs.t
@@ -0,0 +1,23 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+The statement: C<This is dog kind's I<finest> hour!> is a parody of a
+quotation from Winston Churchill.
+
+=cut
+
diff --git a/gnu/usr.bin/perl/t/pod/nested_seqs.xr b/gnu/usr.bin/perl/t/pod/nested_seqs.xr
new file mode 100644
index 00000000000..f981061f949
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/nested_seqs.xr
@@ -0,0 +1,3 @@
+    The statement: `This is dog kind's *finest* hour!' is a parody of a
+    quotation from Winston Churchill.
+
diff --git a/gnu/usr.bin/perl/t/pod/oneline_cmds.t b/gnu/usr.bin/perl/t/pod/oneline_cmds.t
new file mode 100644
index 00000000000..3081ef4dc37
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/oneline_cmds.t
@@ -0,0 +1,46 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+==head1 NAME
+B<rdb2pg> - insert an rdb table into a PostgreSQL database
+
+==head1 SYNOPSIS
+B<rdb2pg>  [I<param>=I<value> ...]
+
+==head1 PARAMETERS
+B<rdb2pg> uses an IRAF-compatible parameter interface.  
+A template parameter file is in F</proj/axaf/simul/lib/uparm/rdb2pg.par>.
+
+==over 4
+==item B<input> I<file>
+The B<RDB> file to insert into the database. If the given name
+is the string C<stdin>, it reads from the UNIX standard input stream.
+
+==back
+
+==head1 DESCRIPTION
+B<rdb2pg> will enter the data from an B<RDB> database into a
+PostgreSQL database table, optionally creating the database and the
+table if they do not exist.  It automatically determines the
+PostgreSQL data type from the column definition in the B<RDB> file,
+but may be overriden via a series of definition files or directly
+via one of its parameters.
+
+The target database and table are specified by the C<db> and C<table>
+parameters.  If they do not exist, and the C<createdb> parameter is
+set, they will be created.  Table field definitions are determined
+in the following order:
+
diff --git a/gnu/usr.bin/perl/t/pod/oneline_cmds.xr b/gnu/usr.bin/perl/t/pod/oneline_cmds.xr
new file mode 100644
index 00000000000..fb37a2b0cf6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/oneline_cmds.xr
@@ -0,0 +1,26 @@
+NAME
+    rdb2pg - insert an rdb table into a PostgreSQL database
+
+SYNOPSIS
+    rdb2pg [*param*=*value* ...]
+
+PARAMETERS
+    rdb2pg uses an IRAF-compatible parameter interface. A template parameter
+    file is in /proj/axaf/simul/lib/uparm/rdb2pg.par.
+
+    input *file*
+        The RDB file to insert into the database. If the given name is the
+        string `stdin', it reads from the UNIX standard input stream.
+
+DESCRIPTION
+    rdb2pg will enter the data from an RDB database into a PostgreSQL
+    database table, optionally creating the database and the table if they
+    do not exist. It automatically determines the PostgreSQL data type from
+    the column definition in the RDB file, but may be overriden via a series
+    of definition files or directly via one of its parameters.
+
+    The target database and table are specified by the `db' and `table'
+    parameters. If they do not exist, and the `createdb' parameter is set,
+    they will be created. Table field definitions are determined in the
+    following order:
+
diff --git a/gnu/usr.bin/perl/t/pod/pod2usage.t b/gnu/usr.bin/perl/t/pod/pod2usage.t
new file mode 100644
index 00000000000..bceeeefce87
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/pod2usage.t
@@ -0,0 +1,18 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+=include pod2usage.PL
+
+
diff --git a/gnu/usr.bin/perl/t/pod/pod2usage.xr b/gnu/usr.bin/perl/t/pod/pod2usage.xr
new file mode 100644
index 00000000000..7315d4025a0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/pod2usage.xr
@@ -0,0 +1,55 @@
+###### begin =include pod2usage.PL #####
+NAME
+    pod2usage - print usage messages from embedded pod docs in files
+
+SYNOPSIS
+    pod2usage   [-help] [-man] [-exit *exitval*] [-output *outfile*]
+                [-verbose *level*] [-pathlist *dirlist*] *file*
+
+OPTIONS AND ARGUMENTS
+    -help   Print a brief help message and exit.
+
+    -man    Print this command's manual page and exit.
+
+    -exit *exitval*
+            The exit status value to return.
+
+    -output *outfile*
+            The output file to print to. If the special names "-" or ">&1"
+            or ">&STDOUT" are used then standard output is used. If ">&2" or
+            ">&STDERR" is used then standard error is used.
+
+    -verbose *level*
+            The desired level of verbosity to use:
+
+                1 : print SYNOPSIS only
+                2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections
+                3 : print the entire manpage (similar to running pod2text)
+
+    -pathlist *dirlist*
+            Specifies one or more directories to search for the input file
+            if it was not supplied with an absolute path. Each directory
+            path in the given list should be separated by a ':' on Unix (';'
+            on MSWin32 and DOS).
+
+    *file*  The pathname of a file containing pod documentation to be output
+            in usage mesage format (defaults to standard input).
+
+DESCRIPTION
+    pod2usage will read the given input file looking for pod documentation
+    and will print the corresponding usage message. If no input file is
+    specifed than standard input is read.
+
+    pod2usage invokes the pod2usage() function in the Pod::Usage module.
+    Please see the pod2usage() entry in the Pod::Usage manpage.
+
+SEE ALSO
+    the Pod::Usage manpage, the pod2text(1) manpage
+
+AUTHOR
+    Brad Appleton <bradapp@enteract.com>
+
+    Based on code for pod2text(1) written by Tom Christiansen
+    <tchrist@mox.perl.com>
+
+###### end =include pod2usage.PL #####
diff --git a/gnu/usr.bin/perl/t/pod/poderrs.t b/gnu/usr.bin/perl/t/pod/poderrs.t
new file mode 100644
index 00000000000..ec632c25385
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/poderrs.t
@@ -0,0 +1,125 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testpchk.pl";
+   import TestPodChecker;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodchecker \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+### Deliberately throw in some blank but non-empty lines
+                                        
+### The above line should contain spaces
+
+
+__END__
+
+
+=head1 NAME
+
+poderrors.t - test Pod::Checker on some pod syntax errors
+
+=unknown1 this is an unknown command with two N<unknownA>
+and D<unknownB> interior sequences.
+
+This is some paragraph text with some unknown interior sequences,
+such as Q<unknown2>,
+A<unknown3>,
+and Y<unknown4 V<unknown5>>.
+
+Now try some unterminated sequences like
+I<hello mudda!
+B<hello fadda!
+
+Here I am at C<camp granada!
+
+Camps is very,
+entertaining.
+And they say we'll have some fun if it stops raining!
+
+Okay, now use a non-empty blank line to terminate a paragraph and make
+sure we get a warning.
+	                                     	
+The above blank line contains tabs and spaces only
+
+=head1 Additional tests
+
+=head2 item without over
+
+=item oops
+
+=head2 back without over
+
+=back
+
+=head2 over without back
+
+=over 4
+
+=item oops
+
+=head2 end without begin
+
+=end
+
+=head2 begin and begin
+
+=begin html
+
+=begin text
+
+=end
+
+=end
+
+=head2 Nested sequences of the same type
+
+C<code I<italic C<code again!>>>
+
+=head2 Garbled entities
+
+E<alea iacta est>
+E<C<auml>>
+E<abcI<bla>>
+
+=head2 Unresolved internal links
+
+L</"begin or begin">
+L<"end with begin">
+L</OoPs>
+
+=head2 Some links with problems
+
+L<abc
+def>
+L<>
+L<"Warnings"> this one is ok
+
+=head2 Warnings
+
+L<passwd(5)>
+L<   some text|page/"section"   >
+
+=over 4
+
+=item bla
+
+=back 200
+
+=begin html
+
+What?
+
+=end xml
+
+=over 4
+
+=back
+
+see these unescaped < and > in the text?
+
+=cut
+
diff --git a/gnu/usr.bin/perl/t/pod/poderrs.xr b/gnu/usr.bin/perl/t/pod/poderrs.xr
new file mode 100644
index 00000000000..b8e5e86fd57
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/poderrs.xr
@@ -0,0 +1,33 @@
+*** ERROR: Unknown command 'unknown1' at line 25 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'Q' at line 29 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'A' at line 30 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'Y' at line 31 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'V' at line 31 in file pod/poderrs.t
+*** ERROR: unterminated B<...> at line 35 in file pod/poderrs.t
+*** ERROR: unterminated I<...> at line 34 in file pod/poderrs.t
+*** ERROR: unterminated C<...> at line 37 in file pod/poderrs.t
+*** WARNING: line containing nothing but whitespace in paragraph at line 45 in file pod/poderrs.t
+*** ERROR: =item without previous =over at line 52 in file pod/poderrs.t
+*** ERROR: =back without previous =over at line 56 in file pod/poderrs.t
+*** ERROR: =over on line 60 without closing =back (at head2) at line 64 in file pod/poderrs.t
+*** ERROR: =end without =begin at line 66 in file pod/poderrs.t
+*** ERROR: Nested =begin's (first at line 70:html) at line 72 in file pod/poderrs.t
+*** ERROR: =end without =begin at line 76 in file pod/poderrs.t
+*** ERROR: nested commands C<...C<...>...> at line 80 in file pod/poderrs.t
+*** ERROR: garbled entity E<alea iacta est> at line 84 in file pod/poderrs.t
+*** ERROR: garbled entity E<C<auml>> at line 85 in file pod/poderrs.t
+*** ERROR: garbled entity E<abcI<bla>> at line 86 in file pod/poderrs.t
+*** WARNING: collapsing newlines to blanks at line 96 in file pod/poderrs.t
+*** ERROR: malformed link L<> : empty link at line 98 in file pod/poderrs.t
+*** WARNING: ignoring leading whitespace in link at line 104 in file pod/poderrs.t
+*** WARNING: ignoring trailing whitespace in link at line 104 in file pod/poderrs.t
+*** ERROR: Spurious character(s) after =back at line 110 in file pod/poderrs.t
+*** WARNING: No items in =over (at line 118) / =back list at line 120 in file pod/poderrs.t
+*** WARNING: 2 unescaped <> in paragraph at line 122 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'begin or begin' at line 90 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'end with begin' at line 91 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'OoPs' at line 92 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'abc def' at line 96 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'passwd(5)' at line 103 in file pod/poderrs.t
+*** WARNING: multiple occurence of link target 'oops' at line - in file pod/poderrs.t
+pod/poderrs.t has 25 pod syntax errors.
diff --git a/gnu/usr.bin/perl/t/pod/podselect.t b/gnu/usr.bin/perl/t/pod/podselect.t
new file mode 100644
index 00000000000..30eb30c9b03
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/podselect.t
@@ -0,0 +1,18 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+=include podselect.PL
+
+
diff --git a/gnu/usr.bin/perl/t/pod/podselect.xr b/gnu/usr.bin/perl/t/pod/podselect.xr
new file mode 100644
index 00000000000..7d1188d84c6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/podselect.xr
@@ -0,0 +1,42 @@
+###### begin =include podselect.PL #####
+NAME
+    podselect - print selected sections of pod documentation on standard
+    output
+
+SYNOPSIS
+    podselect [-help] [-man] [-section *section-spec*] [*file* ...]
+
+OPTIONS AND ARGUMENTS
+    -help   Print a brief help message and exit.
+
+    -man    Print the manual page and exit.
+
+    -section *section-spec*
+            Specify a section to include in the output. See the section on
+            "SECTION SPECIFICATIONS" in the Pod::Parser manpage for the
+            format to use for *section-spec*. This option may be given
+            multiple times on the command line.
+
+    *file*  The pathname of a file from which to select sections of pod
+            documentation (defaults to standard input).
+
+DESCRIPTION
+    podselect will read the given input files looking for pod documentation
+    and will print out (in raw pod format) all sections that match one ore
+    more of the given section specifications. If no section specifications
+    are given than all pod sections encountered are output.
+
+    podselect invokes the podselect() function exported by Pod::Select
+    Please see the podselect() entry in the Pod::Select manpage for more
+    details.
+
+SEE ALSO
+    the Pod::Parser manpage and the Pod::Select manpage
+
+AUTHOR
+    Brad Appleton <bradapp@enteract.com>
+
+    Based on code for Pod::Text::pod2text(1) written by Tom Christiansen
+    <tchrist@mox.perl.com>
+
+###### end =include podselect.PL #####
diff --git a/gnu/usr.bin/perl/t/pod/special_seqs.t b/gnu/usr.bin/perl/t/pod/special_seqs.t
new file mode 100644
index 00000000000..b8af57ee058
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/special_seqs.t
@@ -0,0 +1,43 @@
+#!./perl
+BEGIN {
+   chdir 't' if -d 't';
+   unshift @INC, './pod', '../lib';
+   require "testp2pt.pl";
+   import TestPodIncPlainText;
+}
+
+my %options = map { $_ => 1 } @ARGV;  ## convert cmdline to options-hash
+my $passed  = testpodplaintext \%options, $0;
+exit( ($passed == 1) ? 0 : -1 )  unless $ENV{HARNESS_ACTIVE};
+
+
+__END__
+
+
+=pod
+
+This is a test to see if I can do not only C<$self> and C<method()>, but
+also C<< $self->method() >> and C<< $self->{FIELDNAME} >> and
+C<< $Foo <=> $Bar >> without resorting to escape sequences. If 
+I want to refer to the right-shift operator I can do something
+like C<<< $x >> 3 >>> or even C<<<< $y >> 5 >>>>.
+
+Now for the grand finale of C<< $self->method()->{FIELDNAME} = {FOO=>BAR} >>.
+And I also want to make sure that newlines work like this
+C<<<
+$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]
+>>>
+
+Of course I should still be able to do all this I<with> escape sequences
+too: C<$self-E<gt>method()> and C<$self-E<gt>{FIELDNAME}> and C<{FOO=E<gt>BAR}>.
+
+Dont forget C<$self-E<gt>method()-E<gt>{FIELDNAME} = {FOO=E<gt>BAR}>.
+
+And make sure that C<0> works too!
+
+Now, if I use << or >> as my delimiters, then I have to use whitespace.
+So things like C<<$self->method()>> and C<<$self->{FIELDNAME}>> wont end
+up doing what you might expect since the first > will still terminate
+the first < seen.
+
+=cut
diff --git a/gnu/usr.bin/perl/t/pod/special_seqs.xr b/gnu/usr.bin/perl/t/pod/special_seqs.xr
new file mode 100644
index 00000000000..a07f4cf417e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/special_seqs.xr
@@ -0,0 +1,22 @@
+    This is a test to see if I can do not only `$self' and `method()', but
+    also `$self->method()' and `$self->{FIELDNAME}' and `$Foo <=> $Bar'
+    without resorting to escape sequences. If I want to refer to the
+    right-shift operator I can do something like `$x >> 3' or even `$y >>
+    5'.
+
+    Now for the grand finale of `$self->method()->{FIELDNAME} = {FOO=>BAR}'.
+    And I also want to make sure that newlines work like this
+    `$self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b]'
+
+    Of course I should still be able to do all this *with* escape sequences
+    too: `$self->method()' and `$self->{FIELDNAME}' and `{FOO=>BAR}'.
+
+    Dont forget `$self->method()->{FIELDNAME} = {FOO=>BAR}'.
+
+    And make sure that `0' works too!
+
+    Now, if I use << or >> as my delimiters, then I have to use whitespace.
+    So things like `<$self-'method()>> and `<$self-'{FIELDNAME}>> wont end
+    up doing what you might expect since the first > will still terminate
+    the first < seen.
+
diff --git a/gnu/usr.bin/perl/t/pod/testcmp.pl b/gnu/usr.bin/perl/t/pod/testcmp.pl
new file mode 100644
index 00000000000..5f6217192ce
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/testcmp.pl
@@ -0,0 +1,91 @@
+package TestCompare;
+
+use vars qw(@ISA @EXPORT $MYPKG);
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+use File::Basename;
+use File::Spec;
+use FileHandle;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&testcmp);
+$MYPKG = eval { (caller)[0] };
+
+##--------------------------------------------------------------------------
+
+=head1 NAME
+
+testcmp -- compare two files line-by-line
+
+=head1 SYNOPSIS
+
+    $is_diff = testcmp($file1, $file2);
+
+or
+
+    $is_diff = testcmp({-cmplines => \&mycmp}, $file1, $file2);
+
+=head2 DESCRIPTION
+
+Compare two text files line-by-line and return 0 if they are the
+same, 1 if they differ. Each of $file1 and $file2 may be a filenames,
+or a filehandles (in which case it must already be open for reading).
+
+If the first argument is a hashref, then the B<-cmplines> key in the
+hash may have a subroutine reference as its corresponding value.
+The referenced user-defined subroutine should be a line-comparator
+function that takes two pre-chomped text-lines as its arguments
+(the first is from $file1 and the second is from $file2). It should
+return 0 if it considers the two lines equivalent, and non-zero
+otherwise.
+
+=cut
+
+##--------------------------------------------------------------------------
+
+sub testcmp( $ $ ; $) {
+   my %opts = ref($_[0]) eq 'HASH' ? %{shift()} : ();
+   my ($file1, $file2) = @_;
+   my ($fh1, $fh2) = ($file1, $file2);
+   unless (ref $fh1) {
+      $fh1 = FileHandle->new($file1, "r") or die "Can't open $file1: $!";
+   }
+   unless (ref $fh2) {
+      $fh2 = FileHandle->new($file2, "r") or die "Can't open $file2: $!";
+   }
+  
+   my $cmplines = $opts{'-cmplines'} || undef;
+   my ($f1text, $f2text) = ("", "");
+   my ($line, $diffs)    = (0, 0);
+  
+   while ( defined($f1text) and defined($f2text) ) {
+      defined($f1text = <$fh1>)  and  chomp($f1text);
+      defined($f2text = <$fh2>)  and  chomp($f2text);
+      ++$line;
+      last unless ( defined($f1text) and defined($f2text) );
+      $diffs = (ref $cmplines) ? &$cmplines($f1text, $f2text)
+                               : ($f1text ne $f2text);
+      last if $diffs;
+   }
+   close($fh1) unless (ref $file1);
+   close($fh2) unless (ref $file2);
+  
+   $diffs = 1  if (defined($f1text) or defined($f2text));
+   if ( defined($f1text) and defined($f2text) ) {
+      ## these two lines must be different
+      warn "$file1 and $file2 differ at line $line\n";
+   }
+   elsif (defined($f1text)  and  (! defined($f1text))) {
+      ## file1 must be shorter
+      warn "$file1 is shorter than $file2\n";
+   }
+   elsif (defined $f2text) {
+      ## file2 must be longer
+      warn "$file1 is shorter than $file2\n";
+   }
+   return $diffs;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/pod/testp2pt.pl b/gnu/usr.bin/perl/t/pod/testp2pt.pl
new file mode 100644
index 00000000000..2ff8aa427a3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/testp2pt.pl
@@ -0,0 +1,192 @@
+package TestPodIncPlainText;
+
+BEGIN {
+   use File::Basename;
+   use File::Spec;
+   use Cwd qw(abs_path);
+   push @INC, '..';
+   my $THISDIR = abs_path(dirname $0);
+   unshift @INC, $THISDIR;
+   require "testcmp.pl";
+   import TestCompare;
+   my $PARENTDIR = dirname $THISDIR;
+   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
+}
+
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+#use File::Compare;
+#use Cwd qw(abs_path);
+
+use vars qw($MYPKG @EXPORT @ISA);
+$MYPKG = eval { (caller)[0] };
+@EXPORT = qw(&testpodplaintext);
+BEGIN {
+    if ( $] >= 5.005_58 ) {
+       require Pod::Text;
+       @ISA = qw( Pod::Text );
+    }
+    else {
+       require Pod::PlainText;
+       @ISA = qw( Pod::PlainText );
+    }
+    require VMS::Filespec if $^O eq 'VMS';
+}
+
+## Hardcode settings for TERMCAP and COLUMNS so we can try to get
+## reproducible results between environments
+@ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76);
+
+sub catfile(@) { File::Spec->catfile(@_); }
+
+my $INSTDIR = abs_path(dirname $0);
+$INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS';
+$INSTDIR =~ s#/$## if $^O eq 'VMS';
+$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
+$INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
+my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
+                   catfile($INSTDIR, 'scripts'),
+                   catfile($INSTDIR, 'pod'),
+                   catfile($INSTDIR, 't', 'pod')
+                 );
+
+## Find the path to the file to =include
+sub findinclude {
+    my $self    = shift;
+    my $incname = shift;
+
+    ## See if its already found w/out any "searching;
+    return  $incname if (-r $incname);
+
+    ## Need to search for it. Look in the following directories ...
+    ##   1. the directory containing this pod file
+    my $thispoddir = dirname $self->input_file;
+    ##   2. the parent directory of the above
+    my $parentdir  = dirname $thispoddir;
+    my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS);
+
+    for (@podincdirs) {
+       my $incfile = catfile($_, $incname);
+       return $incfile  if (-r $incfile);
+    }
+    warn("*** Can't find =include file $incname in @podincdirs\n");
+    return "";
+}
+
+sub command {
+    my $self = shift;
+    my ($cmd, $text, $line_num, $pod_para)  = @_;
+    $cmd     = ''  unless (defined $cmd);
+    local $_ = $text || '';
+    my $out_fh  = $self->output_handle;
+
+    ## Defer to the superclass for everything except '=include'
+    return  $self->SUPER::command(@_) unless ($cmd eq "include");
+
+    ## We have an '=include' command
+    my $incdebug = 1; ## debugging
+    my @incargs = split;
+    if (@incargs == 0) {
+        warn("*** No filename given for '=include'\n");
+        return;
+    }
+    my $incfile  = $self->findinclude(shift @incargs)  or  return;
+    my $incbase  = basename $incfile;
+    print $out_fh "###### begin =include $incbase #####\n"  if ($incdebug);
+    $self->parse_from_file( {-cutting => 1}, $incfile );
+    print $out_fh "###### end =include $incbase #####\n"    if ($incdebug);
+}
+
+sub begin_input {
+   $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS';
+}
+
+sub podinc2plaintext( $ $ ) {
+    my ($infile, $outfile) = @_;
+    local $_;
+    my $text_parser = $MYPKG->new;
+    $text_parser->parse_from_file($infile, $outfile);
+}
+
+sub testpodinc2plaintext( @ ) {
+   my %args = @_;
+   my $infile  = $args{'-In'}  || croak "No input file given!";
+   my $outfile = $args{'-Out'} || croak "No output file given!";
+   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
+
+   my $different = '';
+   my $testname = basename $cmpfile, '.t', '.xr';
+
+   unless (-e $cmpfile) {
+      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
+      warn  "$msg\n";
+      return  $msg;
+   }
+
+   print "# Running testpodinc2plaintext for '$testname'...\n";
+   ## Compare the output against the expected result
+   podinc2plaintext($infile, $outfile);
+   if ( testcmp($outfile, $cmpfile) ) {
+       $different = "$outfile is different from $cmpfile";
+   }
+   else {
+       unlink($outfile);
+   }
+   return  $different;
+}
+
+sub testpodplaintext( @ ) {
+   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
+   my @testpods = @_;
+   my ($testname, $testdir) = ("", "");
+   my ($podfile, $cmpfile) = ("", "");
+   my ($outfile, $errfile) = ("", "");
+   my $passes = 0;
+   my $failed = 0;
+   local $_;
+
+   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
+
+   for $podfile (@testpods) {
+      ($testname, $_) = fileparse($podfile);
+      $testdir ||=  $_;
+      $testname  =~ s/\.t$//;
+      $cmpfile   =  $testdir . $testname . '.xr';
+      $outfile   =  $testdir . $testname . '.OUT';
+
+      if ($opts{'-xrgen'}) {
+          if ($opts{'-force'} or ! -e $cmpfile) {
+             ## Create the comparison file
+             print "# Creating expected result for \"$testname\"" .
+                   " pod2plaintext test ...\n";
+             podinc2plaintext($podfile, $cmpfile);
+          }
+          else {
+             print "# File $cmpfile already exists" .
+                   " (use '-force' to regenerate it).\n";
+          }
+          next;
+      }
+
+      my $failmsg = testpodinc2plaintext
+                        -In  => $podfile,
+                        -Out => $outfile,
+                        -Cmp => $cmpfile;
+      if ($failmsg) {
+          ++$failed;
+          print "#\tFAILED. ($failmsg)\n";
+	  print "not ok ", $failed+$passes, "\n";
+      }
+      else {
+          ++$passes;
+          unlink($outfile);
+          print "#\tPASSED.\n";
+	  print "ok ", $failed+$passes, "\n";
+      }
+   }
+   return  $passes;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/pod/testpchk.pl b/gnu/usr.bin/perl/t/pod/testpchk.pl
new file mode 100644
index 00000000000..8aa10b94f87
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pod/testpchk.pl
@@ -0,0 +1,129 @@
+package TestPodChecker;
+
+BEGIN {
+   use File::Basename;
+   use File::Spec;
+   push @INC, '..';
+   my $THISDIR = dirname $0;
+   unshift @INC, $THISDIR;
+   require "testcmp.pl";
+   import TestCompare;
+   my $PARENTDIR = dirname $THISDIR;
+   push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
+   require VMS::Filespec if $^O eq 'VMS';
+}
+
+use Pod::Checker;
+use vars qw(@ISA @EXPORT $MYPKG);
+#use strict;
+#use diagnostics;
+use Carp;
+use Exporter;
+#use File::Compare;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&testpodchecker);
+$MYPKG = eval { (caller)[0] };
+
+sub stripname( $ ) {
+   local $_ = shift;
+   return /(\w[.\w]*)\s*$/ ? $1 : $_;
+}
+
+sub msgcmp( $ $ ) {
+   ## filter out platform-dependent aspects of error messages
+   my ($line1, $line2) = @_;
+   for ($line1, $line2) {
+      ## remove filenames from error messages to avoid any
+      ## filepath naming differences between OS platforms
+      s/(at line \S+ in file) .*\W(\w+\.[tT])\s*$/$1 \L$2\E/;
+      s/.*\W(\w+\.[tT]) (has \d+ pod syntax error)/\L$1\E $2/;
+   }
+   return ($line1 ne $line2);
+}
+
+sub testpodcheck( @ ) {
+   my %args = @_;
+   my $infile  = $args{'-In'}  || croak "No input file given!";
+   my $outfile = $args{'-Out'} || croak "No output file given!";
+   my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
+
+   my $different = '';
+   my $testname = basename $cmpfile, '.t', '.xr';
+
+   unless (-e $cmpfile) {
+      my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
+      warn  "$msg\n";
+      return  $msg;
+   }
+
+   print "# Running podchecker for '$testname'...\n";
+   ## Compare the output against the expected result
+   if ($^O eq 'VMS') {
+      for ($infile, $outfile, $cmpfile) {
+         $_ = VMS::Filespec::unixify($_)  unless  ref;
+      }
+   }
+   podchecker($infile, $outfile);
+   if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) {
+       $different = "$outfile is different from $cmpfile";
+   }
+   else {
+       unlink($outfile);
+   }
+   return  $different;
+}
+
+sub testpodchecker( @ ) {
+   my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
+   my @testpods = @_;
+   my ($testname, $testdir) = ("", "");
+   my ($podfile, $cmpfile) = ("", "");
+   my ($outfile, $errfile) = ("", "");
+   my $passes = 0;
+   my $failed = 0;
+   local $_;
+
+   print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
+
+   for $podfile (@testpods) {
+      ($testname, $_) = fileparse($podfile);
+      $testdir ||=  $_;
+      $testname  =~ s/\.t$//;
+      $cmpfile   =  $testdir . $testname . '.xr';
+      $outfile   =  $testdir . $testname . '.OUT';
+
+      if ($opts{'-xrgen'}) {
+          if ($opts{'-force'} or ! -e $cmpfile) {
+             ## Create the comparison file
+             print "# Creating expected result for \"$testname\"" .
+                   " podchecker test ...\n";
+             podchecker($podfile, $cmpfile);
+          }
+          else {
+             print "# File $cmpfile already exists" .
+                   " (use '-force' to regenerate it).\n";
+          }
+          next;
+      }
+
+      my $failmsg = testpodcheck
+                        -In  => $podfile,
+                        -Out => $outfile,
+                        -Cmp => $cmpfile;
+      if ($failmsg) {
+          ++$failed;
+          print "#\tFAILED. ($failmsg)\n";
+	  print "not ok ", $failed+$passes, "\n";
+      }
+      else {
+          ++$passes;
+          unlink($outfile);
+          print "#\tPASSED.\n";
+	  print "ok ", $failed+$passes, "\n";
+      }
+   }
+   return  $passes;
+}
+
+1;
diff --git a/gnu/usr.bin/perl/t/pragma/diagnostics.t b/gnu/usr.bin/perl/t/pragma/diagnostics.t
new file mode 100644
index 00000000000..15cd6b59276
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/diagnostics.t
@@ -0,0 +1,38 @@
+#!./perl
+
+BEGIN {
+    chdir '..' if -d '../pod';
+    unshift @INC, './lib' if -d './lib';
+}
+
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+use strict;
+use warnings;
+
+use vars qw($Test_Num $Total_tests);
+
+my $loaded;
+BEGIN { $| = 1; $Test_Num = 1 }
+END {print "not ok $Test_Num\n" unless $loaded;}
+print "1..$Total_tests\n";
+BEGIN { require diagnostics; } # Don't want diagnostics' noise yet.
+$loaded = 1;
+ok($loaded, 'compile');
+######################### End of black magic.
+
+sub ok {
+	my($test, $name) = shift;
+	print "not " unless $test;
+	print "ok $Test_Num";
+	print " - $name" if defined $name;
+	print "\n";
+	$Test_Num++;
+}
+
+
+# Change this to your # of ok() calls + 1
+BEGIN { $Total_tests = 1 }
diff --git a/gnu/usr.bin/perl/t/pragma/locale/latin1 b/gnu/usr.bin/perl/t/pragma/locale/latin1
new file mode 100644
index 00000000000..f40f7325e0f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/locale/latin1
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Catal� Catalan:ca:es:1 15
+Fran�ais French:fr:be ca ch fr lu:1 15
+G�idhlig Gaelic:gd:gb uk:1 14 15
+F�royskt Faroese:fo:fo:1 15
+�slensku Icelandic:is:is:1 15
+S�mi Lappish:::4 6 13
+Portugu�s Portuguese:po:po br:1 15
+Espan�l Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF
diff --git a/gnu/usr.bin/perl/t/pragma/locale/utf8 b/gnu/usr.bin/perl/t/pragma/locale/utf8
new file mode 100644
index 00000000000..fbbe94fb51d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/locale/utf8
@@ -0,0 +1,10 @@
+$locales .= <<EOF;
+Català Catalan:ca:es:1 15
+Français French:fr:be ca ch fr lu:1 15
+Gáidhlig Gaelic:gd:gb uk:1 14 15
+Føroyskt Faroese:fo:fo:1 15
+Íslensku Icelandic:is:is:1 15
+Sámi Lappish:::4 6 13
+Português Portuguese:po:po br:1 15
+Espanõl Spanish:es:ar bo cl co cr do ec es gt hn mx ni pa pe py sv uy ve:1 15
+EOF
diff --git a/gnu/usr.bin/perl/t/pragma/sub_lval.t b/gnu/usr.bin/perl/t/pragma/sub_lval.t
new file mode 100644
index 00000000000..e96c329d8ef
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/sub_lval.t
@@ -0,0 +1,429 @@
+print "1..46\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+sub a : lvalue { my $a = 34; bless \$a }  # Return a temporary
+sub b : lvalue { shift }
+
+my $out = a(b());		# Check that temporaries are allowed.
+print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
+print "ok 1\n";
+
+my @out = grep /main/, a(b()); # Check that temporaries are allowed.
+print "# `@out'\nnot " unless @out==1; # Not reached if error.
+print "ok 2\n";
+
+my $in;
+
+# Check that we can return localized values from subroutines:
+
+sub in : lvalue { $in = shift; }
+sub neg : lvalue {  #(num_str) return num_str
+    local $_ = shift;
+    s/^\+/-/;
+    $_;
+}
+in(neg("+2"));
+
+
+print "# `$in'\nnot " unless $in eq '-2';
+print "ok 3\n";
+
+sub get_lex : lvalue { $in }
+sub get_st : lvalue { $blah }
+sub id : lvalue { shift }
+sub id1 : lvalue { $_[0] }
+sub inc : lvalue { ++$_[0] }
+
+$in = 5;
+$blah = 3;
+
+get_st = 7;
+
+print "# `$blah' ne 7\nnot " unless $blah eq 7;
+print "ok 4\n";
+
+get_lex = 7;
+
+print "# `$in' ne 7\nnot " unless $in eq 7;
+print "ok 5\n";
+
+++get_st;
+
+print "# `$blah' ne 8\nnot " unless $blah eq 8;
+print "ok 6\n";
+
+++get_lex;
+
+print "# `$in' ne 8\nnot " unless $in eq 8;
+print "ok 7\n";
+
+id(get_st) = 10;
+
+print "# `$blah' ne 10\nnot " unless $blah eq 10;
+print "ok 8\n";
+
+id(get_lex) = 10;
+
+print "# `$in' ne 10\nnot " unless $in eq 10;
+print "ok 9\n";
+
+++id(get_st);
+
+print "# `$blah' ne 11\nnot " unless $blah eq 11;
+print "ok 10\n";
+
+++id(get_lex);
+
+print "# `$in' ne 11\nnot " unless $in eq 11;
+print "ok 11\n";
+
+id1(get_st) = 20;
+
+print "# `$blah' ne 20\nnot " unless $blah eq 20;
+print "ok 12\n";
+
+id1(get_lex) = 20;
+
+print "# `$in' ne 20\nnot " unless $in eq 20;
+print "ok 13\n";
+
+++id1(get_st);
+
+print "# `$blah' ne 21\nnot " unless $blah eq 21;
+print "ok 14\n";
+
+++id1(get_lex);
+
+print "# `$in' ne 21\nnot " unless $in eq 21;
+print "ok 15\n";
+
+inc(get_st);
+
+print "# `$blah' ne 22\nnot " unless $blah eq 22;
+print "ok 16\n";
+
+inc(get_lex);
+
+print "# `$in' ne 22\nnot " unless $in eq 22;
+print "ok 17\n";
+
+inc(id(get_st));
+
+print "# `$blah' ne 23\nnot " unless $blah eq 23;
+print "ok 18\n";
+
+inc(id(get_lex));
+
+print "# `$in' ne 23\nnot " unless $in eq 23;
+print "ok 19\n";
+
+++inc(id1(id(get_st)));
+
+print "# `$blah' ne 25\nnot " unless $blah eq 25;
+print "ok 20\n";
+
+++inc(id1(id(get_lex)));
+
+print "# `$in' ne 25\nnot " unless $in eq 25;
+print "ok 21\n";
+
+@a = (1) x 3;
+@b = (undef) x 2;
+$#c = 3;			# These slots are not fillable.
+
+# Explanation: empty slots contain &sv_undef.
+
+=for disabled constructs
+
+sub a3 :lvalue {@a}
+sub b2 : lvalue {@b}
+sub c4: lvalue {@c}
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
+  1;
+EOE
+
+#@out = ($x, a3, $y, b2, $z, c4, $t);
+#@in = (34 .. 41, (undef) x 4, 46);
+#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+=cut
+
+print "ok 22\n";
+
+my $var;
+
+sub a::var : lvalue { $var }
+
+"a"->var = 45;
+
+print "# `$var' ne 45\nnot " unless $var eq 45;
+print "ok 23\n";
+
+my $oo;
+$o = bless \$oo, "a";
+
+$o->var = 47;
+
+print "# `$var' ne 47\nnot " unless $var eq 47;
+print "ok 24\n";
+
+sub o : lvalue { $o }
+
+o->var = 49;
+
+print "# `$var' ne 49\nnot " unless $var eq 49;
+print "ok 25\n";
+
+sub nolv () { $x0, $x1 } # Not lvalue
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3);
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 26\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 27\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  &nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 28\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3) if $_;
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
+print "ok 29\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3);
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot "
+  unless /Can\'t modify non-lvalue subroutine call/;
+print "ok 30\n";
+
+sub lv0 : lvalue { }		# Converted to lv10 in scalar context
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv0 = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 31\n";
+
+sub lv10 : lvalue {}
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv0) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " if defined $_;
+print "ok 32\n";
+
+sub lv1u :lvalue { undef }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1u = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 33\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1u) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 34\n";
+
+$x = '1234567';
+sub lv1t : lvalue { index $x, 2 }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1t = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 35\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1t) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 36\n";
+
+$xxx = 'xxx';
+sub xxx () { $xxx }  # Not lvalue
+sub lv1tmp : lvalue { xxx }			# is it a TEMP?
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1tmp = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 37\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmp) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 38\n";
+
+sub xxx () { 'xxx' } # Not lvalue
+sub lv1tmpr : lvalue { xxx }			# is it a TEMP?
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1tmpr = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 39\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmpr) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 40\n";
+
+=for disabled constructs
+
+sub lva : lvalue {@a}
+
+$_ = undef;
+@a = ();
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 41\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 42\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 43\n";
+
+=cut
+
+print "ok $_\n" for 41..43;
+
+sub lv1n : lvalue { $newvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1n = (3,4);
+  1;
+EOE
+
+print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
+print "ok 44\n";
+
+sub lv1nn : lvalue { $nnewvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1nn) = (3,4);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
+print "ok 45\n";
+
+$a = \&lv1nn;
+$a->() = 8;
+print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
+print "ok 46\n";
diff --git a/gnu/usr.bin/perl/t/pragma/utf8.t b/gnu/usr.bin/perl/t/pragma/utf8.t
new file mode 100644
index 00000000000..0e55a67d693
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/utf8.t
@@ -0,0 +1,253 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    $ENV{PERL5LIB} = '../lib';
+    if ( ord("\t") != 9 ) { # skip on ebcdic platforms
+        print "1..0 # Skip utf8 tests on ebcdic platform.\n";
+        exit;
+    }
+}
+
+print "1..60\n";
+
+my $test = 1;
+
+sub ok {
+    my ($got,$expect) = @_;
+    print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
+    print "ok $test\n";
+}
+
+{
+    use utf8;
+    $_ = ">\x{263A}<"; 
+    s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg; 
+    ok $_, '>&#9786;<';
+    $test++;
+
+    $_ = ">\x{263A}<"; 
+    my $rx = "\x{80}-\x{10ffff}";
+    s/([$rx])/"&#".ord($1).";"/eg; 
+    ok $_, '>&#9786;<';
+    $test++;
+
+    $_ = ">\x{263A}<"; 
+    my $rx = "\\x{80}-\\x{10ffff}";
+    s/([$rx])/"&#".ord($1).";"/eg; 
+    ok $_, '>&#9786;<';
+    $test++;
+
+    $_ = "alpha,numeric"; 
+    m/([[:alpha:]]+)/; 
+    ok $1, 'alpha';
+    $test++;
+
+    $_ = "alphaNUMERICstring";
+    m/([[:^lower:]]+)/; 
+    ok $1, 'NUMERIC';
+    $test++;
+
+    $_ = "alphaNUMERICstring";
+    m/(\p{Ll}+)/; 
+    ok $1, 'alpha';
+    $test++;
+
+    $_ = "alphaNUMERICstring"; 
+    m/(\p{Lu}+)/; 
+    ok $1, 'NUMERIC';
+    $test++;
+
+    $_ = "alpha,numeric"; 
+    m/([\p{IsAlpha}]+)/; 
+    ok $1, 'alpha';
+    $test++;
+
+    $_ = "alphaNUMERICstring";
+    m/([^\p{IsLower}]+)/; 
+    ok $1, 'NUMERIC';
+    $test++;
+
+    $_ = "alpha123numeric456"; 
+    m/([\p{IsDigit}]+)/; 
+    ok $1, '123';
+    $test++;
+
+    $_ = "alpha123numeric456"; 
+    m/([^\p{IsDigit}]+)/; 
+    ok $1, 'alpha';
+    $test++;
+
+    $_ = ",123alpha,456numeric"; 
+    m/([\p{IsAlnum}]+)/; 
+    ok $1, '123alpha';
+    $test++;
+}
+{
+    use utf8;
+
+    $_ = "\x{263A}>\x{263A}\x{263A}"; 
+
+    ok length, 4;
+    $test++;
+
+    ok length((m/>(.)/)[0]), 1;
+    $test++;
+
+    ok length($&), 2;
+    $test++;
+
+    ok length($'), 1;
+    $test++;
+
+    ok length($`), 1;
+    $test++;
+
+    ok length($1), 1;
+    $test++;
+
+    ok length($tmp=$&), 2;
+    $test++;
+
+    ok length($tmp=$'), 1;
+    $test++;
+
+    ok length($tmp=$`), 1;
+    $test++;
+
+    ok length($tmp=$1), 1;
+    $test++;
+
+    ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
+    $test++;
+
+    ok $', pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    ok $`, pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    ok $1, pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    {
+	use bytes;
+	no utf8;
+
+	ok length, 10;
+	$test++;
+
+    	ok length((m/>(.)/)[0]), 1;
+    	$test++;
+
+    	ok length($&), 2;
+    	$test++;
+
+    	ok length($'), 5;
+    	$test++;
+
+    	ok length($`), 3;
+    	$test++;
+
+    	ok length($1), 1;
+    	$test++;
+
+	ok $&, pack("C*", ord(">"), 0342);
+	$test++;
+
+	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
+	$test++;
+
+	ok $`, pack("C*", 0342, 0230, 0272);
+	$test++;
+
+	ok $1, pack("C*", 0342);
+	$test++;
+
+    }
+
+
+    {
+	no utf8;
+	$_="\342\230\272>\342\230\272\342\230\272";
+    }
+
+    ok length, 10;
+    $test++;
+
+    ok length((m/>(.)/)[0]), 1;
+    $test++;
+
+    ok length($&), 2;
+    $test++;
+
+    ok length($'), 1;
+    $test++;
+
+    ok length($`), 1;
+    $test++;
+
+    ok length($1), 1;
+    $test++;
+
+    ok length($tmp=$&), 2;
+    $test++;
+
+    ok length($tmp=$'), 1;
+    $test++;
+
+    ok length($tmp=$`), 1;
+    $test++;
+
+    ok length($tmp=$1), 1;
+    $test++;
+
+    ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
+    $test++;
+
+    ok $', pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    ok $`, pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    ok $1, pack("C*", 0342, 0230, 0272);
+    $test++;
+
+    {
+	use bytes;
+	no utf8;
+
+	ok length, 10;
+	$test++;
+
+    	ok length((m/>(.)/)[0]), 1;
+    	$test++;
+
+    	ok length($&), 2;
+    	$test++;
+
+    	ok length($'), 5;
+    	$test++;
+
+    	ok length($`), 3;
+    	$test++;
+
+    	ok length($1), 1;
+    	$test++;
+
+	ok $&, pack("C*", ord(">"), 0342);
+	$test++;
+
+	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
+	$test++;
+
+	ok $`, pack("C*", 0342, 0230, 0272);
+	$test++;
+
+	ok $1, pack("C*", 0342);
+	$test++;
+
+    }
+}
diff --git a/gnu/usr.bin/perl/t/pragma/warn/1global b/gnu/usr.bin/perl/t/pragma/warn/1global
new file mode 100644
index 00000000000..0af80221b25
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/1global
@@ -0,0 +1,189 @@
+Check existing $^W functionality
+
+
+__END__
+
+# warnable code, warnings disabled
+$a =+ 3 ;
+EXPECT
+
+########
+-w
+# warnable code, warnings enabled via command line switch
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+#! perl -w
+# warnable code, warnings enabled via #! line
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 3.
+Name "main::a" used only once: possible typo at - line 3.
+########
+
+# warnable code, warnings enabled via compile time $^W
+BEGIN { $^W = 1 }
+$a =+ 3 ;
+EXPECT
+Reversed += operator at - line 4.
+Name "main::a" used only once: possible typo at - line 4.
+########
+
+# compile-time warnable code, warnings enabled via runtime $^W
+# so no warning printed.
+$^W = 1 ;
+$a =+ 3 ;
+EXPECT
+
+########
+
+# warnable code, warnings enabled via runtime $^W
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+# warnings enabled at compile time, disabled at run time
+BEGIN { $^W = 1 }
+$^W = 0 ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# warnings disabled at compile time, enabled at run time
+BEGIN { $^W = 0 }
+$^W = 1 ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+#! perl -w
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+Use of uninitialized value in scalar chop at ./abcd line 1.
+########
+
+--FILE-- abcd
+$^W = 0;
+my $b ; chop $b ;
+1 ;
+--FILE-- 
+$^W =1 ;
+require "./abcd";
+EXPECT
+
+########
+
+--FILE-- abcd
+$^W = 1;
+1 ;
+--FILE-- 
+$^W =0 ;
+require "./abcd";
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+$^W = 1;
+eval 'my $b ; chop $b ;' ;
+print $@ ;
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 1.
+########
+
+eval '$^W = 1;' ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+eval {$^W = 1;} ;
+print $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 4.
+########
+
+{
+    local ($^W) = 1;
+}
+my $b ; chop $b ;
+EXPECT
+
+########
+
+my $a ; chop $a ;
+{
+    local ($^W) = 1;
+    my $b ; chop $b ;
+}
+my $c ; chop $c ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+-w
+-e undef
+EXPECT
+Use of uninitialized value in -e at - line 2.
+########
+
+$^W = 1 + 2 ;
+EXPECT
+
+########
+
+$^W = $a ;
+EXPECT
+
+########
+
+sub fred {}
+$^W = fred() ;
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 0 ;
+  fred() ;
+}
+EXPECT
+
+########
+
+sub fred { my $b ; chop $b ;}
+{ local $^W = 1 ;
+  fred() ;
+}
+EXPECT
+Use of uninitialized value in scalar chop at - line 2.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/2use b/gnu/usr.bin/perl/t/pragma/warn/2use
new file mode 100644
index 00000000000..60a60c313cb
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/2use
@@ -0,0 +1,308 @@
+Check lexical warnings functionality
+
+TODO
+  check that the warning hierarchy works.
+
+__END__
+
+#  check illegal category is caught
+use warnings 'this-should-never-be-a-warning-category' ;
+EXPECT
+unknown warnings category 'this-should-never-be-a-warning-category' at - line 3
+BEGIN failed--compilation aborted at - line 3.
+########
+
+# Check compile time scope of pragma
+use warnings 'deprecated' ;
+{
+    no warnings ;
+    1 if $a EQ $b ;
+}
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check compile time scope of pragma
+no warnings;
+{
+    use warnings 'deprecated' ;
+    1 if $a EQ $b ;
+}
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+########
+
+# Check runtime scope of pragma
+use warnings 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 3.
+########
+
+--FILE-- abc
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings 'deprecated' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'deprecated' ;
+1;
+--FILE-- 
+require "./abc";
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings 'uninitialized' ;
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check scope of pragma with eval
+use warnings 'uninitialized' ;
+eval {
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings 'uninitialized' ;
+eval {
+    no warnings ;
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings 'deprecated' ;
+    1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+########
+
+# Check scope of pragma with eval
+use warnings 'deprecated' ;
+eval {
+    1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+Use of EQ is deprecated at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings 'deprecated' ;
+eval {
+    no warnings ;
+    1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval '
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings 'uninitialized' ;
+    my $b ; chop $b ;
+]; print STDERR $@;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use warnings 'uninitialized' ;
+eval '
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings 'uninitialized' ;
+eval '
+    no warnings ;
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval '
+    1 if $a EQ $b ;
+'; print STDERR $@ ;
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings 'deprecated' ;
+    1 if $a EQ $b ;
+]; print STDERR $@;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at (eval 1) line 3.
+########
+
+# Check scope of pragma with eval
+use warnings 'deprecated' ;
+eval '
+    1 if $a EQ $b ;
+'; print STDERR $@;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 7.
+Use of EQ is deprecated at (eval 1) line 2.
+########
+
+# Check scope of pragma with eval
+use warnings 'deprecated' ;
+eval '
+    no warnings ;
+    1 if $a EQ $b ;
+'; print STDERR $@;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check the additive nature of the pragma
+1 if $a EQ $b ;
+my $a ; chop $a ;
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+my $b ; chop $b ;
+use warnings 'uninitialized' ;
+my $c ; chop $c ;
+no warnings 'deprecated' ;
+1 if $a EQ $b ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+Use of uninitialized value in scalar chop at - line 9.
+Use of uninitialized value in string eq at - line 11.
+Use of uninitialized value in string eq at - line 11.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/3both b/gnu/usr.bin/perl/t/pragma/warn/3both
new file mode 100644
index 00000000000..132b99b80fb
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/3both
@@ -0,0 +1,197 @@
+Check interaction of $^W and lexical
+
+__END__
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 0 ;
+  fred() ;
+}
+
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ local $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+{ $^W = 1 ;
+  fred() ;
+}
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+$^W = 1 ;
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+$^W = 1 ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+-w
+# Check interaction of $^W and use warnings
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 5.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 0 }
+fred() ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+sub fred { 
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+BEGIN {  $^W = 1 }
+fred() ;
+
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+use warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+use warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+no warnings ;
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+no warnings ;
+BEGIN {  $^W = 1 }
+my $b ; 
+chop $b ;
+EXPECT
+
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 1 }
+{
+    no warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 10.
+########
+
+# Check interaction of $^W and use warnings
+BEGIN {  $^W = 0 }
+{
+    use warnings ;
+    my $b ; 
+    chop $b ;
+}
+my $b ;
+chop $b ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 7.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/4lint b/gnu/usr.bin/perl/t/pragma/warn/4lint
new file mode 100644
index 00000000000..db54f31c7b4
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/4lint
@@ -0,0 +1,112 @@
+Check lint
+
+__END__
+-W
+# lint: check compile time $^W is zapped
+BEGIN { $^W = 0 ;}
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+print() on closed filehandle main::STDIN at - line 6.
+########
+-W
+# lint: check runtime $^W is zapped
+$^W = 0 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+print() on closed filehandle main::STDIN at - line 4.
+########
+-W
+# lint: check runtime $^W is zapped
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle main::STDIN at - line 5.
+########
+-W
+# lint: check "no warnings" is zapped
+no warnings ;
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+print() on closed filehandle main::STDIN at - line 6.
+########
+-W
+# lint: check "no warnings" is zapped
+{
+  no warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle main::STDIN at - line 5.
+########
+-Ww
+# lint: check combination of -w and -W
+{
+  $^W = 0 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+print() on closed filehandle main::STDIN at - line 5.
+########
+-W
+--FILE-- abc.pm
+no warnings 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+no warnings 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+no warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc.pm
+BEGIN {$^W = 0}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+$^W = 0 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 3.
+Use of uninitialized value in scalar chop at - line 3.
+########
+-W
+--FILE-- abc
+BEGIN {$^W = 0}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+$^W = 0 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+Use of EQ is deprecated at ./abc line 3.
+Use of uninitialized value in scalar chop at - line 3.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/5nolint b/gnu/usr.bin/perl/t/pragma/warn/5nolint
new file mode 100644
index 00000000000..994190a8559
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/5nolint
@@ -0,0 +1,96 @@
+Check anti-lint
+
+__END__
+-X
+# nolint: check compile time $^W is zapped
+BEGIN { $^W = 1 ;}
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+$^W = 1 ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check runtime $^W is zapped
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+use warnings ;
+$a = $b = 1 ;
+$a = 1 if $a EQ $b ;
+close STDIN ; print STDIN "abc" ;
+EXPECT
+########
+-X
+# nolint: check "no warnings" is zapped
+{
+  use warnings ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-Xw
+# nolint: check combination of -w and -X
+{
+  $^W = 1 ;
+  close STDIN ; print STDIN "abc" ;
+}
+EXPECT
+########
+-X
+--FILE-- abc.pm
+use warnings 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+use warnings 'deprecated' ;
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc.pm
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+$^W = 1 ;
+use abc;
+my $a ; chop $a ;
+EXPECT
+########
+-X
+--FILE-- abc
+BEGIN {$^W = 1}
+my ($a, $b) = (0,0);
+1 if $a EQ $b ;
+1;
+--FILE-- 
+$^W = 1 ;
+require "./abc";
+my $a ; chop $a ;
+EXPECT
diff --git a/gnu/usr.bin/perl/t/pragma/warn/6default b/gnu/usr.bin/perl/t/pragma/warn/6default
new file mode 100644
index 00000000000..dd3d1825f44
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/6default
@@ -0,0 +1,53 @@
+Check default warnings
+
+__END__
+# default warnings should be displayed if you don't add anything
+# optional shouldn't
+my $a = oct "7777777777777777777777777777777777779" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# no warnings should be displayed 
+no warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+########
+# check scope
+use warnings ;
+my $a = oct "7777777777777777777777777777777777778" ;
+{
+    no warnings ;
+    my $a = oct "7777777777777777777777777777777777778" ;
+}    
+my $c = oct "7777777777777777777777777777777777778" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+Illegal octal digit '8' ignored at - line 3.
+Octal number > 037777777777 non-portable at - line 3.
+Integer overflow in octal number at - line 8.
+Illegal octal digit '8' ignored at - line 8.
+Octal number > 037777777777 non-portable at - line 8.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0xfffffffffffffffffg" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+Illegal hexadecimal digit 'g' ignored at - line 3.
+Hexadecimal number > 0xffffffff non-portable at - line 3.
+########
+# all warnings should be displayed 
+use warnings ;
+my $a = oct "0b111111111111111111111111111111111111111111111111111111111111111112";
+EXPECT
+Integer overflow in binary number at - line 3.
+Illegal binary digit '2' ignored at - line 3.
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 3.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/7fatal b/gnu/usr.bin/perl/t/pragma/warn/7fatal
new file mode 100644
index 00000000000..943bb06fb34
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/7fatal
@@ -0,0 +1,242 @@
+Check FATAL functionality
+
+__END__
+
+# Check compile time warning
+use warnings FATAL => 'deprecated' ;
+{
+    no warnings ;
+    1 if $a EQ $b ;
+}
+1 if $a EQ $b ; 
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check runtime scope of pragma
+use warnings FATAL => 'uninitialized' ;
+{
+    no warnings ;
+    my $b ; chop $b ;
+}
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check runtime scope of pragma
+no warnings ;
+{
+    use warnings FATAL => 'uninitialized' ;
+    $a = sub { my $b ; chop $b ; }
+}
+&$a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 6.
+########
+
+--FILE-- abc
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings FATAL => 'deprecated' ;
+require "./abc";
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings FATAL => 'deprecated' ;
+1;
+--FILE-- 
+require "./abc";
+1 if $a EQ $b ;
+EXPECT
+
+########
+
+--FILE-- abc
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+require "./abc";
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at ./abc line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+--FILE-- abc.pm
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+1;
+--FILE-- 
+use warnings FATAL => 'uninitialized' ;
+use abc;
+my $a ; chop $a ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at abc.pm line 2.
+Use of uninitialized value in scalar chop at - line 3.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 6.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    my $b ; chop $b ;
+}; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at - line 5.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval {
+    no warnings ;
+    my $b ; chop $b ;
+}; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'deprecated' ;
+    1 if $a EQ $b ;
+}; print STDERR "-- $@" ;
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at - line 6.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'deprecated' ;
+eval {
+    1 if $a EQ $b ;
+}; print STDERR "-- $@" ;
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at - line 5.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'deprecated' ;
+eval {
+    no warnings ;
+    1 if $a EQ $b ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval {
+    use warnings FATAL => 'deprecated' ;
+}; print STDERR $@ ;
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+The End.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'uninitialized' ;
+    my $b ; chop $b ;
+]; print STDERR "-- $@";
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    my $b ; chop $b ;
+'; print STDERR "-- $@" ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of uninitialized value in scalar chop at (eval 1) line 2.
+Use of uninitialized value in scalar chop at - line 7.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'uninitialized' ;
+eval '
+    no warnings ;
+    my $b ; chop $b ;
+'; print STDERR $@ ;
+my $b ; chop $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of uninitialized value in scalar chop at - line 8.
+########
+
+# Check scope of pragma with eval
+no warnings ;
+eval q[ 
+    use warnings FATAL => 'deprecated' ;
+    1 if $a EQ $b ;
+]; print STDERR "-- $@";
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of EQ is deprecated at (eval 1) line 3.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'deprecated' ;
+eval '
+    1 if $a EQ $b ;
+'; print STDERR "-- $@";
+print STDERR "The End.\n" ;
+EXPECT
+-- Use of EQ is deprecated at (eval 1) line 2.
+The End.
+########
+
+# Check scope of pragma with eval
+use warnings FATAL => 'deprecated' ;
+eval '
+    no warnings ;
+    1 if $a EQ $b ;
+'; print STDERR "-- $@";
+1 if $a EQ $b ;
+print STDERR "The End.\n" ;
+EXPECT
+Use of EQ is deprecated at - line 8.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/8signal b/gnu/usr.bin/perl/t/pragma/warn/8signal
new file mode 100644
index 00000000000..d480f1902a9
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/8signal
@@ -0,0 +1,18 @@
+Check interaction of __WARN__, __DIE__ & lexical Warnings
+
+TODO
+
+__END__
+# 8signal
+BEGIN { $| = 1; $SIG{__WARN__} = sub { print "WARN -- @_" } }
+BEGIN { $SIG{__DIE__}  = sub { print "DIE -- @_" } }
+1 if 1 EQ 2 ;
+use warnings qw(deprecated) ;
+1 if 1 EQ 2 ;
+use warnings FATAL => qw(deprecated) ;
+1 if 1 EQ 2 ;
+print "The End.\n" ;
+EXPECT
+WARN -- Use of EQ is deprecated at - line 6.
+DIE -- Use of EQ is deprecated at - line 8.
+Use of EQ is deprecated at - line 8.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/9enabled b/gnu/usr.bin/perl/t/pragma/warn/9enabled
new file mode 100644
index 00000000000..7facf996f5f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/9enabled
@@ -0,0 +1,819 @@
+Check warnings::enabled & warnings::warn
+
+__END__
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'syntax' ;
+print "ok1\n" if   warnings::enabled('io') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+no warnings ;
+print "ok1\n" if !warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+use warnings 'syntax' ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("syntax") ;
+print "ok3\n" if   warnings::enabled("io") ;
+1;
+--FILE-- 
+use warnings 'io' ;
+require "abc" ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if ! warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+no warnings;
+use abc ;
+1;
+--FILE-- 
+use warnings;
+use def ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+print "ok1\n" if ! warnings::enabled('all') ;
+print "ok2\n" if warnings::enabled("syntax") ;
+print "ok3\n" if !warnings::enabled("io") ;
+1;
+--FILE-- def.pm
+use warnings 'syntax' ;
+print "ok4\n" if !warnings::enabled('all') ;
+print "ok5\n" if warnings::enabled("io") ;
+use abc ;
+1;
+--FILE--
+use warnings 'io' ;
+use def ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+ok5
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if   warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc
+package abc ;
+no warnings ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if !warnings::enabled('all') ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+  print "ok3\n" if warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+require "abc" ;
+eval { use warnings 'io' ; abc::check() ; };
+abc::check() ; 
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if ! warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled('all') ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+# check warnings::warn
+use warnings ;
+eval { warnings::warn() } ;
+print $@ ;
+eval { warnings::warn("fred", "joe") } ;
+print $@ ;
+EXPECT
+Usage: warnings::warn([category,] 'message') at - line 4
+unknown warnings category 'fred' at - line 6
+	require 0 called at - line 6
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("misc", "hello") }
+1;
+--FILE--
+use warnings "io" ;
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL deprecated ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+sub check { warnings::warn("io", "hello") }
+1;
+--FILE--
+use warnings qw( FATAL io ) ;
+use abc;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if warnings::enabled("io") ;
+print "ok2\n" if warnings::enabled("all") ;
+1;
+--FILE-- 
+no warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+print "ok1\n" if !warnings::enabled("io") ;
+print "ok2\n" if !warnings::enabled("all") ;
+1;
+--FILE-- 
+use warnings;
+use abc ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+sub check {
+  print "ok\n" if ! warnings::enabled() ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+package 'abc' not registered for warnings at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+no warnings ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if warnings::enabled ;
+  print "ok2\n" if warnings::enabled("syntax") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+eval { abc::check() ; };
+print $@ ;
+EXPECT
+ok1
+ok2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if !warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+eval { abc::check() ; } ;
+print $@ ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if !warnings::enabled("io") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'io' ;
+use warnings::register ;
+sub check {
+  print "ok1\n" if  ! warnings::enabled ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+sub fred { no warnings ; abc::check() }
+fred() ;
+EXPECT
+ok1
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check {
+  print "ok1\n" if  warnings::enabled ;
+  print "ok2\n" if  warnings::enabled("syntax") ;
+  print "ok3\n" if  warnings::enabled("io") ;
+  print "ok4\n" if  ! warnings::enabled("misc") ;
+}
+1;
+--FILE-- 
+use warnings 'syntax' ;
+use abc ;
+use warnings 'abc' ;
+sub fred { use warnings 'io'  ; abc::check() }
+fred() ;
+EXPECT
+ok1
+ok2
+ok3
+ok4
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings 'misc' ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings "abc" ;
+abc::check() ;
+EXPECT
+hello at - line 3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+abc::check() ;
+EXPECT
+hello at - line 2
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL deprecated ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+hello at - line 3
+[[]]
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings::register ;
+sub check { warnings::warn("hello") }
+1;
+--FILE--
+use abc;
+use warnings qw( FATAL abc ) ;
+eval { abc::check() ; } ;
+print "[[$@]]\n";
+EXPECT
+[[hello at - line 3
+]]
+########
+-W
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+-X
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+no warnings;
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if warnings::enabled() ;
+  print "ok2\n" if warnings::enabled("io") ;
+  print "ok3\n" if warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use warnings 'all';
+use abc ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "ok1\n" if !warnings::enabled() ;
+  print "ok2\n" if !warnings::enabled("io") ;
+  print "ok3\n" if !warnings::enabled("all") ;
+}
+1;
+--FILE-- 
+use abc ;
+use warnings 'abc';
+no warnings ;
+abc::check() ;
+EXPECT
+ok1
+ok2
+ok3
+########
+
+--FILE-- abc.pm
+package abc ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "abc self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "abc def"  . (warnings::enabled('def') ? "" : " not") . " enabled\n" ;
+  print "abc all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- def.pm
+package def ;
+use warnings "io" ;
+use warnings::register ;
+sub check { 
+  print "def self" . (warnings::enabled() ? "" : " not") . " enabled\n" ;
+  print "def abc"  . (warnings::enabled('abc') ? "" : " not") . " enabled\n" ;
+  print "def all"  . (warnings::enabled('all') ? "" : " not") . " enabled\n" ;
+}
+1;
+--FILE-- 
+use abc ;
+use def ;
+use warnings 'abc';
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings 'abc'  ;
+use warnings 'def'  ;
+abc::check() ;
+def::check() ;
+no warnings 'abc'  ;
+no warnings 'def'  ;
+abc::check() ;
+def::check() ;
+use warnings;
+abc::check() ;
+def::check() ;
+no warnings 'abc' ;
+abc::check() ;
+def::check() ;
+EXPECT
+abc self enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc enabled
+def all not enabled
+abc self not enabled
+abc def not enabled
+abc all not enabled
+def self not enabled
+def abc not enabled
+def all not enabled
+abc self enabled
+abc def enabled
+abc all enabled
+def self enabled
+def abc enabled
+def all enabled
+abc self not enabled
+abc def enabled
+abc all not enabled
+def self enabled
+def abc not enabled
+def all not enabled
diff --git a/gnu/usr.bin/perl/t/pragma/warn/av b/gnu/usr.bin/perl/t/pragma/warn/av
new file mode 100644
index 00000000000..79bd3b7600f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/av
@@ -0,0 +1,9 @@
+  av.c	
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  av_reify called on tied array		[av_reify]
+
+  Attempt to clear deleted array	[av_clear]
+  
+__END__
diff --git a/gnu/usr.bin/perl/t/pragma/warn/doio b/gnu/usr.bin/perl/t/pragma/warn/doio
new file mode 100644
index 00000000000..bd409721d26
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/doio
@@ -0,0 +1,191 @@
+  doio.c	
+
+  Can't open bidirectional pipe		[Perl_do_open9]
+    open(F, "| true |");
+
+  Missing command in piped open		[Perl_do_open9]
+    open(F, "| ");
+
+  Missing command in piped open		[Perl_do_open9]
+    open(F, " |");
+
+  warn(warn_nl, "open");		[Perl_do_open9]
+    open(F, "true\ncd")
+
+  Close on unopened file <%s>		[Perl_do_close] <<TODO
+    $a = "fred";close("$a")
+
+  tell() on unopened file		[Perl_do_tell]
+    $a = "fred";$a = tell($a)
+
+  seek() on unopened file		[Perl_do_seek]
+    $a = "fred";$a = seek($a,1,1)
+
+  sysseek() on unopened file		[Perl_do_sysseek]
+    $a = "fred";$a = seek($a,1,1)
+
+  warn(warn_uninit);			[Perl_do_print]
+    print $a ;
+
+  Stat on unopened file <%s> 		[Perl_my_stat]
+    close STDIN ; -x STDIN ;
+
+  warn(warn_nl, "stat");		[Perl_my_stat]
+    stat "ab\ncd"
+
+  warn(warn_nl, "lstat");		[Perl_my_lstat]
+    lstat "ab\ncd"
+
+  Can't exec \"%s\": %s 		[Perl_do_aexec5]
+
+  Can't exec \"%s\": %s 		[Perl_do_exec3]
+
+  Filehandle %s opened only for output	[Perl_do_eof]
+	my $a = eof STDOUT
+
+  Mandatory Warnings ALL TODO
+  ------------------
+  Can't do inplace edit: %s is not a regular file	[Perl_nextargv]
+     edit a directory
+
+  Can't do inplace edit: %s would not be unique		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't remove %s: %s, skipping file			[Perl_nextargv]
+  Can't do inplace edit on %s: %s			[Perl_nextargv]
+  
+
+__END__
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(F);
+no warnings 'io' ;
+open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
+close(G);
+EXPECT
+Can't open bidirectional pipe at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "|      ");
+no warnings 'io' ;
+open(G, "|      ");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "      |");
+no warnings 'io' ;
+open(G, "      |");
+EXPECT
+Missing command in piped open at - line 3.
+########
+# doio.c [Perl_do_open9]
+use warnings 'io' ;
+open(F, "<true\ncd");
+no warnings 'io' ;
+open(G, "<true\ncd");
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+Close on unopened file <fred> at - line 3.
+########
+# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
+use warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+no warnings 'io' ;
+close STDIN ;
+tell(STDIN);
+$a = seek(STDIN,1,1);
+$a = sysseek(STDIN,1,1);
+-x STDIN ;
+EXPECT
+tell() on unopened file at - line 4.
+seek() on unopened file at - line 5.
+sysseek() on unopened file at - line 6.
+Stat on unopened file <STDIN> at - line 7.
+########
+# doio.c [Perl_do_print]
+use warnings 'uninitialized' ;
+print $a ;
+no warnings 'uninitialized' ;
+print $b ;
+EXPECT
+Use of uninitialized value in print at - line 3.
+########
+# doio.c [Perl_my_stat Perl_my_lstat]
+use warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+no warnings 'io' ;
+stat "ab\ncd";
+lstat "ab\ncd";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+Unsuccessful stat on filename containing newline at - line 4.
+########
+# doio.c [Perl_do_aexec5]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls","" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls": .+
+########
+# doio.c [Perl_do_exec3]
+use warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+no warnings 'io' ;
+exec "lskdjfalksdjfdjfkls", "abc" ;
+EXPECT
+OPTION regex
+Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
+########
+# doio.c [Perl_nextargv]
+$^W = 0 ;
+my $filename = "./temp.dir" ;
+mkdir $filename, 0777 
+  or die "Cannot create directory $filename: $!\n" ;
+{
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    no warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+{
+    use warnings 'inplace' ;
+    local (@ARGV) = ($filename) ;
+    local ($^I) = "" ;
+    my $x = <> ;
+}
+rmdir $filename ;
+EXPECT
+Can't do inplace edit: ./temp.dir is not a regular file at - line 9.
+Can't do inplace edit: ./temp.dir is not a regular file at - line 21.
+
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle main::STDOUT opened only for output at - line 3.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/doop b/gnu/usr.bin/perl/t/pragma/warn/doop
new file mode 100644
index 00000000000..5803b445812
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/doop
@@ -0,0 +1,6 @@
+# doop.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+chop ;
+EXPECT
+########
diff --git a/gnu/usr.bin/perl/t/pragma/warn/gv b/gnu/usr.bin/perl/t/pragma/warn/gv
new file mode 100644
index 00000000000..5ed4eca0180
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/gv
@@ -0,0 +1,54 @@
+  gv.c AOK
+
+     Can't locate package %s for @%s::ISA
+	@ISA = qw(Fred); joe()
+
+     Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated
+	sub Other::AUTOLOAD { 1 } sub Other::fred {}
+	@ISA = qw(Other) ;
+	fred() ;
+
+     Use of $# is deprecated
+     Use of $* is deprecated
+
+	$a = ${"#"} ;
+ 	$a = ${"*"} ;
+
+  Mandatory Warnings ALL TODO
+  ------------------
+
+    Had to create %s unexpectedly		[gv_fetchpv]
+    Attempt to free unreferenced glob pointers	[gp_free]
+    
+__END__
+# gv.c
+use warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Can't locate package Fred for @main::ISA at - line 3.
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+no warnings 'misc' ;
+@ISA = qw(Fred); joe()
+EXPECT
+Undefined subroutine &main::joe called at - line 3.
+########
+# gv.c
+sub Other::AUTOLOAD { 1 } sub Other::fred {}
+@ISA = qw(Other) ;
+use warnings 'deprecated' ;
+fred() ;
+EXPECT
+Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5.
+########
+# gv.c
+use warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+no warnings 'deprecated' ;
+$a = ${"#"};
+$a = ${"*"};
+EXPECT
+Use of $# is deprecated at - line 3.
+Use of $* is deprecated at - line 4.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/hv b/gnu/usr.bin/perl/t/pragma/warn/hv
new file mode 100644
index 00000000000..c9eec028f14
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/hv
@@ -0,0 +1,8 @@
+  hv.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Attempt to free non-existent shared string	[unsharepvn]
+
+__END__
diff --git a/gnu/usr.bin/perl/t/pragma/warn/malloc b/gnu/usr.bin/perl/t/pragma/warn/malloc
new file mode 100644
index 00000000000..2f8b096a518
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/malloc
@@ -0,0 +1,9 @@
+  malloc.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    %s free() ignored		[Perl_mfree]
+    %s", "Bad free() ignored	[Perl_mfree]
+
+__END__
diff --git a/gnu/usr.bin/perl/t/pragma/warn/mg b/gnu/usr.bin/perl/t/pragma/warn/mg
new file mode 100644
index 00000000000..a8f9dbc3380
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/mg
@@ -0,0 +1,44 @@
+  mg.c	AOK
+
+  No such signal: SIG%s
+    $SIG{FRED} = sub {}
+
+  SIG%s handler \"%s\" not defined.
+    $SIG{"INT"} = "ok3"; kill "INT",$$;
+
+  Mandatory Warnings TODO
+  ------------------
+  Can't break at that line	[magic_setdbline]
+
+__END__
+# mg.c
+use warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+No such signal: SIGFRED at - line 3.
+########
+# mg.c
+no warnings 'signal' ;
+$SIG{FRED} = sub {};
+EXPECT
+
+########
+# mg.c
+use warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+    print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+SIGINT handler "fred" not defined.
+########
+# mg.c
+no warnings 'signal' ;
+if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+    print "SKIPPED\n# win32, can't kill() to raise()\n"; exit;
+}
+$|=1;
+$SIG{"INT"} = "fred"; kill "INT",$$;
+EXPECT
+
diff --git a/gnu/usr.bin/perl/t/pragma/warn/op b/gnu/usr.bin/perl/t/pragma/warn/op
new file mode 100644
index 00000000000..1a79b4ad23c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/op
@@ -0,0 +1,861 @@
+  op.c		AOK
+
+     "my" variable %s masks earlier declaration in same scope
+	my $x;
+	my $x ;
+
+     Variable "%s" may be unavailable 
+	sub x {
+      	    my $x;
+      	    sub y {
+         	$x
+      	    }
+   	}
+
+     Variable "%s" will not stay shared 
+	sub x {
+      	    my $x;
+      	    sub y {
+         	sub { $x }
+      	    }
+   	}
+
+     Found = in conditional, should be ==
+	1 if $a = 1 ;
+
+     Use of implicit split to @_ is deprecated
+	split ;
+
+     Use of implicit split to @_ is deprecated
+	$a = split ;
+
+     Useless use of time in void context
+     Useless use of a variable in void context
+     Useless use of a constant in void context
+	time ;
+	$a ;
+	"abc"
+
+     Applying %s to %s will act on scalar(%s)
+	my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+	@a =~ /abc/ ;
+	@a =~ s/a/b/ ;
+	@a =~ tr/a/b/ ;
+	@$b =~ /abc/ ;
+	@$b =~ s/a/b/ ;
+	@$b =~ tr/a/b/ ;
+	%a =~ /abc/ ;
+	%a =~ s/a/b/ ;
+	%a =~ tr/a/b/ ;
+	%$c =~ /abc/ ;
+	%$c =~ s/a/b/ ;
+	%$c =~ tr/a/b/ ;
+
+
+     Parentheses missing around "my" list at -e line 1.
+       my $a, $b = (1,2);
+ 
+     Parentheses missing around "local" list at -e line 1.
+       local $a, $b = (1,2);
+ 
+     Bareword found in conditional at -e line 1.
+       use warnings 'bareword'; my $x = print(ABC || 1);
+ 
+     Value of %s may be \"0\"; use \"defined\" 
+	$x = 1 if $x = <FH> ;
+	$x = 1 while $x = <FH> ;
+
+     Subroutine fred redefined at -e line 1.
+       sub fred{1;} sub fred{1;}
+ 
+     Constant subroutine %s redefined 
+        sub fred() {1;} sub fred() {1;}
+ 
+     Format FRED redefined at /tmp/x line 5.
+       format FRED =
+       .
+       format FRED =
+       .
+ 
+     Array @%s missing the @ in argument %d of %s() 
+	push fred ;
+ 
+     Hash %%%s missing the %% in argument %d of %s() 
+	keys joe ;
+ 
+     Statement unlikely to be reached
+     	(Maybe you meant system() when you said exec()?
+ 	exec "true" ; my $a
+
+     defined(@array) is deprecated
+     	(Maybe you should just omit the defined()?)
+	my @a ; defined @a ;
+	defined (@a = (1,2,3)) ;
+
+     defined(%hash) is deprecated
+     	(Maybe you should just omit the defined()?)
+	my %h ; defined %h ;
+    
+     /---/ should probably be written as "---"
+        join(/---/, @foo);
+
+    %s() called too early to check prototype		[Perl_peep]
+        fred() ; sub fred ($$) {}
+
+
+    Mandatory Warnings 
+    ------------------
+    Prototype mismatch:		[cv_ckproto]
+        sub fred() ;
+        sub fred($) {}
+
+    %s never introduced		[pad_leavemy]	TODO
+    Runaway prototype		[newSUB]	TODO
+    oops: oopsAV		[oopsAV]	TODO
+    oops: oopsHV		[oopsHV]	TODO
+    
+
+__END__
+# op.c
+use warnings 'misc' ;
+my $x ;
+my $x ;
+no warnings 'misc' ;
+my $x ;
+EXPECT
+"my" variable $x masks earlier declaration in same scope at - line 4.
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+Variable "$x" will not stay shared at - line 7.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+Variable "$x" may be unavailable at - line 6.
+########
+# op.c
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
+EXPECT
+
+########
+# op.c
+use warnings 'syntax' ;
+1 if $a = 1 ;
+no warnings 'syntax' ;
+1 if $a = 1 ;
+EXPECT
+Found = in conditional, should be == at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+split ;
+no warnings 'deprecated' ;
+split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+$a = split ;
+no warnings 'deprecated' ;
+$a = split ;
+EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
+########
+# op.c
+use warnings 'void' ; close STDIN ;
+1 x 3 ;			# OP_REPEAT
+			# OP_GVSV
+wantarray ; 		# OP_WANTARRAY
+			# OP_GV
+			# OP_PADSV
+			# OP_PADAV
+			# OP_PADHV
+			# OP_PADANY
+			# OP_AV2ARYLEN
+ref ;			# OP_REF
+\@a ;			# OP_REFGEN
+\$a ;			# OP_SREFGEN
+defined $a ;		# OP_DEFINED
+hex $a ;		# OP_HEX
+oct $a ;		# OP_OCT
+length $a ;		# OP_LENGTH
+substr $a,1 ;		# OP_SUBSTR
+vec $a,1,2 ;		# OP_VEC
+index $a,1,2 ;		# OP_INDEX
+rindex $a,1,2 ;		# OP_RINDEX
+sprintf $a ;		# OP_SPRINTF
+$a[0] ;			# OP_AELEM
+			# OP_AELEMFAST
+@a[0] ;			# OP_ASLICE
+#values %a ;		# OP_VALUES
+#keys %a ;		# OP_KEYS
+$a{0} ;			# OP_HELEM
+@a{0} ;			# OP_HSLICE
+unpack "a", "a" ;	# OP_UNPACK
+pack $a,"" ;		# OP_PACK
+join "" ;		# OP_JOIN
+(@a)[0,1] ;		# OP_LSLICE
+			# OP_ANONLIST
+			# OP_ANONHASH
+sort(1,2) ;		# OP_SORT
+reverse(1,2) ;		# OP_REVERSE
+			# OP_RANGE
+			# OP_FLIP
+(1 ..2) ;		# OP_FLOP
+caller ;		# OP_CALLER
+fileno STDIN ;		# OP_FILENO
+eof STDIN ;		# OP_EOF
+tell STDIN ;		# OP_TELL
+readlink 1;		# OP_READLINK
+time ;			# OP_TIME
+localtime ;		# OP_LOCALTIME
+gmtime ;		# OP_GMTIME
+eval { getgrnam 1 };	# OP_GGRNAM
+eval { getgrgid 1 };	# OP_GGRGID
+eval { getpwnam 1 };	# OP_GPWNAM
+eval { getpwuid 1 };	# OP_GPWUID
+EXPECT
+Useless use of repeat (x) in void context at - line 3.
+Useless use of wantarray in void context at - line 5.
+Useless use of reference-type operator in void context at - line 12.
+Useless use of reference constructor in void context at - line 13.
+Useless use of single ref constructor in void context at - line 14.
+Useless use of defined operator in void context at - line 15.
+Useless use of hex in void context at - line 16.
+Useless use of oct in void context at - line 17.
+Useless use of length in void context at - line 18.
+Useless use of substr in void context at - line 19.
+Useless use of vec in void context at - line 20.
+Useless use of index in void context at - line 21.
+Useless use of rindex in void context at - line 22.
+Useless use of sprintf in void context at - line 23.
+Useless use of array element in void context at - line 24.
+Useless use of array slice in void context at - line 26.
+Useless use of hash element in void context at - line 29.
+Useless use of hash slice in void context at - line 30.
+Useless use of unpack in void context at - line 31.
+Useless use of pack in void context at - line 32.
+Useless use of join in void context at - line 33.
+Useless use of list slice in void context at - line 34.
+Useless use of sort in void context at - line 37.
+Useless use of reverse in void context at - line 38.
+Useless use of range (or flop) in void context at - line 41.
+Useless use of caller in void context at - line 42.
+Useless use of fileno in void context at - line 43.
+Useless use of eof in void context at - line 44.
+Useless use of tell in void context at - line 45.
+Useless use of readlink in void context at - line 46.
+Useless use of time in void context at - line 47.
+Useless use of localtime in void context at - line 48.
+Useless use of gmtime in void context at - line 49.
+Useless use of getgrnam in void context at - line 50.
+Useless use of getgrgid in void context at - line 51.
+Useless use of getpwnam in void context at - line 52.
+Useless use of getpwuid in void context at - line 53.
+########
+# op.c
+no warnings 'void' ; close STDIN ;
+1 x 3 ;			# OP_REPEAT
+			# OP_GVSV
+wantarray ; 		# OP_WANTARRAY
+			# OP_GV
+			# OP_PADSV
+			# OP_PADAV
+			# OP_PADHV
+			# OP_PADANY
+			# OP_AV2ARYLEN
+ref ;			# OP_REF
+\@a ;			# OP_REFGEN
+\$a ;			# OP_SREFGEN
+defined $a ;		# OP_DEFINED
+hex $a ;		# OP_HEX
+oct $a ;		# OP_OCT
+length $a ;		# OP_LENGTH
+substr $a,1 ;		# OP_SUBSTR
+vec $a,1,2 ;		# OP_VEC
+index $a,1,2 ;		# OP_INDEX
+rindex $a,1,2 ;		# OP_RINDEX
+sprintf $a ;		# OP_SPRINTF
+$a[0] ;			# OP_AELEM
+			# OP_AELEMFAST
+@a[0] ;			# OP_ASLICE
+#values %a ;		# OP_VALUES
+#keys %a ;		# OP_KEYS
+$a{0} ;			# OP_HELEM
+@a{0} ;			# OP_HSLICE
+unpack "a", "a" ;	# OP_UNPACK
+pack $a,"" ;		# OP_PACK
+join "" ;		# OP_JOIN
+(@a)[0,1] ;		# OP_LSLICE
+			# OP_ANONLIST
+			# OP_ANONHASH
+sort(1,2) ;		# OP_SORT
+reverse(1,2) ;		# OP_REVERSE
+			# OP_RANGE
+			# OP_FLIP
+(1 ..2) ;		# OP_FLOP
+caller ;		# OP_CALLER
+fileno STDIN ;		# OP_FILENO
+eof STDIN ;		# OP_EOF
+tell STDIN ;		# OP_TELL
+readlink 1;		# OP_READLINK
+time ;			# OP_TIME
+localtime ;		# OP_LOCALTIME
+gmtime ;		# OP_GMTIME
+eval { getgrnam 1 };	# OP_GGRNAM
+eval { getgrgid 1 };	# OP_GGRGID
+eval { getpwnam 1 };	# OP_GPWNAM
+eval { getpwuid 1 };	# OP_GPWUID
+EXPECT
+########
+# op.c
+use warnings 'void' ;
+for (@{[0]}) { "$_" }		# check warning isn't duplicated
+no warnings 'void' ;
+for (@{[0]}) { "$_" }		# check warning isn't duplicated
+EXPECT
+Useless use of string in void context at - line 3.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_telldir}) {
+        print <<EOM ;
+SKIPPED
+# telldir not present
+EOM
+        exit 
+    }
+}
+telldir 1 ;		# OP_TELLDIR
+no warnings 'void' ;
+telldir 1 ;		# OP_TELLDIR
+EXPECT
+Useless use of telldir in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getppid}) {
+        print <<EOM ;
+SKIPPED
+# getppid not present
+EOM
+        exit 
+    }
+}
+getppid ;		# OP_GETPPID
+no warnings 'void' ;
+getppid ;		# OP_GETPPID
+EXPECT
+Useless use of getppid in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getpgrp}) {
+        print <<EOM ;
+SKIPPED
+# getpgrp not present
+EOM
+        exit 
+    }
+}
+getpgrp ;		# OP_GETPGRP
+no warnings 'void' ;
+getpgrp ;		# OP_GETPGRP
+EXPECT
+Useless use of getpgrp in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_times}) {
+        print <<EOM ;
+SKIPPED
+# times not present
+EOM
+        exit 
+    }
+}
+times ;			# OP_TMS
+no warnings 'void' ;
+times ;			# OP_TMS
+EXPECT
+Useless use of times in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getprior} or $^O eq 'os2') { # Locks before fixpak22
+        print <<EOM ;
+SKIPPED
+# getpriority not present
+EOM
+        exit 
+    }
+}
+getpriority 1,2;	# OP_GETPRIORITY
+no warnings 'void' ;
+getpriority 1,2;	# OP_GETPRIORITY
+EXPECT
+Useless use of getpriority in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ;
+BEGIN {
+    if ( ! $Config{d_getlogin}) {
+        print <<EOM ;
+SKIPPED
+# getlogin not present
+EOM
+        exit 
+    }
+}
+getlogin ;			# OP_GETLOGIN
+no warnings 'void' ;
+getlogin ;			# OP_GETLOGIN
+EXPECT
+Useless use of getlogin in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
+use Config ; BEGIN {
+if ( ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# getsockname not present
+# getpeername not present
+# gethostbyname not present
+# gethostbyaddr not present
+# gethostent not present
+# getnetbyname not present
+# getnetbyaddr not present
+# getnetent not present
+# getprotobyname not present
+# getprotobynumber not present
+# getprotoent not present
+# getservbyname not present
+# getservbyport not present
+# getservent not present
+EOM
+    exit 
+} }
+getsockname STDIN ;	# OP_GETSOCKNAME
+getpeername STDIN ;	# OP_GETPEERNAME
+gethostbyname 1 ;	# OP_GHBYNAME
+gethostbyaddr 1,2;	# OP_GHBYADDR
+gethostent ;		# OP_GHOSTENT
+getnetbyname 1 ;	# OP_GNBYNAME
+getnetbyaddr 1,2 ;	# OP_GNBYADDR
+getnetent ;		# OP_GNETENT
+getprotobyname 1;	# OP_GPBYNAME
+getprotobynumber 1;	# OP_GPBYNUMBER
+getprotoent ;		# OP_GPROTOENT
+getservbyname 1,2;	# OP_GSBYNAME
+getservbyport 1,2;	# OP_GSBYPORT
+getservent ;		# OP_GSERVENT
+
+no warnings 'void' ;
+getsockname STDIN ;	# OP_GETSOCKNAME
+getpeername STDIN ;	# OP_GETPEERNAME
+gethostbyname 1 ;	# OP_GHBYNAME
+gethostbyaddr 1,2;	# OP_GHBYADDR
+gethostent ;		# OP_GHOSTENT
+getnetbyname 1 ;	# OP_GNBYNAME
+getnetbyaddr 1,2 ;	# OP_GNBYADDR
+getnetent ;		# OP_GNETENT
+getprotobyname 1;	# OP_GPBYNAME
+getprotobynumber 1;	# OP_GPBYNUMBER
+getprotoent ;		# OP_GPROTOENT
+getservbyname 1,2;	# OP_GSBYNAME
+getservbyport 1,2;	# OP_GSBYPORT
+getservent ;		# OP_GSERVENT
+INIT {
+   # some functions may not be there, so we exit without running
+   exit;
+}
+EXPECT
+Useless use of getsockname in void context at - line 24.
+Useless use of getpeername in void context at - line 25.
+Useless use of gethostbyname in void context at - line 26.
+Useless use of gethostbyaddr in void context at - line 27.
+Useless use of gethostent in void context at - line 28.
+Useless use of getnetbyname in void context at - line 29.
+Useless use of getnetbyaddr in void context at - line 30.
+Useless use of getnetent in void context at - line 31.
+Useless use of getprotobyname in void context at - line 32.
+Useless use of getprotobynumber in void context at - line 33.
+Useless use of getprotoent in void context at - line 34.
+Useless use of getservbyname in void context at - line 35.
+Useless use of getservbyport in void context at - line 36.
+Useless use of getservent in void context at - line 37.
+########
+# op.c
+use warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+no warnings 'void' ;
+*a ; # OP_RV2GV
+$a ; # OP_RV2SV
+@a ; # OP_RV2AV
+%a ; # OP_RV2HV
+EXPECT
+Useless use of a variable in void context at - line 3.
+Useless use of a variable in void context at - line 4.
+Useless use of a variable in void context at - line 5.
+Useless use of a variable in void context at - line 6.
+########
+# op.c
+use warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+no warnings 'void' ;
+"abc"; # OP_CONST
+7 ; # OP_CONST
+EXPECT
+Useless use of a constant in void context at - line 3.
+Useless use of a constant in void context at - line 4.
+########
+# op.c
+BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak
+use warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+{
+no warnings 'misc' ;
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
+@a =~ /abc/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
+@$b =~ /abc/ ;
+@$b =~ s/a/b/ ;
+@$b =~ tr/a/b/ ;
+%a =~ /abc/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
+%$c =~ /abc/ ;
+%$c =~ s/a/b/ ;
+%$c =~ tr/a/b/ ;
+}
+EXPECT
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 5.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 6.
+Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 7.
+Applying pattern match (m//) to @array will act on scalar(@array) at - line 8.
+Applying substitution (s///) to @array will act on scalar(@array) at - line 9.
+Applying transliteration (tr///) to @array will act on scalar(@array) at - line 10.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 11.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 12.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 13.
+Applying pattern match (m//) to %hash will act on scalar(%hash) at - line 14.
+Applying substitution (s///) to %hash will act on scalar(%hash) at - line 15.
+Applying transliteration (tr///) to %hash will act on scalar(%hash) at - line 16.
+BEGIN not safe after errors--compilation aborted at - line 18.
+########
+# op.c
+use warnings 'syntax' ;
+my $a, $b = (1,2);
+no warnings 'syntax' ;
+my $c, $d = (1,2);
+EXPECT
+Parentheses missing around "my" list at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+local $a, $b = (1,2);
+no warnings 'syntax' ;
+local $c, $d = (1,2);
+EXPECT
+Parentheses missing around "local" list at - line 3.
+########
+# op.c
+use warnings 'bareword' ;
+print (ABC || 1) ;
+no warnings 'bareword' ;
+print (ABC || 1) ;
+EXPECT
+Bareword found in conditional at - line 3.
+########
+--FILE-- abc
+
+--FILE--
+# op.c
+use warnings 'misc' ;
+open FH, "<abc" ;
+$x = 1 if $x = <FH> ;
+no warnings 'misc' ;
+$x = 1 if $x = <FH> ;
+EXPECT
+Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 if $x = readdir FH ;
+no warnings 'misc' ;
+$x = 1 if $x = readdir FH ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 if $x = <*> ;
+no warnings 'misc' ;
+$x = 1 if $x = <*> ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+%a = (1,2,3,4) ;
+$x = 1 if $x = each %a ;
+no warnings 'misc' ;
+$x = 1 if $x = each %a ;
+EXPECT
+Value of each() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = <*> and 0 ;
+EXPECT
+Value of glob construct can be "0"; test with defined() at - line 3.
+########
+# op.c
+use warnings 'misc' ;
+opendir FH, "." ;
+$x = 1 while $x = readdir FH and 0 ;
+no warnings 'misc' ;
+$x = 1 while $x = readdir FH and 0 ;
+closedir FH ;
+EXPECT
+Value of readdir() operator can be "0"; test with defined() at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred {}
+sub fred {}
+no warnings 'redefine' ;
+sub fred {}
+EXPECT
+Subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+sub fred () { 1 }
+sub fred () { 1 }
+no warnings 'redefine' ;
+sub fred () { 1 }
+EXPECT
+Constant subroutine fred redefined at - line 4.
+########
+# op.c
+use warnings 'redefine' ;
+format FRED =
+.
+format FRED =
+.
+no warnings 'redefine' ;
+format FRED =
+.
+EXPECT
+Format FRED redefined at - line 5.
+########
+# op.c
+use warnings 'deprecated' ;
+push FRED;
+no warnings 'deprecated' ;
+push FRED;
+EXPECT
+Array @FRED missing the @ in argument 1 of push() at - line 3.
+########
+# op.c
+use warnings 'deprecated' ;
+@a = keys FRED ;
+no warnings 'deprecated' ;
+@a = keys FRED ;
+EXPECT
+Hash %FRED missing the % in argument 1 of keys() at - line 3.
+########
+# op.c
+use warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+Statement unlikely to be reached at - line 4.
+	(Maybe you meant system() when you said exec()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my @a; defined(@a);
+EXPECT
+defined(@array) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+defined(@a = (1,2,3));
+EXPECT
+defined(@array) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+use warnings 'deprecated' ;
+my %h; defined(%h);
+EXPECT
+defined(%hash) is deprecated at - line 3.
+	(Maybe you should just omit the defined()?)
+########
+# op.c
+no warnings 'syntax' ;
+exec "$^X -e 1" ; 
+my $a
+EXPECT
+
+########
+# op.c
+sub fred();
+sub fred($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 3.
+########
+# op.c
+$^W = 0 ;
+sub fred() ;
+sub fred($) {}
+{
+    no warnings 'prototype' ;
+    sub Fred() ;
+    sub Fred($) {}
+    use warnings 'prototype' ;
+    sub freD() ;
+    sub freD($) {}
+}
+sub FRED() ;
+sub FRED($) {}
+EXPECT
+Prototype mismatch: sub main::fred () vs ($) at - line 4.
+Prototype mismatch: sub main::freD () vs ($) at - line 11.
+Prototype mismatch: sub main::FRED () vs ($) at - line 14.
+########
+# op.c
+use warnings 'syntax' ;
+join /---/, 'x', 'y', 'z';
+EXPECT
+/---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'prototype' ;
+fred() ; 
+sub fred ($$) {}
+no warnings 'prototype' ;
+joe() ; 
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+use warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+use abc;
+delete $INC{"abc.pm"};
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in check
+in init
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in begin
+Too late to run CHECK block at abc.pm line 3.
+Too late to run INIT block at abc.pm line 4.
+in mainline
+in end
+in end
+in end
+########
+# op.c [Perl_newATTRSUB]
+--FILE-- abc.pm
+no warnings 'void' ;
+BEGIN { $| = 1; print "in begin\n"; }
+CHECK { print "in check\n"; }
+INIT { print "in init\n"; }
+END { print "in end\n"; }
+print "in mainline\n";
+1;
+--FILE--
+require abc;
+do "abc.pm";
+EXPECT
+in begin
+in mainline
+in begin
+in mainline
+in end
+in end
diff --git a/gnu/usr.bin/perl/t/pragma/warn/perl b/gnu/usr.bin/perl/t/pragma/warn/perl
new file mode 100644
index 00000000000..45807499d6a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/perl
@@ -0,0 +1,57 @@
+  perl.c	AOK
+
+  gv_check(defstash)
+	Name \"%s::%s\" used only once: possible typo 
+
+  Mandatory Warnings All TODO
+  ------------------
+  Recompile perl with -DDEBUGGING to use -D switch	[moreswitches]
+  Unbalanced scopes: %ld more ENTERs than LEAVEs	[perl_destruct]
+  Unbalanced saves: %ld more saves than restores	[perl_destruct]
+  Unbalanced tmps: %ld more allocs than frees		[perl_destruct]
+  Unbalanced context: %ld more PUSHes than POPs		[perl_destruct]
+  Unbalanced string table refcount: (%d) for \"%s\"	[perl_destruct]
+  Scalars leaked: %ld					[perl_destruct]
+
+
+__END__
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::z" used only once: possible typo at - line 5.
+########
+-w
+# perl.c
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+# perl.c
+BEGIN { $^W =1 ; }
+$x = 3 ;
+no warnings 'once' ;
+$z = 3 
+EXPECT
+Name "main::x" used only once: possible typo at - line 3.
+########
+-W
+# perl.c
+no warnings 'once' ;
+$x = 3 ;
+use warnings 'once' ;
+$z = 3 ;
+EXPECT
+Name "main::x" used only once: possible typo at - line 4.
+Name "main::z" used only once: possible typo at - line 6.
+########
+-X
+# perl.c
+use warnings 'once' ;
+$x = 3 ;
+EXPECT
+
diff --git a/gnu/usr.bin/perl/t/pragma/warn/perlio b/gnu/usr.bin/perl/t/pragma/warn/perlio
new file mode 100644
index 00000000000..18c0dfa89f8
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/perlio
@@ -0,0 +1,10 @@
+  perlio.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+    Setting cnt to %d
+    Setting ptr %p > end+1 %p
+    Setting cnt to %d, ptr implies %d
+
+__END__
diff --git a/gnu/usr.bin/perl/t/pragma/warn/perly b/gnu/usr.bin/perl/t/pragma/warn/perly
new file mode 100644
index 00000000000..afc5dccc72f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/perly
@@ -0,0 +1,31 @@
+  perly.y	AOK
+
+  dep() => deprecate("\"do\" to call subroutines") 
+  Use of "do" to call subroutines is deprecated
+
+	sub fred {} do fred()
+	sub fred {} do fred(1)
+	sub fred {} $a = "fred" ; do $a()
+	sub fred {} $a = "fred" ; do $a(1)
+
+
+__END__
+# perly.y
+use warnings 'deprecated' ;
+sub fred {} 
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+no warnings 'deprecated' ;
+do fred() ;
+do fred(1) ;
+$a = "fred" ; 
+do $a() ;
+do $a(1) ;
+EXPECT
+Use of "do" to call subroutines is deprecated at - line 4.
+Use of "do" to call subroutines is deprecated at - line 5.
+Use of "do" to call subroutines is deprecated at - line 7.
+Use of "do" to call subroutines is deprecated at - line 8.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/pp b/gnu/usr.bin/perl/t/pragma/warn/pp
new file mode 100644
index 00000000000..8f42ba64ecc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/pp
@@ -0,0 +1,110 @@
+  pp.c	TODO
+
+  substr outside of string
+    $a = "ab" ; $b = substr($a, 4,5) ;
+
+  Attempt to use reference as lvalue in substr 
+    $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
+
+  uninitialized	in pp_rv2gv()
+	my *b = *{ undef()}
+
+  uninitialized	in pp_rv2sv()
+	my $a = undef ; my $b = $$a
+
+  Odd number of elements in hash list
+	my $a = { 1,2,3 } ;
+
+  Invalid type in unpack: '%c
+	my $A = pack ("A,A", 1,2) ;
+	my @A = unpack ("A,A", "22") ;
+
+  Attempt to pack pointer to temporary value
+	pack("p", "abc") ;
+
+  Explicit blessing to '' (assuming package main)
+	bless \[], "";
+
+  Constant subroutine %s undefined			<<<TODO
+  Constant subroutine (anonymous) undefined		<<<TODO
+
+__END__
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5) ;
+no warnings 'substr' ;
+$a = "ab" ; 
+$b = substr($a, 4,5)  ;
+EXPECT
+substr outside of string at - line 4.
+########
+# pp.c
+use warnings 'substr' ;
+$a = "ab" ; 
+$b = \$a ;  
+substr($b, 1,1) = "ab" ;
+no warnings 'substr' ;
+substr($b, 1,1) = "ab" ;
+EXPECT
+Attempt to use reference as lvalue in substr at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+# TODO
+EXPECT
+
+########
+# pp.c
+use warnings 'misc' ;
+my $a = { 1,2,3};
+no warnings 'misc' ;
+my $b = { 1,2,3};
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp.c
+use warnings 'pack' ;
+use warnings 'unpack' ;
+my @a = unpack ("A,A", "22") ;
+my $a = pack ("A,A", 1,2) ;
+no warnings 'pack' ;
+no warnings 'unpack' ;
+my @b = unpack ("A,A", "22") ;
+my $b = pack ("A,A", 1,2) ;
+EXPECT
+Invalid type in unpack: ',' at - line 4.
+Invalid type in pack: ',' at - line 5.
+########
+# pp.c
+use warnings 'uninitialized' ;
+my $a = undef ; 
+my $b = $$a;
+no warnings 'uninitialized' ;
+my $c = $$a;
+EXPECT
+Use of uninitialized value in scalar dereference at - line 4.
+########
+# pp.c
+use warnings 'pack' ;
+sub foo { my $a = "a"; return $a . $a++ . $a++ }
+my $a = pack("p", &foo) ;
+no warnings 'pack' ;
+my $b = pack("p", &foo) ;
+EXPECT
+Attempt to pack pointer to temporary value at - line 4.
+########
+# pp.c
+use warnings 'misc' ;
+bless \[], "" ;
+no warnings 'misc' ;
+bless \[], "" ;
+EXPECT
+Explicit blessing to '' (assuming package main) at - line 3.
+########
+# pp.c
+use utf8 ;
+$_ = "\x80  \xff" ;
+reverse ;
+EXPECT
+########
diff --git a/gnu/usr.bin/perl/t/pragma/warn/pp_ctl b/gnu/usr.bin/perl/t/pragma/warn/pp_ctl
new file mode 100644
index 00000000000..0deccd35e27
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/pp_ctl
@@ -0,0 +1,217 @@
+  pp_ctl.c	AOK
+ 
+     Not enough format arguments	
+ 	format STDOUT =
+ 	@<<< @<<<
+ 	$a
+ 	.
+ 	write;
+     
+
+    Exiting substitution via %s
+	$_ = "abc" ;
+	while ($i ++ == 0)
+	{
+    	    s/ab/last/e ;
+	}
+
+    Exiting subroutine via %s		
+	sub fred { last }
+	{ fred() }
+
+    Exiting eval via %s	
+	{ eval "last" }
+
+    Exiting pseudo-block via %s 
+	@a = (1,2) ; @b = sort { last } @a ;
+
+    Exiting substitution via %s
+	$_ = "abc" ;
+	last fred:
+	while ($i ++ == 0)
+	{
+    	    s/ab/last fred/e ;
+	}
+
+
+    Exiting subroutine via %s
+	sub fred { last joe }
+	joe: { fred() }
+
+    Exiting eval via %s
+	fred: { eval "last fred" }
+
+    Exiting pseudo-block via %s 
+	@a = (1,2) ; fred: @b = sort { last fred } @a ;
+
+
+    Deep recursion on subroutine \"%s\"
+	sub fred
+	{
+    	  fred() if $a++ < 200
+	}
+	 
+	fred()
+
+      (in cleanup) foo bar
+	package Foo;
+	DESTROY { die "foo bar" }
+	{ bless [], 'Foo' for 1..10 }
+
+__END__
+# pp_ctl.c
+use warnings 'syntax' ;
+format STDOUT =
+@<<< @<<<
+1
+.
+write;
+EXPECT
+Not enough format arguments at - line 5.
+1
+########
+# pp_ctl.c
+no warnings 'syntax' ;
+format =
+@<<< @<<<
+1
+.
+write ;
+EXPECT
+1
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+ 
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last }
+{ fred() }
+no warnings 'exiting' ;
+sub joe { last }
+{ joe() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+{
+  eval "use warnings 'exiting' ; last;" 
+}
+print STDERR $@ ;
+{
+  eval "no warnings 'exiting' ;last;" 
+} 
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+@b = sort { last } @a ;
+no warnings 'exiting' ;
+@b = sort { last } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Can't "last" outside a loop block at - line 4.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+$_ = "abc" ;
+fred: 
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+no warnings 'exiting' ;
+while ($i ++ == 0)
+{
+    s/ab/last fred/e ;
+}
+EXPECT
+Exiting substitution via last at - line 7.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+sub fred { last joe }
+joe: { fred() }
+no warnings 'exiting' ;
+sub Fred { last Joe }
+Joe: { Fred() }
+EXPECT
+Exiting subroutine via last at - line 3.
+########
+# pp_ctl.c
+joe:
+{ eval "use warnings 'exiting' ; last joe;" }
+print STDERR $@ ;
+Joe:
+{ eval "no warnings 'exiting' ; last Joe;" }
+print STDERR $@ ;
+EXPECT
+Exiting eval via last at (eval 1) line 1.
+########
+# pp_ctl.c
+use warnings 'exiting' ;
+@a = (1,2) ;
+fred: @b = sort { last fred } @a ;
+no warnings 'exiting' ;
+Fred: @b = sort { last Fred } @a ;
+EXPECT
+Exiting pseudo-block via last at - line 4.
+Label not found for "last fred" at - line 4.
+########
+# pp_ctl.c
+use warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+Deep recursion on subroutine "main::fred" at - line 6.
+########
+# pp_ctl.c
+no warnings 'recursion' ;
+BEGIN { warn "PREFIX\n" ;}
+sub fred
+{
+    fred() if $a++ < 200
+}
+ 
+fred()
+EXPECT
+########
+# pp_ctl.c
+use warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+	(in cleanup) A foo bar at - line 4.
+	(in cleanup) B foo bar at - line 4.
+########
+# pp_ctl.c
+no warnings 'misc' ;
+package Foo;
+DESTROY { die "@{$_[0]} foo bar" }
+{ bless ['A'], 'Foo' for 1..10 }
+{ bless ['B'], 'Foo' for 1..10 }
+EXPECT
+
diff --git a/gnu/usr.bin/perl/t/pragma/warn/pp_hot b/gnu/usr.bin/perl/t/pragma/warn/pp_hot
new file mode 100644
index 00000000000..275905749ed
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/pp_hot
@@ -0,0 +1,226 @@
+  pp_hot.c	
+
+  Filehandle %s never opened			[pp_print]
+    $f = $a = "abc" ; print $f $a
+
+  Filehandle %s opened only for input		[pp_print]
+    print STDIN "abc" ;
+
+  Filehandle %s opened only for output		[pp_print]
+    print <STDOUT> ;
+
+  print() on closed filehandle %s		[pp_print]
+    close STDIN ; print STDIN "abc" ;
+
+  uninitialized					[pp_rv2av]
+	my $a = undef ; my @b = @$a
+
+  uninitialized					[pp_rv2hv]
+	my $a = undef ; my %b = %$a
+
+  Odd number of elements in hash list		[pp_aassign]
+	%X = (1,2,3) ;
+
+  Reference found where even-sized list expected [pp_aassign]
+	$X = [ 1 ..3 ];
+
+  Filehandle %s opened only for output		[Perl_do_readline] 
+  	open (FH, ">./xcv") ;
+	my $a = <FH> ;
+
+  glob failed (can't start child: %s)		[Perl_do_readline] <<TODO
+
+  readline() on closed filehandle %s		[Perl_do_readline]
+    close STDIN ; $a = <STDIN>;
+
+  glob failed (child exited with status %d%s)	[Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"		[Perl_sub_crush_depth]
+    sub fred { fred() if $a++ < 200} fred()
+
+  Deep recursion on anonymous subroutine 	[Perl_sub_crush_depth]
+    $a = sub { &$a if $a++ < 200} &$a
+
+  Possible Y2K bug: about to append an integer to '19' [pp_concat]
+    $x     = "19$yy\n";
+
+__END__
+# pp_hot.c [pp_print]
+use warnings 'unopened' ;
+$f = $a = "abc" ; 
+print $f $a;
+no warnings 'unopened' ;
+print $f $a;
+EXPECT
+Filehandle main::abc never opened at - line 4.
+########
+# pp_hot.c [pp_print]
+use warnings 'io' ;
+print STDIN "anc";
+print <STDOUT>;
+print <STDERR>;
+open(FOO, ">&STDOUT") and print <FOO>;
+print getc(STDERR);
+print getc(FOO);
+####################################################################
+# The next test is known to fail on some systems (Linux+old glibc, #
+# old *BSDs, and NeXT, among others.                               #
+# We skip it for now (on the grounds that it is "just" a warning). #
+####################################################################
+#read(FOO,$_,1);
+no warnings 'io' ;
+print STDIN "anc";
+EXPECT
+Filehandle main::STDIN opened only for input at - line 3.
+Filehandle main::STDOUT opened only for output at - line 4.
+Filehandle main::STDERR opened only for output at - line 5.
+Filehandle main::FOO opened only for output at - line 6.
+Filehandle main::STDERR opened only for output at - line 7.
+Filehandle main::FOO opened only for output at - line 8.
+########
+# pp_hot.c [pp_print]
+use warnings 'closed' ;
+close STDIN ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+closedir STDIN;
+no warnings 'closed' ;
+print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+EXPECT
+print() on closed filehandle main::STDIN at - line 4.
+print() on closed filehandle main::STDIN at - line 6.
+	(Are you trying to call print() on dirhandle main::STDIN?)
+########
+# pp_hot.c [pp_rv2av]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my @b = @$a;
+no warnings 'uninitialized' ;
+my @c = @$a;
+EXPECT
+Use of uninitialized value in array dereference at - line 4.
+########
+# pp_hot.c [pp_rv2hv]
+use warnings 'uninitialized' ;
+my $a = undef ;
+my %b = %$a;
+no warnings 'uninitialized' ;
+my %c = %$a;
+EXPECT
+Use of uninitialized value in hash dereference at - line 4.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = (1,2,3) ;
+no warnings 'misc' ;
+my %Y ; %Y = (1,2,3) ;
+EXPECT
+Odd number of elements in hash assignment at - line 3.
+########
+# pp_hot.c [pp_aassign]
+use warnings 'misc' ;
+my %X ; %X = [1 .. 3] ;
+no warnings 'misc' ;
+my %Y ; %Y = [1 .. 3] ;
+EXPECT
+Reference found where even-sized list expected at - line 3.
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'closed' ;
+close STDIN        ; $a = <STDIN> ;
+opendir STDIN, "." ; $a = <STDIN> ;
+closedir STDIN;
+no warnings 'closed' ;
+opendir STDIN, "." ; $a = <STDIN> ;
+$a = <STDIN> ;
+EXPECT
+readline() on closed filehandle main::STDIN at - line 3.
+readline() on closed filehandle main::STDIN at - line 4.
+	(Are you trying to call readline() on dirhandle main::STDIN?)
+########
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+unlink $file ;
+EXPECT
+Filehandle main::FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+ok
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+sub fred 
+{ 
+    fred() if $a++ < 200
+} 
+{
+  local $SIG{__WARN__} = sub {
+    die "ok\n" if $_[0] =~ /^Deep recursion on subroutine "main::fred"/
+  };
+  fred();
+}
+EXPECT
+
+########
+# pp_hot.c [Perl_sub_crush_depth]
+use warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+Deep recursion on anonymous subroutine at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
+no warnings 'recursion' ;
+$b = sub 
+{ 
+    &$b if $a++ < 200
+}  ;
+
+&$b ;
+EXPECT
+########
+# pp_hot.c [pp_concat]
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+	exit 0;
+    }
+}
+my $x;
+my $yy = 78;
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+$x     = "319$yy\n";
+$x     = "319" . $yy . "\n";
+no warnings 'y2k';
+$x     = "19$yy\n";
+$x     = "19" . $yy . "\n";
+EXPECT
+Possible Y2K bug: about to append an integer to '19' at - line 12.
+Possible Y2K bug: about to append an integer to '19' at - line 13.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/pp_sys b/gnu/usr.bin/perl/t/pragma/warn/pp_sys
new file mode 100644
index 00000000000..7c38727e28e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/pp_sys
@@ -0,0 +1,354 @@
+  pp_sys.c 	AOK
+
+  untie attempted while %d inner references still exist	[pp_untie]
+    sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
+
+  Filehandle %s opened only for input		[pp_leavewrite]
+    format STDIN =
+    .
+    write STDIN;
+
+  write() on closed filehandle %s		[pp_leavewrite]
+    format STDIN =
+    .
+    close STDIN;
+    write STDIN ;
+
+  page overflow	 				[pp_leavewrite]
+
+  Filehandle %s never opened			[pp_prtf]
+    $a = "abc"; printf $a "fred"
+
+  Filehandle %s opened only for input		[pp_prtf]
+    $a = "abc"; 
+    printf $a "fred"
+
+  printf() on closed filehandle %s		[pp_prtf]
+    close STDIN ;
+    printf STDIN "fred"
+
+  syswrite() on closed filehandle %s		[pp_send]
+    close STDIN; 
+    syswrite STDIN, "fred", 1;
+
+  send() on closed socket %s			[pp_send]
+    close STDIN; 
+    send STDIN, "fred", 1
+
+  bind() on closed socket %s			[pp_bind]
+    close STDIN; 
+    bind STDIN, "fred" ;
+
+
+  connect() on closed socket %s			[pp_connect]
+    close STDIN; 
+    connect STDIN, "fred" ;
+
+  listen() on closed socket %s			[pp_listen]
+    close STDIN; 
+    listen STDIN, 2;
+
+  accept() on closed socket %s			[pp_accept]
+    close STDIN; 
+    accept "fred", STDIN ;
+
+  shutdown() on closed socket %s		[pp_shutdown]
+    close STDIN; 
+    shutdown STDIN, 0;
+
+  setsockopt() on closed socket %s		[pp_ssockopt]
+  getsockopt() on closed socket	%s		[pp_ssockopt]
+    close STDIN; 
+    setsockopt STDIN, 1,2,3;
+    getsockopt STDIN, 1,2;
+
+  getsockname() on closed socket %s		[pp_getpeername]
+  getpeername() on closed socket %s		[pp_getpeername]
+    close STDIN; 
+    getsockname STDIN;
+    getpeername STDIN;
+
+  flock() on closed socket %s			[pp_flock]
+    close STDIN;
+    flock STDIN, 8;
+
+  warn(warn_nl, "stat");			[pp_stat]
+
+  Test on unopened file <%s>
+	close STDIN ; -T STDIN ;
+
+  warn(warn_nl, "open");			[pp_fttext]
+    -T "abc\ndef" ;
+
+  Filehandle %s opened only for output		[pp_sysread]
+	my $file = "./xcv" ;
+	open(F, ">$file") ; 
+	my $a = sysread(F, $a,10) ;
+  
+  
+
+__END__
+# pp_sys.c [pp_untie]
+use warnings 'untie' ;
+sub TIESCALAR { bless [] } ; 
+$b = tie $a, 'main'; 
+untie $a ;
+no warnings 'untie' ;
+$c = tie $d, 'main'; 
+untie $d ;
+EXPECT
+untie attempted while 1 inner references still exist at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDIN =
+.
+write STDIN;
+no warnings 'io' ;
+write STDIN;
+EXPECT
+Filehandle main::STDIN opened only for input at - line 5.
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'closed' ;
+format STDIN =
+.
+close STDIN;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+closedir STDIN;
+no warnings 'closed' ;
+write STDIN;
+opendir STDIN, ".";
+write STDIN;
+EXPECT
+write() on closed filehandle main::STDIN at - line 6.
+write() on closed filehandle main::STDIN at - line 8.
+	(Are you trying to call write() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_leavewrite]
+use warnings 'io' ;
+format STDOUT_TOP =
+abc
+.
+format STDOUT =
+def
+ghi
+.
+$= = 1 ;
+$- =1 ;
+open STDOUT, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+write ;
+no warnings 'io' ;
+write ;
+EXPECT
+page overflow at - line 13.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'unopened' ;
+$a = "abc"; 
+printf $a "fred";
+no warnings 'unopened' ;
+printf $a "fred";
+EXPECT
+Filehandle main::abc never opened at - line 4.
+########
+# pp_sys.c [pp_prtf]
+use warnings 'closed' ;
+close STDIN ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+closedir STDIN;
+no warnings 'closed' ;
+printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+EXPECT
+printf() on closed filehandle main::STDIN at - line 4.
+printf() on closed filehandle main::STDIN at - line 6.
+	(Are you trying to call printf() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_prtf]
+use warnings 'io' ;
+printf STDIN "fred";
+no warnings 'io' ;
+printf STDIN "fred";
+EXPECT
+Filehandle main::STDIN opened only for input at - line 3.
+########
+# pp_sys.c [pp_send]
+use warnings 'closed' ;
+close STDIN; 
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+closedir STDIN;
+no warnings 'closed' ;
+syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+EXPECT
+syswrite() on closed filehandle main::STDIN at - line 4.
+syswrite() on closed filehandle main::STDIN at - line 6.
+	(Are you trying to call syswrite() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_flock]
+use Config; 
+BEGIN { 
+  if ( $^O eq 'VMS' and ! $Config{d_flock}) {
+    print <<EOM ;
+SKIPPED
+# flock not present
+EOM
+    exit ;
+  } 
+}
+use warnings 'closed' ;
+close STDIN;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+no warnings 'closed' ;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+EXPECT
+flock() on closed filehandle main::STDIN at - line 14.
+flock() on closed filehandle main::STDIN at - line 16.
+	(Are you trying to call flock() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
+use warnings 'io' ;
+use Config; 
+BEGIN { 
+  if ( $^O ne 'VMS' and ! $Config{d_socket}) {
+    print <<EOM ;
+SKIPPED
+# send not present
+# bind not present
+# connect not present
+# accept not present
+# shutdown not present
+# setsockopt not present
+# getsockopt not present
+# getsockname not present
+# getpeername not present
+EOM
+    exit ;
+  } 
+}
+close STDIN; 
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+closedir STDIN;
+no warnings 'io' ;
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept STDIN, "fred" ;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+EXPECT
+send() on closed socket main::STDIN at - line 22.
+bind() on closed socket main::STDIN at - line 23.
+connect() on closed socket main::STDIN at - line 24.
+listen() on closed socket main::STDIN at - line 25.
+accept() on closed socket main::STDIN at - line 26.
+shutdown() on closed socket main::STDIN at - line 27.
+setsockopt() on closed socket main::STDIN at - line 28.
+getsockopt() on closed socket main::STDIN at - line 29.
+getsockname() on closed socket main::STDIN at - line 30.
+getpeername() on closed socket main::STDIN at - line 31.
+send() on closed socket main::STDIN at - line 33.
+	(Are you trying to call send() on dirhandle main::STDIN?)
+bind() on closed socket main::STDIN at - line 34.
+	(Are you trying to call bind() on dirhandle main::STDIN?)
+connect() on closed socket main::STDIN at - line 35.
+	(Are you trying to call connect() on dirhandle main::STDIN?)
+listen() on closed socket main::STDIN at - line 36.
+	(Are you trying to call listen() on dirhandle main::STDIN?)
+accept() on closed socket main::STDIN at - line 37.
+	(Are you trying to call accept() on dirhandle main::STDIN?)
+shutdown() on closed socket main::STDIN at - line 38.
+	(Are you trying to call shutdown() on dirhandle main::STDIN?)
+setsockopt() on closed socket main::STDIN at - line 39.
+	(Are you trying to call setsockopt() on dirhandle main::STDIN?)
+getsockopt() on closed socket main::STDIN at - line 40.
+	(Are you trying to call getsockopt() on dirhandle main::STDIN?)
+getsockname() on closed socket main::STDIN at - line 41.
+	(Are you trying to call getsockname() on dirhandle main::STDIN?)
+getpeername() on closed socket main::STDIN at - line 42.
+	(Are you trying to call getpeername() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_stat]
+use warnings 'newline' ;
+stat "abc\ndef";
+no warnings 'newline' ;
+stat "abc\ndef";
+EXPECT
+Unsuccessful stat on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_fttext]
+use warnings 'unopened' ;
+close STDIN ; 
+-T STDIN ;
+no warnings 'unopened' ;
+-T STDIN ;
+EXPECT
+Test on unopened file <STDIN> at - line 4.
+########
+# pp_sys.c [pp_fttext]
+use warnings 'newline' ;
+-T "abc\ndef" ;
+no warnings 'newline' ;
+-T "abc\ndef" ;
+EXPECT
+Unsuccessful open on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_sysread]
+use warnings 'io' ;
+my $file = "./xcv" ;
+open(F, ">$file") ; 
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle main::F opened only for output at - line 5.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/regcomp b/gnu/usr.bin/perl/t/pragma/warn/regcomp
new file mode 100644
index 00000000000..5d0c291ea04
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/regcomp
@@ -0,0 +1,165 @@
+  regcomp.c	AOK
+
+  Strange *+?{} on zero-length expression	[S_study_chunk]
+	/(?=a)?/
+
+  %.*s matches null string many times   	[S_regpiece]
+	$a = "ABC123" ; $a =~ /(?=a)*/'
+
+  /%.127s/: Unrecognized escape \\%c passed through	[S_regatom] 
+  	$x = '\m' ; /$x/
+
+  Character class [:%.*s:] unknown	[S_regpposixcc]
+
+  Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
+
+  Character class syntax [= =] is reserved for future extensions [S_checkposixcc]
+
+  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
+  
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass]
+
+  /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8]
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"	[S_regclass] 
+
+  /%.127s/: Unrecognized escape \\%c in character class passed through"	[S_regclassutf8] 
+
+__END__
+# regcomp.c [S_regpiece]
+use warnings 'regexp' ;
+my $a = "ABC123" ; 
+$a =~ /(?=a)*/ ;
+no warnings 'regexp' ;
+$a =~ /(?=a)*/ ;
+EXPECT
+(?=a)* matches null string many times at - line 4.
+########
+# regcomp.c [S_study_chunk]
+use warnings 'regexp' ;
+$_ = "" ;
+/(?=a)?/;
+no warnings 'regexp' ;
+/(?=a)?/;
+EXPECT
+Strange *+?{} on zero-length expression at - line 4.
+########
+# regcomp.c [S_regatom]
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
+EXPECT
+/a\m/: Unrecognized escape \m passed through at - line 4.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
+BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 }
+use warnings 'regexp' ;
+$_ = "" ;
+/[:alpha:]/;
+/[.bar.]/;
+/[=zog=]/;
+/[[:alpha:]]/;
+/[[.foo.]]/;
+/[[=bar=]]/;
+/[:zog:]/;
+/[[:zog:]]/;
+no warnings 'regexp' ;
+/[:alpha:]/;
+/[.foo.]/;
+/[=bar=]/;
+/[[:alpha:]]/;
+/[[.foo.]]/;
+/[[=bar=]]/;
+/[[:zog:]]/;
+/[:zog:]/;
+EXPECT
+Character class syntax [: :] belongs inside character classes at - line 5.
+Character class syntax [. .] belongs inside character classes at - line 6.
+Character class syntax [. .] is reserved for future extensions at - line 6.
+Character class syntax [= =] belongs inside character classes at - line 7.
+Character class syntax [= =] is reserved for future extensions at - line 7.
+Character class syntax [. .] is reserved for future extensions at - line 9.
+Character class syntax [= =] is reserved for future extensions at - line 10.
+Character class syntax [: :] belongs inside character classes at - line 11.
+Character class [:zog:] unknown at - line 12.
+########
+# regcomp.c [S_regclass]
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+/[a-\d]/: false [] range "a-\d" in regexp at - line 5.
+/[\d-b]/: false [] range "\d-" in regexp at - line 6.
+/[\s-\d]/: false [] range "\s-" in regexp at - line 7.
+/[\d-\s]/: false [] range "\d-" in regexp at - line 8.
+/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 9.
+/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 10.
+/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 11.
+/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 12.
+########
+# regcomp.c [S_regclassutf8]
+BEGIN {
+    if (ord("\t") == 5) {
+        print "SKIPPED\n# ebcdic regular expression ranges differ.";
+        exit 0;
+    }
+}
+use utf8;
+$_ = "";
+use warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+no warnings 'regexp' ;
+/[a-b]/;
+/[a-\d]/;
+/[\d-b]/;
+/[\s-\d]/;
+/[\d-\s]/;
+/[a-[:digit:]]/;
+/[[:digit:]-b]/;
+/[[:alpha:]-[:digit:]]/;
+/[[:digit:]-[:alpha:]]/;
+EXPECT
+/[a-\d]/: false [] range "a-\d" in regexp at - line 12.
+/[\d-b]/: false [] range "\d-" in regexp at - line 13.
+/[\s-\d]/: false [] range "\s-" in regexp at - line 14.
+/[\d-\s]/: false [] range "\d-" in regexp at - line 15.
+/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 16.
+/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 17.
+/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 18.
+/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 19.
+########
+# regcomp.c [S_regclass S_regclassutf8]
+use warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+no warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+EXPECT
+/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/regexec b/gnu/usr.bin/perl/t/pragma/warn/regexec
new file mode 100644
index 00000000000..73696dfb1d6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/regexec
@@ -0,0 +1,119 @@
+  regexec.c	
+
+  This test generates "bad free" warnings when run under
+  PERL_DESTRUCT_LEVEL.  This file merely serves as a placeholder
+  for investigation.
+
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*$/ ;
+  Complex regular subexpression recursion limit (%d) exceeded
+
+        $_ = 'a' x (2**15+1); /^()(a\1)*?$/ ;
+
+  (The actual value substituted for %d is masked in the tests so that
+  REG_INFTY configuration variable value does not affect outcome.)
+__END__
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1); 
+/^()(a\1)*$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+use warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+Complex regular subexpression recursion limit (*MASKED*) exceeded at - line 9.
+########
+# regexec.c
+print("SKIPPED\n# most systems run into stacksize limits\n"),exit;
+no warnings 'regexp' ;
+$SIG{__WARN__} = sub{local ($m) = shift;
+                 $m =~ s/\(\d+\)/(*MASKED*)/;
+                 print STDERR $m};
+$_ = 'a' x (2**15+1);
+/^()(a\1)*?$/ ;
+#
+# If this test fails with a segmentation violation or similar,
+# you may have to increase the default stacksize limit in your
+# shell.  You may need superuser privileges.
+#
+# Under the sh, ksh, zsh:
+#    $ ulimit -s
+#    8192
+#    $ ulimit -s 16000
+#
+# Under the csh:
+#    % limit stacksize
+#    stacksize        8192 kbytes
+#    % limit stacksize 16000
+#
+EXPECT
+
diff --git a/gnu/usr.bin/perl/t/pragma/warn/run b/gnu/usr.bin/perl/t/pragma/warn/run
new file mode 100644
index 00000000000..7a4be20e704
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/run
@@ -0,0 +1,8 @@
+  run.c 
+
+
+  Mandatory Warnings ALL TODO
+  ------------------
+        NULL OP IN RUN
+
+__END__
diff --git a/gnu/usr.bin/perl/t/pragma/warn/sv b/gnu/usr.bin/perl/t/pragma/warn/sv
new file mode 100644
index 00000000000..758137f2e8d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/sv
@@ -0,0 +1,303 @@
+  sv.c	
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  not_a_number(sv);
+
+  not_a_number(sv);
+
+  warn(warn_uninit);
+
+  warn(warn_uninit);
+
+  Subroutine %s redefined	
+
+  Invalid conversion in %s:
+
+  Undefined value assigned to typeglob
+
+  Possible Y2K bug: %d format string following '19'
+
+  Reference is already weak			[Perl_sv_rvweaken] <<TODO
+
+  Mandatory Warnings
+  ------------------
+  Malformed UTF-8 character [sv_pos_b2u] (not tested: difficult to produce
+                                          with perl now)
+
+  Mandatory Warnings TODO
+  ------------------
+    Attempt to free non-arena SV: 0x%lx		[del_sv]
+    Reference miscount in sv_replace()		[sv_replace]
+    Attempt to free unreferenced scalar		[sv_free]
+    Attempt to free temp prematurely: SV 0x%lx	[sv_free]
+    semi-panic: attempt to dup freed string	[newSVsv]
+    
+
+__END__
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # a
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # a
+EXPECT
+Use of uninitialized value in integer addition (+) at - line 4.
+########
+# sv.c (sv_2iv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use integer ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 10.
+########
+# sv.c
+use integer ;
+use warnings 'uninitialized' ;
+my $x *= 2 ; #b 
+no warnings 'uninitialized' ;
+my $y *= 2 ; #b 
+EXPECT
+Use of uninitialized value in integer multiplication (*) at - line 4.
+########
+# sv.c (sv_2uv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+no warnings 'uninitialized' ;
+$B = 0 ;
+$B |= $A ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 10.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $Y = 1 ; 
+my $x = 1 | $a[$Y] ;
+no warnings 'uninitialized' ;
+my $Y = 1 ; 
+$x = 1 | $b[$Y] ;
+EXPECT
+Use of uninitialized value in bitwise or (|) at - line 4.
+########
+# sv.c
+use warnings 'uninitialized' ;
+my $x *= 1 ; # d
+no warnings 'uninitialized' ;
+my $y *= 1 ; # d
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = 1 + $a[0] ; # e
+no warnings 'uninitialized' ;
+$x = 1 + $b[0] ; # e
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c (sv_2nv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$A *= 2 ;
+no warnings 'uninitialized' ;
+$A *= 2 ;
+EXPECT
+Use of uninitialized value in multiplication (*) at - line 9.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = $y + 1 ; # f
+no warnings 'uninitialized' ;
+$x = $z + 1 ; # f
+EXPECT
+Use of uninitialized value in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop undef ; # g
+no warnings 'uninitialized' ;
+$x = chop undef ; # g
+EXPECT
+Modification of a read-only value attempted at - line 3.
+########
+# sv.c
+use warnings 'uninitialized' ;
+$x = chop $y ; # h
+no warnings 'uninitialized' ;
+$x = chop $z ; # h
+EXPECT
+Use of uninitialized value in scalar chop at - line 3.
+########
+# sv.c (sv_2pv)
+package fred ;
+sub TIESCALAR { my $x ; bless \$x}
+sub FETCH { return undef }
+sub STORE { return 1 }
+package main ;
+tie $A, 'fred' ;
+use warnings 'uninitialized' ;
+$B = "" ;
+$B .= $A ;
+no warnings 'uninitialized' ;
+$C = "" ;
+$C .= $A ;
+EXPECT
+Use of uninitialized value in concatenation (.) at - line 10.
+########
+# sv.c 
+use warnings 'numeric' ;
+sub TIESCALAR{bless[]} ; 
+sub FETCH {"def"} ; 
+tie $a,"main" ; 
+my $b = 1 + $a;
+no warnings 'numeric' ;
+my $c = 1 + $a;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 6.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 + "def" ;
+no warnings 'numeric' ;
+my $z = 1 + "def" ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 3.
+########
+# sv.c
+use warnings 'numeric' ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $y = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ; use integer ;
+my $a = "def" ;
+my $x = 1 + $a ;
+no warnings 'numeric' ;
+my $z = 1 + $a ;
+EXPECT
+Argument "def" isn't numeric in integer addition (+) at - line 4.
+########
+# sv.c
+use warnings 'numeric' ;
+my $x = 1 & "def" ;
+no warnings 'numeric' ;
+my $z = 1 & "def" ;
+EXPECT
+Argument "def" isn't numeric in bitwise and (&) at - line 3.
+########
+# sv.c
+use warnings 'redefine' ;
+sub fred {}  
+sub joe {} 
+*fred = \&joe ;
+no warnings 'redefine' ;
+sub jim {} 
+*jim = \&joe ;
+EXPECT
+Subroutine fred redefined at - line 5.
+########
+# sv.c
+use warnings 'printf' ;
+open F, ">".($^O eq 'VMS'? 'NL:' : '/dev/null') ;
+printf F "%z\n" ;
+my $a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+no warnings 'printf' ;
+printf F "%z\n" ;
+$a = sprintf "%z" ;
+printf F "%" ;
+$a = sprintf "%" ;
+printf F "%\x02" ;
+$a = sprintf "%\x02" ;
+EXPECT
+Invalid conversion in sprintf: "%z" at - line 5.
+Invalid conversion in sprintf: end of string at - line 7.
+Invalid conversion in sprintf: "%\002" at - line 9.
+Invalid conversion in printf: "%z" at - line 4.
+Invalid conversion in printf: end of string at - line 6.
+Invalid conversion in printf: "%\002" at - line 8.
+########
+# sv.c
+use warnings 'misc' ;
+*a = undef ;
+no warnings 'misc' ;
+*b = undef ;
+EXPECT
+Undefined value assigned to typeglob at - line 3.
+########
+# sv.c
+use warnings 'y2k';
+use Config;
+BEGIN {
+    unless ($Config{ccflags} =~ /Y2KWARN/) {
+	print "SKIPPED\n# perl not built with -DPERL_Y2KWARN";
+	exit 0;
+    }
+    $|=1;
+}
+my $x;
+my $yy = 78;
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "#19%02d\n", $yy;
+$x     = printf  " 19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+$x     = printf  "319%02d\n", $yy;
+$x     = sprintf "319%02d\n", $yy;
+no warnings 'y2k';
+$x     = printf  "19%02d\n", $yy;
+$x     = sprintf "19%02d\n", $yy;
+$x     = printf  "19%02d\n", 78;
+$x     = sprintf "19%02d\n", 78;
+EXPECT
+Possible Y2K bug: %d format string following '19' at - line 16.
+Possible Y2K bug: %d format string following '19' at - line 13.
+1978
+Possible Y2K bug: %d format string following '19' at - line 14.
+Possible Y2K bug: %d format string following '19' at - line 15.
+ 1978
+31978
+1978
+1978
diff --git a/gnu/usr.bin/perl/t/pragma/warn/taint b/gnu/usr.bin/perl/t/pragma/warn/taint
new file mode 100644
index 00000000000..fd6deed60f9
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/taint
@@ -0,0 +1,49 @@
+  taint.c AOK
+
+  Insecure %s%s while running with -T switch
+
+__END__
+-T
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 5.
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+chdir $a ;
+print "xxx\n" ;
+EXPECT
+xxx
+########
+-TU
+--FILE-- abc
+def
+--FILE--
+# taint.c
+open(FH, "<abc") ;
+$a = <FH> ;
+close FH ;
+use warnings 'taint' ;
+chdir $a ;
+print "xxx\n" ;
+no warnings 'taint' ;
+chdir $a ;
+print "yyy\n" ;
+EXPECT
+Insecure dependency in chdir while running with -T switch at - line 6.
+xxx
+yyy
diff --git a/gnu/usr.bin/perl/t/pragma/warn/toke b/gnu/usr.bin/perl/t/pragma/warn/toke
new file mode 100644
index 00000000000..cfdea78d3c3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/toke
@@ -0,0 +1,583 @@
+toke.c	AOK
+
+    we seem to have lost a few ambiguous warnings!!
+
+ 
+             	1 if $a EQ $b ;
+             	1 if $a NE $b ;
+             	1 if $a LT $b ;
+             	1 if $a GT $b ;
+             	1 if $a GE $b ;
+             	1 if $a LE $b ;
+ 		$a = <<;
+ 		Use of comma-less variable list is deprecated 
+		(called 3 times via depcom)
+
+     \1 better written as $1 
+ 	use warnings 'syntax' ;
+ 	s/(abc)/\1/;
+ 
+     warn(warn_nosemi) 
+     Semicolon seems to be missing
+	$a = 1
+	&time ;
+
+
+     Reversed %c= operator 
+	my $a =+ 2 ;
+	$a =- 2 ;
+	$a =* 2 ;
+	$a =% 2 ;
+	$a =& 2 ;
+	$a =. 2 ;
+	$a =^ 2 ;
+	$a =| 2 ;
+	$a =< 2 ;
+	$a =/ 2 ;
+
+     Multidimensional syntax %.*s not supported 
+	my $a = $a[1,2] ;
+
+     You need to quote \"%s\"" 
+	sub fred {} ; $SIG{TERM} = fred;
+
+     Scalar value %.*s better written as $%.*s" 
+	@a[3] = 2;
+	@a{3} = 2;
+
+     Can't use \\%c to mean $%c in expression 
+	$_ = "ab" ; s/(ab)/\1/e;
+
+     Unquoted string "abc" may clash with future reserved word at - line 3.
+     warn(warn_reserved	
+	$a = abc;
+
+     chmod() mode argument is missing initial 0 
+	chmod 3;
+
+     Possible attempt to separate words with commas 
+	@a = qw(a, b, c) ;
+
+     Possible attempt to put comments in qw() list 
+	@a = qw(a b # c) ;
+
+     umask: argument is missing initial 0 
+	umask 3;
+
+     %s (...) interpreted as function 
+	print ("")
+	printf ("")
+	sort ("")
+
+     Ambiguous use of %c{%s%s} resolved to %c%s%s 
+	$a = ${time[2]}
+	$a = ${time{2}}
+
+
+     Ambiguous use of %c{%s} resolved to %c%s
+	$a = ${time}
+	sub fred {} $a = ${fred}
+
+     Misplaced _ in number 
+	$a = 1_2;
+	$a = 1_2345_6;
+
+    Bareword \"%s\" refers to nonexistent package
+	$a = FRED:: ;
+
+    Ambiguous call resolved as CORE::%s(), qualify as such or use &
+	sub time {} 
+	my $a = time()
+
+    Unrecognized escape \\%c passed through
+        $a = "\m" ;
+
+    %s number > %s non-portable
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+
+    Integer overflow in binary number
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+     
+    Mandatory Warnings
+    ------------------
+    Use of "%s" without parentheses is ambiguous	[check_uni]
+        rand + 4 
+
+    Ambiguous use of -%s resolved as -&%s() 		[yylex]
+        sub fred {} ; - fred ;
+
+    Precedence problem: open %.*s should be open(%.*s)	[yylex]
+    	open FOO || die;
+
+    Operator or semicolon missing before %c%s		[yylex]
+    Ambiguous use of %c resolved as operator %c
+        *foo *foo
+
+__END__
+# toke.c 
+use warnings 'deprecated' ;
+1 if $a EQ $b ;
+1 if $a NE $b ;
+1 if $a GT $b ;
+1 if $a LT $b ;
+1 if $a GE $b ;
+1 if $a LE $b ;
+no warnings 'deprecated' ;
+1 if $a EQ $b ;
+1 if $a NE $b ;
+1 if $a GT $b ;
+1 if $a LT $b ;
+1 if $a GE $b ;
+1 if $a LE $b ;
+EXPECT
+Use of EQ is deprecated at - line 3.
+Use of NE is deprecated at - line 4.
+Use of GT is deprecated at - line 5.
+Use of LT is deprecated at - line 6.
+Use of GE is deprecated at - line 7.
+Use of LE is deprecated at - line 8.
+########
+# toke.c
+use warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+no warnings 'deprecated' ;
+format STDOUT =
+@<<<  @|||  @>>>  @>>>
+$a    $b    "abc" 'def'
+.
+EXPECT
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+Use of comma-less variable list is deprecated at - line 5.
+########
+# toke.c
+use warnings 'deprecated' ;
+$a = <<;
+
+no warnings 'deprecated' ;
+$a = <<;
+
+EXPECT
+Use of bare << to mean <<"" is deprecated at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+s/(abc)/\1/;
+no warnings 'syntax' ;
+s/(abc)/\1/;
+EXPECT
+\1 better written as $1 at - line 3.
+########
+# toke.c
+use warnings 'semicolon' ;
+$a = 1
+&time ;
+no warnings 'semicolon' ;
+$a = 1
+&time ;
+EXPECT
+Semicolon seems to be missing at - line 3.
+########
+# toke.c
+BEGIN {
+    # Scalars leaked: due to syntax errors
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+use warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+Reversed += operator at - line 7.
+Reversed -= operator at - line 8.
+Reversed *= operator at - line 9.
+Reversed %= operator at - line 10.
+Reversed &= operator at - line 11.
+Reversed .= operator at - line 12.
+syntax error at - line 12, near "=."
+Reversed ^= operator at - line 13.
+syntax error at - line 13, near "=^"
+Reversed |= operator at - line 14.
+syntax error at - line 14, near "=|"
+Reversed <= operator at - line 15.
+Unterminated <> operator at - line 15.
+########
+# toke.c
+BEGIN {
+    # Scalars leaked: due to syntax errors
+    $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+}
+no warnings 'syntax' ;
+my $a =+ 2 ;
+$a =- 2 ;
+$a =* 2 ;
+$a =% 2 ;
+$a =& 2 ;
+$a =. 2 ;
+$a =^ 2 ;
+$a =| 2 ;
+$a =< 2 ;
+$a =/ 2 ;
+EXPECT
+syntax error at - line 12, near "=."
+syntax error at - line 13, near "=^"
+syntax error at - line 14, near "=|"
+Unterminated <> operator at - line 15.
+########
+# toke.c
+use warnings 'syntax' ;
+my $a = $a[1,2] ;
+no warnings 'syntax' ;
+my $a = $a[1,2] ;
+EXPECT
+Multidimensional syntax $a[1,2] not supported at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+sub fred {} ; $SIG{TERM} = fred;
+no warnings 'syntax' ;
+$SIG{TERM} = fred;
+EXPECT
+You need to quote "fred" at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+no warnings 'syntax' ;
+@a[3] = 2;
+@a{3} = 2;
+EXPECT
+Scalar value @a[3] better written as $a[3] at - line 3.
+Scalar value @a{3} better written as $a{3} at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+no warnings 'syntax' ;
+$_ = "ab" ; 
+s/(ab)/\1/e;
+EXPECT
+Can't use \1 to mean $1 in expression at - line 4.
+########
+# toke.c
+use warnings 'reserved' ;
+$a = abc;
+no warnings 'reserved' ;
+$a = abc;
+EXPECT
+Unquoted string "abc" may clash with future reserved word at - line 3.
+########
+# toke.c
+use warnings 'chmod' ;
+chmod 3;
+no warnings 'chmod' ;
+chmod 3;
+EXPECT
+chmod() mode argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a, b, c) ;
+no warnings 'qw' ;
+@a = qw(a, b, c) ;
+EXPECT
+Possible attempt to separate words with commas at - line 3.
+########
+# toke.c
+use warnings 'qw' ;
+@a = qw(a b #) ;
+no warnings 'qw' ;
+@a = qw(a b #) ;
+EXPECT
+Possible attempt to put comments in qw() list at - line 3.
+########
+# toke.c
+use warnings 'umask' ;
+umask 3;
+no warnings 'umask' ;
+umask 3;
+EXPECT
+umask: argument is missing initial 0 at - line 3.
+########
+# toke.c
+use warnings 'syntax' ;
+print ("")
+EXPECT
+print (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+print ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+printf ("")
+EXPECT
+printf (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+printf ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'syntax' ;
+sort ("")
+EXPECT
+sort (...) interpreted as function at - line 3.
+########
+# toke.c
+no warnings 'syntax' ;
+sort ("")
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time[2]};
+no warnings 'ambiguous' ;
+$a = ${time[2]};
+EXPECT
+Ambiguous use of ${time[...]} resolved to $time[...] at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+Ambiguous use of ${time{...}} resolved to $time{...} at - line 3.
+########
+# toke.c
+no warnings 'ambiguous' ;
+$a = ${time{2}};
+EXPECT
+
+########
+# toke.c
+use warnings 'ambiguous' ;
+$a = ${time} ;
+no warnings 'ambiguous' ;
+$a = ${time} ;
+EXPECT
+Ambiguous use of ${time} resolved to $time at - line 3.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub fred {}
+$a = ${fred} ;
+no warnings 'ambiguous' ;
+$a = ${fred} ;
+EXPECT
+Ambiguous use of ${fred} resolved to $fred at - line 4.
+########
+# toke.c
+use warnings 'syntax' ;
+$a = 1_2;
+$a = 1_2345_6;
+no warnings 'syntax' ;
+$a = 1_2;
+$a = 1_2345_6;
+EXPECT
+Misplaced _ in number at - line 3.
+Misplaced _ in number at - line 4.
+Misplaced _ in number at - line 4.
+########
+# toke.c
+use warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+no warnings 'bareword' ;
+#line 25 "bar"
+$a = FRED:: ;
+EXPECT
+Bareword "FRED::" refers to nonexistent package at bar line 25.
+########
+# toke.c
+use warnings 'ambiguous' ;
+sub time {}
+my $a = time() ;
+no warnings 'ambiguous' ;
+my $b = time() ;
+EXPECT
+Ambiguous call resolved as CORE::time(), qualify as such or use & at - line 4.
+########
+# toke.c
+use warnings ;
+eval <<'EOE';
+{
+#line 30 "foo"
+  $_ = " \x{123} " ;
+}
+EOE
+EXPECT
+
+########
+# toke.c
+my $a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 2.
+########
+# toke.c
+$^W = 0 ;
+my $a = rand + 4 ;
+{
+    no warnings 'ambiguous' ;
+    $a = rand + 4 ;
+    use warnings 'ambiguous' ;
+    $a = rand + 4 ;
+}
+$a = rand + 4 ;
+EXPECT
+Warning: Use of "rand" without parens is ambiguous at - line 3.
+Warning: Use of "rand" without parens is ambiguous at - line 8.
+Warning: Use of "rand" without parens is ambiguous at - line 10.
+########
+# toke.c
+sub fred {};
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 3.
+########
+# toke.c
+$^W = 0 ;
+sub fred {} ;
+-fred ;
+{
+    no warnings 'ambiguous' ;
+    -fred ;
+    use warnings 'ambiguous' ;
+    -fred ;
+}
+-fred ;
+EXPECT
+Ambiguous use of -fred resolved as -&fred() at - line 4.
+Ambiguous use of -fred resolved as -&fred() at - line 9.
+Ambiguous use of -fred resolved as -&fred() at - line 11.
+########
+# toke.c
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 2.
+########
+# toke.c
+$^W = 0 ;
+open FOO || time;
+{
+    no warnings 'precedence' ;
+    open FOO || time;
+    use warnings 'precedence' ;
+    open FOO || time;
+}
+open FOO || time;
+EXPECT
+Precedence problem: open FOO should be open(FOO) at - line 3.
+Precedence problem: open FOO should be open(FOO) at - line 8.
+Precedence problem: open FOO should be open(FOO) at - line 10.
+########
+# toke.c
+$^W = 0 ;
+*foo *foo ;
+{
+    no warnings 'ambiguous' ;
+    *foo *foo ;
+    use warnings 'ambiguous' ;
+    *foo *foo ;
+}
+*foo *foo ;
+EXPECT
+Operator or semicolon missing before *foo at - line 3.
+Ambiguous use of * resolved as operator * at - line 3.
+Operator or semicolon missing before *foo at - line 8.
+Ambiguous use of * resolved as operator * at - line 8.
+Operator or semicolon missing before *foo at - line 10.
+Ambiguous use of * resolved as operator * at - line 10.
+########
+# toke.c
+use warnings 'misc' ;
+my $a = "\m" ;
+no warnings 'misc' ;
+$a = "\m" ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# toke.c
+use warnings 'portable' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'portable' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+Hexadecimal number > 0xffffffff non-portable at - line 8.
+Octal number > 037777777777 non-portable at - line 11.
+########
+# toke.c
+use warnings 'overflow' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+no warnings 'overflow' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b10000000000000000000000000000000000000000000000000000000000000000 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x10000000000000000 ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  002000000000000000000000;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in hexadecimal number at - line 8.
+Integer overflow in octal number at - line 11.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/universal b/gnu/usr.bin/perl/t/pragma/warn/universal
new file mode 100644
index 00000000000..6dbb1be4e0e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/universal
@@ -0,0 +1,16 @@
+  universal.c AOK
+
+  Can't locate package %s for @%s::ISA	[S_isa_lookup]
+      
+
+
+__END__
+# universal.c [S_isa_lookup]
+use warnings 'misc' ;
+@ISA = qw(Joe) ;
+my $a = bless [] ;
+UNIVERSAL::isa $a, Jim ;
+EXPECT
+Can't locate package Joe for @main::ISA at - line 5.
+Can't locate package Joe for @main::ISA.
+Can't locate package Joe for @main::ISA.
diff --git a/gnu/usr.bin/perl/t/pragma/warn/utf8 b/gnu/usr.bin/perl/t/pragma/warn/utf8
new file mode 100644
index 00000000000..6a2fe5446c3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/utf8
@@ -0,0 +1,29 @@
+
+  utf8.c AOK
+
+     [utf8_to_uv]
+     Malformed UTF-8 character
+	my $a = ord "\x80" ;
+
+     Malformed UTF-8 character
+	my $a = ord "\xf080" ;
+     <<<<<< this warning can't be easily triggered from perl anymore
+
+     [utf16_to_utf8]
+     Malformed UTF-16 surrogate		
+     <<<<<< Add a test when somethig actually calls utf16_to_utf8
+
+__END__
+# utf8.c [utf8_to_uv] -W
+use utf8 ;
+my $a = "sn�storm" ;
+{
+    no warnings 'utf8' ;
+    my $a = "sn�storm";
+    use warnings 'utf8' ;
+    my $a = "sn�storm";
+}
+EXPECT
+Malformed UTF-8 character at - line 3.
+Malformed UTF-8 character at - line 8.
+########
diff --git a/gnu/usr.bin/perl/t/pragma/warn/util b/gnu/usr.bin/perl/t/pragma/warn/util
new file mode 100644
index 00000000000..e82d6a66171
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warn/util
@@ -0,0 +1,108 @@
+  util.c AOK
+ 
+     Illegal octal digit ignored 
+	my $a = oct "029" ;
+
+     Illegal hex digit ignored 
+	my $a = hex "0xv9" ;
+
+     Illegal binary digit ignored
+      my $a = oct "0b9" ;
+     
+     Integer overflow in binary number
+	my $a =  oct "0b111111111111111111111111111111111111111111" ;
+     Binary number > 0b11111111111111111111111111111111 non-portable
+   	$a =  oct "0b111111111111111111111111111111111" ;
+     Integer overflow in octal number
+	my $a =  oct "077777777777777777777777777777" ;
+     Octal number > 037777777777 non-portable
+   	$a =  oct "0047777777777" ;
+     Integer overflow in hexadecimal number
+	my $a =  hex "0xffffffffffffffffffff" ;
+     Hexadecimal number > 0xffffffff non-portable
+   	$a =  hex "0x1ffffffff" ;
+
+__END__
+# util.c
+use warnings 'digit' ;
+my $a = oct "029" ;
+no warnings 'digit' ;
+$a = oct "029" ;
+EXPECT
+Illegal octal digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  hex "0xv9" ;
+no warnings 'digit' ;
+$a =  hex "0xv9" ;
+EXPECT
+Illegal hexadecimal digit 'v' ignored at - line 3.
+########
+# util.c
+use warnings 'digit' ;
+my $a =  oct "0b9" ;
+no warnings 'digit' ;
+$a =  oct "0b9" ;
+EXPECT
+Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+no warnings 'overflow' ;
+$a =  oct "0b11111111111111111111111111111111111111111111111111111111111111111";
+EXPECT
+Integer overflow in binary number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  hex "0xffffffffffffffffffff" ;
+no warnings 'overflow' ;
+$a =  hex "0xffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "077777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a =  oct "077777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+no warnings 'portable' ;
+   $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+no warnings 'portable' ;
+   $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+EXPECT
+Hexadecimal number > 0xffffffff non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+no warnings 'portable' ;
+   $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+EXPECT
+Octal number > 037777777777 non-portable at - line 5.
diff --git a/gnu/usr.bin/perl/t/pragma/warnings.t b/gnu/usr.bin/perl/t/pragma/warnings.t
new file mode 100644
index 00000000000..71fb0df972e
--- /dev/null
+++ b/gnu/usr.bin/perl/t/pragma/warnings.t
@@ -0,0 +1,121 @@
+#!./perl 
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    $ENV{PERL5LIB} = '../lib';
+    require Config; import Config;
+}
+
+$| = 1;
+
+my $Is_VMS     = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $tmpfile = "tmp0000";
+my $i = 0 ;
+1 while -f ++$tmpfile;
+END {  if ($tmpfile) { 1 while unlink $tmpfile} }
+
+my @prgs = () ;
+my @w_files = () ;
+
+if (@ARGV)
+  { print "ARGV = [@ARGV]\n" ; @w_files = map { s#^#./pragma/warn/#; $_ } @ARGV }
+else
+  { @w_files = sort glob("pragma/warn/*") }
+
+foreach (@w_files) {
+
+    next if /\.orig$/ ;
+
+    next if /(~|\.orig)$/;
+
+    open F, "<$_" or die "Cannot open $_: $!\n" ;
+    while (<F>) {
+	last if /^__END__/ ;
+    }
+
+    {
+        local $/ = undef;
+        @prgs = (@prgs, split "\n########\n", <F>) ;
+    }
+    close F ;
+}
+
+undef $/;
+
+print "1..", scalar @prgs, "\n";
+ 
+ 
+for (@prgs){
+    my $switch = "";
+    my @temps = () ;
+    if (s/^\s*-\w+//){
+        $switch = $&;
+        $switch =~ s/(-\S*[A-Z]\S*)/"$1"/ if $Is_VMS; # protect uc switches
+    }
+    my($prog,$expected) = split(/\nEXPECT\n/, $_);
+    if ( $prog =~ /--FILE--/) {
+        my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
+	shift @files ;
+	die "Internal error test $i didn't split into pairs, got " . 
+		scalar(@files) . "[" . join("%%%%", @files) ."]\n"
+	    if @files % 2 ;
+	while (@files > 2) {
+	    my $filename = shift @files ;
+	    my $code = shift @files ;
+    	    push @temps, $filename ;
+	    open F, ">$filename" or die "Cannot open $filename: $!\n" ;
+	    print F $code ;
+	    close F ;
+	}
+	shift @files ;
+	$prog = shift @files ;
+    }
+    open TEST, ">$tmpfile";
+    print TEST $prog,"\n";
+    close TEST;
+    my $results = $Is_VMS ?
+                  `./perl "-I../lib" $switch $tmpfile 2>&1` :
+		  $Is_MSWin32 ?
+                  `.\\perl -I../lib $switch $tmpfile 2>&1` :
+                  `./perl -I../lib $switch $tmpfile 2>&1`;
+    my $status = $?;
+    $results =~ s/\n+$//;
+    # allow expected output to be written as if $prog is on STDIN
+    $results =~ s/tmp\d+/-/g;
+    $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
+# bison says 'parse error' instead of 'syntax error',
+# various yaccs may or may not capitalize 'syntax'.
+    $results =~ s/^(syntax|parse) error/syntax error/mig;
+    # allow all tests to run when there are leaks
+    $results =~ s/Scalars leaked: \d+\n//g;
+    $expected =~ s/\n+$//;
+    my $prefix = ($results =~ s#^PREFIX(\n|$)##) ;
+    # any special options? (OPTIONS foo bar zap)
+    my $option_regex = 0;
+    if ($expected =~ s/^OPTIONS? (.+)\n//) {
+	foreach my $option (split(' ', $1)) {
+	    if ($option eq 'regex') { # allow regular expressions
+		$option_regex = 1;
+	    } else {
+		die "$0: Unknown OPTION '$option'\n";
+	    }
+	}
+    }
+    if ( $results =~ s/^SKIPPED\n//) {
+	print "$results\n" ;
+    }
+    elsif (($prefix  && (( $option_regex && $results !~ /^$expected/) ||
+			 (!$option_regex && $results !~ /^\Q$expected/))) or
+	   (!$prefix && (( $option_regex && $results !~ /^$expected/) ||
+			 (!$option_regex && $results ne $expected)))) {
+        print STDERR "PROG: $switch\n$prog\n";
+        print STDERR "EXPECTED:\n$expected\n";
+        print STDERR "GOT:\n$results\n";
+        print "not ";
+    }
+    print "ok ", ++$i, "\n";
+    foreach (@temps) 
+	{ unlink $_ if $_ } 
+}