stock perl 5.8.0 from CPAN

42 files changed, 1787 insertions, 7742 deletions

diff --git a/gnu/usr.bin/perl/t/comp/hints.t b/gnu/usr.bin/perl/t/comp/hints.t
index 9a08854d86c..5911b77688f 100644
--- a/gnu/usr.bin/perl/t/comp/hints.t
+++ b/gnu/usr.bin/perl/t/comp/hints.t
@@ -1,285 +1,36 @@
-#!./perl
-
-# Tests the scoping of $^H and %^H
+#!./perl -w
 
-BEGIN {
-    @INC = qw(. ../lib);
-    chdir 't';
-}
-
-BEGIN { print "1..31\n"; }
+BEGIN { print "1..7\n"; }
 BEGIN {
     print "not " if exists $^H{foo};
     print "ok 1 - \$^H{foo} doesn't exist initially\n";
-    if (${^OPEN}) {
-	print "not " unless $^H & 0x00020000;
-	print "ok 2 - \$^H contains HINT_LOCALIZE_HH initially with ${^OPEN}\n";
-    } else {
-	print "not " if $^H & 0x00020000;
-	print "ok 2 - \$^H doesn't contain HINT_LOCALIZE_HH initially\n";
-    }
 }
 {
     # simulate a pragma -- don't forget HINT_LOCALIZE_HH
-    BEGIN { $^H |= 0x04020000; $^H{foo} = "a"; }
+    BEGIN { $^H |= 0x00020000; $^H{foo} = "a"; }
     BEGIN {
 	print "not " if $^H{foo} ne "a";
-	print "ok 3 - \$^H{foo} is now 'a'\n";
-	print "not " unless $^H & 0x00020000;
-	print "ok 4 - \$^H contains HINT_LOCALIZE_HH while compiling\n";
+	print "ok 2 - \$^H{foo} is now 'a'\n";
     }
     {
 	BEGIN { $^H |= 0x00020000; $^H{foo} = "b"; }
 	BEGIN {
 	    print "not " if $^H{foo} ne "b";
-	    print "ok 5 - \$^H{foo} is now 'b'\n";
+	    print "ok 3 - \$^H{foo} is now 'b'\n";
 	}
     }
     BEGIN {
 	print "not " if $^H{foo} ne "a";
-	print "ok 6 - \$^H{foo} restored to 'a'\n";
+	print "ok 4 - \$H^{foo} restored to 'a'\n";
     }
-    # The pragma settings disappear after compilation
-    # (test at CHECK-time and at run-time)
     CHECK {
 	print "not " if exists $^H{foo};
-	print "ok 9 - \$^H{foo} doesn't exist when compilation complete\n";
-	if (${^OPEN}) {
-	    print "not " unless $^H & 0x00020000;
-	    print "ok 10 - \$^H contains HINT_LOCALIZE_HH when compilation complete with ${^OPEN}\n";
-	} else {
-	    print "not " if $^H & 0x00020000;
-	    print "ok 10 - \$^H doesn't contain HINT_LOCALIZE_HH when compilation complete\n";
-	}
+	print "ok 6 - \$^H{foo} doesn't exist when compilation complete\n";
     }
     print "not " if exists $^H{foo};
-    print "ok 11 - \$^H{foo} doesn't exist at runtime\n";
-    if (${^OPEN}) {
-	print "not " unless $^H & 0x00020000;
-	print "ok 12 - \$^H contains HINT_LOCALIZE_HH at run-time with ${^OPEN}\n";
-    } else {
-	print "not " if $^H & 0x00020000;
-	print "ok 12 - \$^H doesn't contain HINT_LOCALIZE_HH at run-time\n";
-    }
-    # op_entereval should keep the pragmas it was compiled with
-    eval q*
-      BEGIN {
-	print "not " if $^H{foo} ne "a";
-	print "ok 13 - \$^H{foo} is 'a' at eval-\"\" time\n";
-	print "not " unless $^H & 0x00020000;
-	print "ok 14 - \$^H contains HINT_LOCALIZE_HH at eval\"\"-time\n";
-      }
-    *;
+    print "ok 7 - \$^H{foo} doesn't exist at runtime\n";
 }
 BEGIN {
     print "not " if exists $^H{foo};
-    print "ok 7 - \$^H{foo} doesn't exist while finishing compilation\n";
-    if (${^OPEN}) {
-	print "not " unless $^H & 0x00020000;
-	print "ok 8 - \$^H contains HINT_LOCALIZE_HH while finishing compilation with ${^OPEN}\n";
-    } else {
-	print "not " if $^H & 0x00020000;
-	print "ok 8 - \$^H doesn't contain HINT_LOCALIZE_HH while finishing compilation\n";
-    }
+    print "ok 5 - \$^H{foo} doesn't exist while finishing compilation\n";
 }
-
-{
-    BEGIN{$^H{x}=1};
-    for my $tno (15..16) {
-        eval q(
-            BEGIN {
-                print $^H{x}==1 && !$^H{y} ? "ok $tno\n" : "not ok $tno\n";
-            }
-            $^H{y} = 1;
-        );
-        if ($@) {
-            (my $str = $@)=~s/^/# /gm;
-            print "not ok $tno\n$str\n";
-        }
-    }
-}
-
-{
-    BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; }
-
-    our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; }
-    print +($ri0 & 0x04000000 ? "" : "not "), "ok 17 - \$^H correct before require\n";
-    print +($rf0 eq "z" ? "" : "not "), "ok 18 - \$^H{foo} correct before require\n";
-
-    our($ra1, $ri1, $rf1, $rfe1);
-    BEGIN { require "comp/hints.aux"; }
-    print +(!($ri1 & 0x04000000) ? "" : "not "), "ok 19 - \$^H cleared for require\n";
-    print +(!defined($rf1) && !$rfe1 ? "" : "not "), "ok 20 - \$^H{foo} cleared for require\n";
-
-    our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; }
-    print +($ri2 & 0x04000000 ? "" : "not "), "ok 21 - \$^H correct after require\n";
-    print +($rf2 eq "z" ? "" : "not "), "ok 22 - \$^H{foo} correct after require\n";
-}
-
-# [perl #73174]
-
-{
-    my $res;
-    BEGIN { $^H{73174} = "foo" }
-    BEGIN { $res = ($^H{73174} // "") }
-    "" =~ /\x{100}/i;	# forces loading of utf8.pm, which used to reset %^H
-    BEGIN { $res .= '-' . ($^H{73174} // "")}
-    $res .= '-' . ($^H{73174} // "");
-    print $res eq "foo-foo-" ? "" : "not ",
-	"ok 23 - \$^H{foo} correct after /unicode/i (res=$res)\n";
-}
-
-# [perl #106282] Crash when tying %^H
-# Tying %^H should not result in a crash when the hint hash is cloned.
-# Hints should also be copied properly to inner scopes.  See also
-# [rt.cpan.org #73402].
-eval q`
-    # Do something naughty enough, and you get your module mentioned in the
-    # test suite. :-)
-    package namespace::clean::_TieHintHash;
-
-    sub TIEHASH  { bless[] }
-    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
-    sub FETCH    { $_[0][0]{$_[1]} }
-    sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
-    sub NEXTKEY  { each %{$_[0][0]} }
-
-    package main;
-
-    BEGIN {
-	$^H{foo} = "bar"; # activate localisation magic
-	tie( %^H, 'namespace::clean::_TieHintHash' ); # sabotage %^H
-	$^H{foo} = "bar"; # create an element in the tied hash
-    }
-    { # clone the tied hint hash on scope entry
-	BEGIN {
-	    print "not " x ($^H{foo} ne 'bar'),
-		  "ok 24 - tied hint hash is copied to inner scope\n";
-	    %^H = ();
-	    tie( %^H, 'namespace::clean::_TieHintHash' );
-	    $^H{foo} = "bar";
-	}
-	{
-	    BEGIN{
-		print
-		  "not " x ($^H{foo} ne 'bar'),
-		  "ok 25 - tied empty hint hash is copied to inner scope\n"
-	    }    
-	}
-	1;
-    }
-    1;
-` or warn $@;
-print "ok 26 - no crash when cloning a tied hint hash\n";
-
-{
-    my $w;
-    local $SIG{__WARN__} = sub { $w = shift };
-    eval q`
-	package namespace::clean::_TieHintHasi;
-    
-	sub TIEHASH  { bless[] }
-	sub STORE    { $_[0][0]{$_[1]} = $_[2] }
-	sub FETCH    { $_[0][0]{$_[1]} }
-	sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} }
-      # Intentionally commented out:
-      #  sub NEXTKEY  { each %{$_[0][0]} }
-    
-	package main;
-    
-	BEGIN {
-    	    $^H{foo} = "bar"; # activate localisation magic
-    	    tie( %^H, 'namespace::clean::_TieHintHasi' ); # sabotage %^H
-    	    $^H{foo} = "bar"; # create an element in the tied hash
-	}
-	{ ; } # clone the tied hint hash
-    `;
-    print "not " if $w;
-    print "ok 27 - double-freeing explosive tied hints hash\n";
-    print "# got: $w" if $w;
-}
-
-# Setting ${^WARNING_HINTS} to its own value should not change things.
-{
-    my $w;
-    local $SIG{__WARN__} = sub { $w++ };
-    BEGIN {
-	# should have no effect:
-	my $x = ${^WARNING_BITS};
-	${^WARNING_BITS} = $x;
-    }
-    {
-	local $^W = 1;
-	() = 1 + undef;
-    }
-    print "# ", $w//'no', " warnings\nnot " unless $w == 1;
-    print "ok 28 - ",
-          "setting \${^WARNING_BITS} to its own value has no effect\n";
-}
-
-# [perl #112326]
-# this code could cause a crash, due to PL_hints continuing to point to th
-# hints hash currently being freed
-
-{
-    package Foo;
-    my @h = qw(a 1 b 2);
-    BEGIN {
-	$^H{FOO} = bless {};
-    }
-    sub DESTROY {
-	@h = %^H;
-	delete $INC{strict}; require strict; # boom!
-    }
-    my $h = join ':', %h;
-    # this isn't the main point of the test; the main point is that
-    # it doesn't crash!
-    print "not " if $h ne '';
-    print "ok 29 - #112326\n";
-}
-
-
-# [perl #112444]
-# A destructor called while %^H is freed should not be able to stop %^H
-# from being magical (due to *^H{HASH} being undef).
-{
-    BEGIN {
-	# Make sure %^H is clear and not localised, to begin with
-	%^H = ();
-	$^H = 0;
-    }
-    DESTROY { %^H }
-    {
-	{
-	    BEGIN {
-		$^H{foom} = bless[];
-	    }
-	} # scope exit triggers destructor, which autovivifies a non-
-	  # magical %^H
-	BEGIN {
-	    # Here we have the %^H created by DESTROY, which is
-	    # not localised
-	    $^H{112444} = 'baz';
-	}
-    } # %^H leaks on scope exit
-    BEGIN { @keez = keys %^H }
-}
-print "not " if @keez;
-print "ok 30 - %^H does not leak when autovivified in destructor\n";
-print "# keys are: @keez\n" if @keez;
-
-
-# Add new tests above this require, in case it fails.
-require './test.pl';
-
-# bug #27040: hints hash was being double-freed
-my $result = runperl(
-    prog => '$^H |= 0x20000; eval q{BEGIN { $^H |= 0x20000 }}',
-    stderr => 1
-);
-print "not " if length $result;
-print "ok 31 - double-freeing hints hash\n";
-print "# got: $result\n" if length $result;
-
-__END__
-# Add new tests above require 'test.pl'
diff --git a/gnu/usr.bin/perl/t/io/crlf.t b/gnu/usr.bin/perl/t/io/crlf.t
index f26ea0d85eb..08ab4fe3b09 100644
--- a/gnu/usr.bin/perl/t/io/crlf.t
+++ b/gnu/usr.bin/perl/t/io/crlf.t
@@ -3,92 +3,42 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = qw(. ../lib);
-    require "test.pl";
-    skip_all_without_perlio();
 }
 
 use Config;
 
+require "test.pl";
 
-my $file = tempfile();
-
-my $ungetc_count = 8200;    # Somewhat over the likely buffer size
-
-{
-    plan(tests => 16 + 2 * $ungetc_count);
-    ok(open(FOO,">:crlf",$file));
-    ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO));
-    ok(open(FOO,"<:crlf",$file));
-
-    my $text;
-    { local $/; $text = <FOO> }
-    is(count_chars($text, "\015\012"), 0);
-    is(count_chars($text, "\n"), 2000);
-
-    binmode(FOO);
-    seek(FOO,0,0);
-    { local $/; $text = <FOO> }
-    is(count_chars($text, "\015\012"), 2000);
-
-    SKIP:
-    {
-	skip_if_miniperl("miniperl can't rely on loading PerlIO::scalar",
-			  2 * $ungetc_count + 1);
-	skip("no PerlIO::scalar", 2 * $ungetc_count + 1)
-	    unless $Config{extensions} =~ m!\bPerlIO/scalar\b!;
-	require PerlIO::scalar;
-	my $fcontents = join "", map {"$_\015\012"} "a".."zzz";
-	open my $fh, "<:crlf", \$fcontents;
-	local $/ = "xxx";
-	local $_ = <$fh>;
-	my $pos = tell $fh; # pos must be behind "xxx", before "\nxxy\n"
-	seek $fh, $pos, 0;
-	$/ = "\n";
-	$s = <$fh>.<$fh>;
-	is($s, "\nxxy\n");
+my $file = "crlf$$.dat";
+END {
+ unlink($file);
+}
 
-        for my $i (0 .. $ungetc_count - 1) {
-            my $j = $i % 256;
-            is($fh->ungetc($j), $j, "ungetc of $j returns itself");
-        }
+if (find PerlIO::Layer 'perlio') {
+ plan(tests => 7);
+ ok(open(FOO,">:crlf",$file));
+ ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO));
+ ok(open(FOO,"<:crlf",$file));
 
-        for (my $i = $ungetc_count - 1; $i >= 0; $i--) {
-            my $j = $i % 256;
-            is(ord($fh->getc()), $j, "getc gets back $j");
-        }
-    }
+ my $text;
+ { local $/; $text = <FOO> }
+ is(count_chars($text, "\015\012"), 0);
+ is(count_chars($text, "\n"), 2000);
 
-    ok(close(FOO));
+ binmode(FOO);
+ seek(FOO,0,0);
+ { local $/; $text = <FOO> }
+ is(count_chars($text, "\015\012"), 2000);
 
-    # binmode :crlf should not cumulate.
-    # Try it first once and then twice so that even UNIXy boxes
-    # get to exercise this, for DOSish boxes even once is enough.
-    # Try also pushing :utf8 first so that there are other layers
-    # in between (this should not matter: CRLF layers still should
-    # not accumulate).
-    for my $utf8 ('', ':utf8') {
-	for my $binmode (1..2) {
-	    open(FOO, ">$file");
-	    # require PerlIO; print PerlIO::get_layers(FOO), "\n";
-	    binmode(FOO, "$utf8:crlf") for 1..$binmode;
-	    # require PerlIO; print PerlIO::get_layers(FOO), "\n";
-	    print FOO "Hello\n";
-	    close FOO;
-	    open(FOO, "<$file");
-	    binmode(FOO);
-	    my $foo = scalar <FOO>;
-	    close FOO;
-	    print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)),
-	    "\n";
-	    like($foo, qr/\x0d\x0a$/);
-	    unlike($foo, qr/\x0d\x0d/);
-	}
-    }
+ ok(close(FOO));
+}
+else {
+ skip_all("No perlio, so no :crlf");
 }
 
 sub count_chars {
-    my($text, $chars) = @_;
-    my $seen = 0;
-    $seen++ while $text =~ /$chars/g;
-    return $seen;
+  my($text, $chars) = @_;
+  my $seen = 0;
+  $seen++ while $text =~ /$chars/g;
+  return $seen;
 }
diff --git a/gnu/usr.bin/perl/t/io/utf8.t b/gnu/usr.bin/perl/t/io/utf8.t
index acce07e900d..e1ecf1c4336 100644
--- a/gnu/usr.bin/perl/t/io/utf8.t
+++ b/gnu/usr.bin/perl/t/io/utf8.t
@@ -3,121 +3,144 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
-    skip_all_without_perlio();
+    unless (find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: not perlio\n";
+	exit 0;
+    }
 }
 
 no utf8; # needed for use utf8 not griping about the raw octets
 
-
-plan(tests => 63);
-
 $| = 1;
+print "1..31\n";
 
-my $a_file = tempfile();
-
-open(F,"+>:utf8",$a_file);
+open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
-cmp_ok( tell(F), '==', 4, tell(F) );
+print '#'.tell(F)."\n";
+print "not " unless tell(F) == 4;
+print "ok 1\n";
 print F "\n";
-cmp_ok( tell(F), '>=', 5, tell(F) );
+print '#'.tell(F)."\n";
+print "not " unless tell(F) >= 5;
+print "ok 2\n";
 seek(F,0,0);
-is( getc(F), chr(0x100) );
-is( getc(F), "£" );
-is( getc(F), "\n" );
+print "not " unless getc(F) eq chr(0x100);
+print "ok 3\n";
+print "not " unless getc(F) eq "£";
+print "ok 4\n";
+print "not " unless getc(F) eq "\n";
+print "ok 5\n";
 seek(F,0,0);
 binmode(F,":bytes");
 my $chr = chr(0xc4);
-if (ord($a_file) == 193) { $chr = chr(0x8c); } # EBCDIC
-is( getc(F), $chr );
+if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC
+print "not " unless getc(F) eq $chr;
+print "ok 6\n";
 $chr = chr(0x80);
-if (ord($a_file) == 193) { $chr = chr(0x41); } # EBCDIC
-is( getc(F), $chr );
+if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC
+print "not " unless getc(F) eq $chr;
+print "ok 7\n";
 $chr = chr(0xc2);
-if (ord($a_file) == 193) { $chr = chr(0x80); } # EBCDIC
-is( getc(F), $chr );
+if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC
+print "not " unless getc(F) eq $chr;
+print "ok 8\n";
 $chr = chr(0xa3);
-if (ord($a_file) == 193) { $chr = chr(0x44); } # EBCDIC
-is( getc(F), $chr );
-is( getc(F), "\n" );
+if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC
+print "not " unless getc(F) eq $chr;
+print "ok 9\n";
+print "not " unless getc(F) eq "\n";
+print "ok 10\n";
 seek(F,0,0);
 binmode(F,":utf8");
-is( scalar(<F>), "\x{100}£\n" );
+print "not " unless scalar(<F>) eq "\x{100}£\n";
+print "ok 11\n";
 seek(F,0,0);
 $buf = chr(0x200);
 $count = read(F,$buf,2,1);
-cmp_ok( $count, '==', 2 );
-is( $buf, "\x{200}\x{100}£" );
+print "not " unless $count == 2;
+print "ok 12\n";
+print "not " unless $buf eq "\x{200}\x{100}£";
+print "ok 13\n";
 close(F);
 
 {
     $a = chr(300); # This *is* UTF-encoded
     $b = chr(130); # This is not.
 
-    open F, ">:utf8", $a_file or die $!;
+    open F, ">:utf8", 'a' or die $!;
     print F $a,"\n";
     close F;
 
-    open F, "<:utf8", $a_file or die $!;
+    open F, "<:utf8", 'a' or die $!;
     $x = <F>;
     chomp($x);
-    is( $x, chr(300) );
+    print "not " unless $x eq chr(300);
+    print "ok 14\n";
 
-    open F, $a_file or die $!; # Not UTF
+    open F, "a" or die $!; # Not UTF
     binmode(F, ":bytes");
     $x = <F>;
     chomp($x);
     $chr = chr(196).chr(172);
-    if (ord($a_file) == 193) { $chr = chr(141).chr(83); } # EBCDIC
-    is( $x, $chr );
+    if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC
+    print "not " unless $x eq $chr;
+    print "ok 15\n";
     close F;
 
-    open F, ">:utf8", $a_file or die $!;
+    open F, ">:utf8", 'a' or die $!;
     binmode(F);  # we write a "\n" and then tell() - avoid CRLF issues.
     binmode(F,":utf8"); # turn UTF-8-ness back on
     print F $a;
     my $y;
     { my $x = tell(F);
       { use bytes; $y = length($a);}
-      cmp_ok( $x, '==', $y );
+      print "not " unless $x == $y;
+      print "ok 16\n";
   }
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	cmp_ok( $y, '==', 1 );
+	print "not " unless $y == 1;
+	print "ok 17\n";
     }
 
     print F $b,"\n"; # Don't upgrades $b
 
     { # Check byte length of $b
 	use bytes; my $y = length($b);
-	cmp_ok( $y, '==', 1 );
+	print "not ($y) " unless $y == 1;
+	print "ok 18\n";
     }
 
     {
 	my $x = tell(F);
 	{ use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII
-	cmp_ok( $x, '==', $y );
+	print "not ($x,$y) " unless $x == $y;
+	print "ok 19\n";
     }
 
     close F;
 
-    open F, $a_file or die $!; # Not UTF
+    open F, "a" or die $!; # Not UTF
     binmode(F, ":bytes");
     $x = <F>;
     chomp($x);
     $chr = v196.172.194.130;
     if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-    is( $x, $chr, sprintf('(%vd)', $x) );
+    printf "not (%vd) ", $x unless $x eq $chr;
+    print "ok 20\n";
 
-    open F, "<:utf8", $a_file or die $!;
+    open F, "<:utf8", "a" or die $!;
     $x = <F>;
     chomp($x);
     close F;
-    is( $x, chr(300).chr(130), sprintf('(%vd)', $x) );
+    printf "not (%vd) ", $x unless $x eq chr(300).chr(130);
+    print "ok 21\n";
 
-    open F, ">", $a_file or die $!;
-    binmode(F, ":bytes:");
+    open F, ">", "a" or die $!;
+    if (${^OPEN} =~ /:utf8/) {
+        binmode(F, ":bytes:");
+    }
 
     # Now let's make it suffer.
     my $w;
@@ -125,63 +148,54 @@ close(F);
 	use warnings 'utf8';
 	local $SIG{__WARN__} = sub { $w = $_[0] };
 	print F $a;
-        ok( (!$@));
-	like($w, qr/Wide character in print/i );
+	print "not " if ($@ || $w !~ /Wide character in print/i);
     }
+    print "ok 22\n";
 }
 
 # Hm. Time to get more evil.
-open F, ">:utf8", $a_file or die $!;
+open F, ">:utf8", "a" or die $!;
 print F $a;
 binmode(F, ":bytes");
 print F chr(130)."\n";
 close F;
 
-open F, "<", $a_file or die $!;
+open F, "<", "a" or die $!;
 binmode(F, ":bytes");
 $x = <F>; chomp $x;
 $chr = v196.172.130;
 if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC
-is( $x, $chr );
+print "not " unless $x eq $chr;
+print "ok 23\n";
 
 # Right.
-open F, ">:utf8", $a_file or die $!;
+open F, ">:utf8", "a" or die $!;
 print F $a;
 close F;
-open F, ">>", $a_file or die $!;
-binmode(F, ":bytes");
+open F, ">>", "a" or die $!;
 print F chr(130)."\n";
 close F;
 
-open F, "<", $a_file or die $!;
-binmode(F, ":bytes");
+open F, "<", "a" or die $!;
 $x = <F>; chomp $x;
-SKIP: {
-    skip("Defaulting to UTF-8 output means that we can't generate a mangled file")
-	if $UTF8_OUTPUT;
-    is( $x, $chr );
-}
+print "not " unless $x eq $chr;
+print "ok 24\n";
 
 # Now we have a deformed file.
 
-SKIP: {
-    if (ord('A') == 193) {
-	skip("EBCDIC doesn't complain", 2);
-    } else {
-	my @warnings;
-	open F, "<:utf8", $a_file or die $!;
-	$x = <F>; chomp $x;
-	local $SIG{__WARN__} = sub { push @warnings, $_[0]; };
-	eval { sprintf "%vd\n", $x };
-	is (scalar @warnings, 1);
-	like ($warnings[0], qr/Malformed UTF-8 character \(unexpected continuation byte 0x82, with no preceding start byte/);
-    }
+if (ord('A') == 193) {
+    print "ok 25 # Skip: EBCDIC\n"; # EBCDIC doesn't complain
+} else {
+    open F, "<:utf8", "a" or die $!;
+    $x = <F>; chomp $x;
+    local $SIG{__WARN__} = sub { print "ok 25\n" };
+    eval { sprintf "%vd\n", $x };
 }
 
 close F;
-unlink($a_file);
+unlink('a');
 
-open F, ">:utf8", $a_file;
+open F, ">:utf8", "a";
 @a = map { chr(1 << ($_ << 2)) } 0..5; # 0x1, 0x10, .., 0x100000
 unshift @a, chr(0); # ... and a null byte in front just for fun
 print F @a;
@@ -190,9 +204,8 @@ close F;
 my $c;
 
 # read() should work on characters, not bytes
-open F, "<:utf8", $a_file;
+open F, "<:utf8", "a";
 $a = 0;
-my $failed;
 for (@a) {
     unless (($c = read(F, $b, 1) == 1)  &&
             length($b)           == 1  &&
@@ -205,12 +218,12 @@ for (@a) {
         print '# tell(F)           == ', tell(F), "\n";
         print '# $a                == ', $a, "\n";
         print '# $c                == ', $c, "\n";
-	$failed++;
+        print "not ";
         last;
     }
 }
 close F;
-is($failed, undef);
+print "ok 26\n";
 
 {
     # Check that warnings are on on I/O, and that they can be muffled.
@@ -218,184 +231,52 @@ is($failed, undef);
     local $SIG{__WARN__} = sub { $@ = shift };
 
     undef $@;
-    open F, ">$a_file";
+    open F, ">a";
     binmode(F, ":bytes");
     print F chr(0x100);
     close(F);
 
-    like( $@, 'Wide character in print' );
+    print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n";
 
     undef $@;
-    open F, ">:utf8", $a_file;
+    open F, ">:utf8", "a";
     print F chr(0x100);
     close(F);
 
-    isnt( defined $@, !0 );
+    print defined $@ ? "not ok 28\n" : "ok 28\n";
 
     undef $@;
-    open F, ">$a_file";
+    open F, ">a";
     binmode(F, ":utf8");
     print F chr(0x100);
     close(F);
 
-    isnt( defined $@, !0 );
+    print defined $@ ? "not ok 29\n" : "ok 29\n";
 
     no warnings 'utf8';
 
     undef $@;
-    open F, ">$a_file";
+    open F, ">a";
     print F chr(0x100);
     close(F);
 
-    isnt( defined $@, !0 );
+    print defined $@ ? "not ok 30\n" : "ok 30\n";
 
     use warnings 'utf8';
 
     undef $@;
-    open F, ">$a_file";
+    open F, ">a";
     binmode(F, ":bytes");
     print F chr(0x100);
     close(F);
 
-    like( $@, 'Wide character in print' );
-}
-
-{
-    open F, ">:bytes",$a_file; print F "\xde"; close F;
-
-    open F, "<:bytes", $a_file;
-    my $b = chr 0x100;
-    $b .= <F>;
-    is( $b, chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" );
-    close F;
-}
-
-{
-    open F, ">:utf8",$a_file; print F chr 0x100; close F;
-
-    open F, "<:utf8", $a_file;
-    my $b = "\xde";
-    $b .= <F>;
-    is( $b, chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" );
-    close F;
-}
-
-{
-    my @a = ( [ 0x007F, "bytes" ],
-	      [ 0x0080, "bytes" ],
-	      [ 0x0080, "utf8"  ],
-	      [ 0x0100, "utf8"  ] );
-    my $t = 34;
-    for my $u (@a) {
-	for my $v (@a) {
-	    # print "# @$u - @$v\n";
-	    open F, ">$a_file";
-	    binmode(F, ":" . $u->[1]);
-	    print F chr($u->[0]);
-	    close F;
-
-	    open F, "<$a_file";
-	    binmode(F, ":" . $u->[1]);
-
-	    my $s = chr($v->[0]);
-	    utf8::upgrade($s) if $v->[1] eq "utf8";
-
-	    $s .= <F>;
-	    is( $s, chr($v->[0]) . chr($u->[0]), 'rcatline utf8' );
-	    close F;
-	    $t++;
-	}
-    }
-    # last test here 49
-}
-
-{
-    # [perl #23428] Somethings rotten in unicode semantics
-    open F, ">$a_file";
-    binmode F, ":utf8";
-    syswrite(F, $a = chr(0x100));
-    close F;
-    is( ord($a), 0x100, '23428 syswrite should not downgrade scalar' );
-    like( $a, qr/^\w+/, '23428 syswrite should not downgrade scalar' );
+    print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
 }
 
-# sysread() and syswrite() tested in lib/open.t since Fcntl is used
+# sysread() and syswrite() tested in lib/open.t since Fnctl is used
 
-{
-    # <FH> on a :utf8 stream should complain immediately with -w
-    # if it finds bad UTF-8 (:encoding(utf8) works this way)
-    use warnings 'utf8';
-    undef $@;
-    local $SIG{__WARN__} = sub { $@ = shift };
-    open F, ">$a_file";
-    binmode F;
-    my ($chrE4, $chrF6) = (chr(0xE4), chr(0xF6));
-    if (ord('A') == 193)	# EBCDIC
-    { ($chrE4, $chrF6) = (chr(0x43), chr(0xEC)); }
-    print F "foo", $chrE4, "\n";
-    print F "foo", $chrF6, "\n";
-    close F;
-    open F, "<:utf8", $a_file;
-    undef $@;
-    my $line = <F>;
-    my ($chrE4, $chrF6) = ("E4", "F6");
-    if (ord('A') == 193) { ($chrE4, $chrF6) = ("43", "EC"); } # EBCDIC
-    like( $@, qr/utf8 "\\x$chrE4" does not map to Unicode .+ <F> line 1/,
-	  "<:utf8 readline must warn about bad utf8");
-    undef $@;
-    $line .= <F>;
-    like( $@, qr/utf8 "\\x$chrF6" does not map to Unicode .+ <F> line 2/,
-	  "<:utf8 rcatline must warn about bad utf8");
-    close F;
+END {
+    1 while unlink "a";
+    1 while unlink "b";
 }
 
-{
-    # fixed record reads
-    open F, ">:utf8", $a_file;
-    print F "foo\xE4";
-    print F "bar\xFE";
-    print F "\xC0\xC8\xCC\xD2";
-    print F "a\xE4ab";
-    print F "a\xE4a";
-    close F;
-    open F, "<:utf8", $a_file;
-    local $/ = \4;
-    my $line = <F>;
-    is($line, "foo\xE4", "readline with \$/ = \\4");
-    $line .= <F>;
-    is($line, "foo\xE4bar\xFE", "rcatline with \$/ = \\4");
-    $line = <F>;
-    is($line, "\xC0\xC8\xCC\xD2", "readline with several encoded characters");
-    $line = <F>;
-    is($line, "a\xE4ab", "readline with another boundary condition");
-    $line = <F>;
-    is($line, "a\xE4a", "readline with boundary condition");
-    close F;
-
-    # badly encoded at EOF
-    open F, ">:raw", $a_file;
-    print F "foo\xEF\xAC"; # truncated \x{FB04} small ligature ffl
-    close F;
-
-    use warnings 'utf8';
-    open F, "<:utf8", $a_file;
-    undef $@;
-    local $SIG{__WARN__} = sub { $@ = shift };
-    $line = <F>;
-
-    like( $@, qr/utf8 "\\xEF" does not map to Unicode .+ <F> chunk 1/,
-	  "<:utf8 readline (fixed) must warn about bad utf8");
-    close F;
-}
-
-# getc should reset the utf8 flag and not be affected by previous
-# return values
-SKIP: {
-    skip "no PerlIO::scalar on miniperl", 2, if is_miniperl();
-    open my $fh, "<:raw",  \($buf = chr 255);
-    open my $uh, "<:utf8", \($uuf = "\xc4\x80");
-    for([$uh,chr 256], [$fh,chr 255]) {
-	is getc $$_[0], $$_[1],
-	  'getc returning non-utf8 after utf8';
-    }
-}
diff --git a/gnu/usr.bin/perl/t/lib/1_compile.t b/gnu/usr.bin/perl/t/lib/1_compile.t
index 2802ae2ad64..45631dd5b8d 100644
--- a/gnu/usr.bin/perl/t/lib/1_compile.t
+++ b/gnu/usr.bin/perl/t/lib/1_compile.t
@@ -7,9 +7,9 @@
 BEGIN {
     chdir 't';
     @INC = '../lib';
-    require './test.pl';
 }
 
+use strict;
 use warnings;
 use File::Spec::Functions;
 
@@ -19,6 +19,7 @@ my @Core_Modules = grep /\S/, <DATA>;
 chomp @Core_Modules;
 
 if (eval { require Socket }) {
+  push @Core_Modules, qw(Net::Domain);
   # Two Net:: modules need the Convert::EBCDIC if in EBDCIC.
   if (ord("A") != 193 || eval { require Convert::EBCDIC }) {
       push @Core_Modules, qw(Net::Cmd Net::POP3);
@@ -27,22 +28,24 @@ if (eval { require Socket }) {
 
 @Core_Modules = sort @Core_Modules;
 
-plan tests => 1+@Core_Modules;
+print "1..".(1+@Core_Modules)."\n";
 
-cmp_ok(@Core_Modules, '>', 0, "All modules should have tests");
-note("http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-04/msg01223.html");
-note("20010421230349.P2946\@blackrider.blackstar.co.uk");
+my $message
+  = "ok 1 - All modules should have tests # TODO Make Schwern Poorer\n";
+if (@Core_Modules) {
+  print "not $message";
+} else {
+  print $message;
+}
+
+my $test_num = 2;
 
 foreach my $module (@Core_Modules) {
-    if ($module eq 'ByteLoader' && $^O eq 'VMS') {
-        TODO: {
-            local $TODO = "$module needs porting on $^O";
-            ok(compile_module($module), "compile $module");
-        }
-    }
-    else {
-        ok(compile_module($module), "compile $module");
-    }
+    my $todo = '';
+    $todo = "# TODO $module needs porting on $^O" if $module eq 'ByteLoader' && $^O eq 'VMS';
+    print "# $module compile failed\nnot " unless compile_module($module);
+    print "ok $test_num $todo\n";
+    $test_num++;
 }
 
 # We do this as a separate process else we'll blow the hell
@@ -54,11 +57,25 @@ sub compile_module {
     my $lib     = '-I' . catdir(updir(), 'lib');
 
     my $out = scalar `$^X $lib $compmod $module`;
+    print "# $out";
     return $out =~ /^ok/;
 }
 
 # These modules have no tests of their own.
 # Keep up to date with
-# http://perl-qa.hexten.net/wiki/index.php/Untested_Core_Modules
+# http://www.pobox.com/~schwern/cgi-bin/perl-qa-wiki.cgi?UntestedModules
 # and vice-versa.  The list should only shrink.
 __DATA__
+B::C
+B::CC
+B::Stackobj
+ByteLoader
+CPAN
+CPAN::FirstTime
+DynaLoader
+ExtUtils::MM_NW5
+ExtUtils::Install
+ExtUtils::Liblist
+ExtUtils::Mksymlists
+Pod::Plainer
+Test::Harness::Iterator
diff --git a/gnu/usr.bin/perl/t/lib/strict/refs b/gnu/usr.bin/perl/t/lib/strict/refs
index e74851220e7..10599b0bb28 100644
--- a/gnu/usr.bin/perl/t/lib/strict/refs
+++ b/gnu/usr.bin/perl/t/lib/strict/refs
@@ -19,37 +19,6 @@ EXPECT
 
 # strict refs - error
 use strict ;
-my $str="A::Really::Big::Package::Name::To::Use"; 
-$str->{foo}= 1;
-EXPECT
-Can't use string ("A::Really::Big::Package::Name::T"...) as a HASH ref while "strict refs" in use at - line 5.
-########
-
-# strict refs - error
-use strict ;
-"A::Really::Big::Package::Name::To::Use" =~ /(.*)/; 
-${$1};
-EXPECT
-Can't use string ("A::Really::Big::Package::Name::T"...) as a SCALAR ref while "strict refs" in use at - line 5.
-########
-
-# strict refs - error
-use strict ;
-*{"A::Really::Big::Package::Name::To::Use"; }
-EXPECT
-Can't use string ("A::Really::Big::Package::Name::T"...) as a symbol ref while "strict refs" in use at - line 4.
-########
-
-# strict refs - error
-use strict ;
-"A::Really::Big::Package::Name::To::Use" =~ /(.*)/;
-*{$1}
-EXPECT
-Can't use string ("A::Really::Big::Package::Name::T"...) as a symbol ref while "strict refs" in use at - line 5.
-########
-
-# strict refs - error
-use strict ;
 my $fred ;
 my $a = ${"fred"} ;
 EXPECT
@@ -326,48 +295,3 @@ eval '
 my $a = ${"Fred"} ;
 EXPECT
 Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8.
-########
-# [perl #26910] hints not propagated into (?{...})
-use strict 'refs';
-/(?{${"foo"}++})/;
-EXPECT
-Can't use string ("foo") as a SCALAR ref while "strict refs" in use at - line 3.
-########
-# [perl #37886] strict 'refs' doesn't apply inside defined
-use strict 'refs';
-my $x = "foo";
-defined $$x;
-EXPECT
-Can't use string ("foo") as a SCALAR ref while "strict refs" in use at - line 4.
-########
-# [perl #37886] strict 'refs' doesn't apply inside defined
-use strict 'refs';
-my $x = "foo";
-defined @$x;
-EXPECT
-defined(@array) is deprecated at - line 4.
-	(Maybe you should just omit the defined()?)
-Can't use string ("foo") as an ARRAY ref while "strict refs" in use at - line 4.
-########
-# [perl #37886] strict 'refs' doesn't apply inside defined
-use strict 'refs';
-my $x = "foo";
-defined %$x;
-EXPECT
-defined(%hash) is deprecated at - line 4.
-	(Maybe you should just omit the defined()?)
-Can't use string ("foo") as a HASH ref while "strict refs" in use at - line 4.
-########
-# [perl #74168] Assertion failed: (SvTYPE(_svcur) >= SVt_PV), function Perl_softref2xv, file pp.c, line 240.
-use strict 'refs';
-my $o = 1 ; $o->{1} ;
-EXPECT
-Can't use string ("1") as a HASH ref while "strict refs" in use at - line 3.
-########
-# pp_hot.c [pp_entersub]
-use strict 'refs';
-use utf8;
-use open qw( :utf8 :std );
-&{"Ｆ"};
-EXPECT
-Can't use string ("Ｆ") as a subroutine ref while "strict refs" in use at - line 5.
diff --git a/gnu/usr.bin/perl/t/lib/strict/subs b/gnu/usr.bin/perl/t/lib/strict/subs
index 5fd0b03de7f..4a90809020f 100644
--- a/gnu/usr.bin/perl/t/lib/strict/subs
+++ b/gnu/usr.bin/perl/t/lib/strict/subs
@@ -45,8 +45,8 @@ Execution of - aborted due to compilation errors.
 use strict 'subs' ;
 my @a = (A..Z);
 EXPECT
-Bareword "A" not allowed while "strict subs" in use at - line 4.
 Bareword "Z" not allowed while "strict subs" in use at - line 4.
+Bareword "A" not allowed while "strict subs" in use at - line 4.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -54,8 +54,8 @@ Execution of - aborted due to compilation errors.
 use strict 'subs' ;
 my $a = (B..Y);
 EXPECT
-Bareword "B" not allowed while "strict subs" in use at - line 4.
 Bareword "Y" not allowed while "strict subs" in use at - line 4.
+Bareword "B" not allowed while "strict subs" in use at - line 4.
 Execution of - aborted due to compilation errors.
 ########
 
@@ -345,116 +345,3 @@ print "$abc\n";
 EXPECT
 Bareword "XYZ" not allowed while "strict subs" in use at - line 5.
 Execution of - aborted due to compilation errors.
-########
-
-# [perl #10021]
-use strict;
-use warnings;
-print "" if BAREWORD;
-EXPECT
-Bareword "BAREWORD" not allowed while "strict subs" in use at - line 5.
-Execution of - aborted due to compilation errors.
-########
-# Ticket: 18927
-use strict 'subs';
-print 1..1, bad;
-EXPECT
-Bareword "bad" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-eval q{ use strict; no strict refs; };
-print $@;
-EXPECT
-Bareword "refs" not allowed while "strict subs" in use at (eval 1) line 1.
-########
-# [perl #25147] 
-use strict;
-print "" if BAREWORD;
-EXPECT
-Bareword "BAREWORD" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-# [perl #26910] hints not propagated into (?{...})
-use strict 'subs';
-qr/(?{my $x=foo})/;
-EXPECT
-Bareword "foo" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-# Regexp compilation errors weren't UTF-8 clean
-use strict 'subs';
-use utf8;
-use open qw( :utf8 :std );
-qr/(?{my $x=fòò})/;
-EXPECT
-Bareword "fòò" not allowed while "strict subs" in use at - line 5.
-Execution of - aborted due to compilation errors.
-########
-#  [perl #27628] strict 'subs' didn't warn on bareword array index
-use strict 'subs';
-my $x=$a[FOO];
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-use strict 'subs';
-my @a;my $x=$a[FOO];
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 2.
-Execution of - aborted due to compilation errors.
-########
-# [perl #53806] No complain about bareword
-use strict 'subs';
-print FOO . "\n";
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
-########
-# [perl #53806] No complain about bareword
-use strict 'subs';
-$ENV{PATH} = "";
-system(FOO . "\n");
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 4.
-Execution of - aborted due to compilation errors.
-########
-use strict 'subs';
-my @players;
-eval { @players = sort(_rankCompare @players) };
-sub _rankCompare2 { }
-@players = sort(_rankCompare2 @players);
-EXPECT
-
-########
-use strict;
-readline(FOO);
-EXPECT
-
-########
-use strict 'subs';
-sub sayfoo { print "foo:@_\n" ; "ret\n" }
-print sayfoo "bar";
-print sayfoo . "bar\n";
-EXPECT
-foo:bar
-ret
-foo:
-ret
-bar
-########
-# infinite loop breaks some strict checking
-use strict 'subs';
-sub foo {
-    1 while 1;
-    kill FOO, 1;
-}
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 5.
-Execution of - aborted due to compilation errors.
-########
-# make sure checks are done within (?{})
-use strict 'subs';
-/(?{FOO})/
-EXPECT
-Bareword "FOO" not allowed while "strict subs" in use at - line 3.
-Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/lib/strict/vars b/gnu/usr.bin/perl/t/lib/strict/vars
index c6cb0679396..de517078be1 100644
--- a/gnu/usr.bin/perl/t/lib/strict/vars
+++ b/gnu/usr.bin/perl/t/lib/strict/vars
@@ -83,21 +83,6 @@ Execution of - aborted due to compilation errors.
 ########
 
 # Check compile time scope of strict vars pragma
-use strict 'vars' ;
-use utf8;
-use open qw( :utf8 :std );
-{
-    no strict ;
-    $jòè = 1 ;
-}
-$jòè = 1 ;
-EXPECT
-Variable "$jòè" is not imported at - line 10.
-Global symbol "$jòè" requires explicit package name at - line 10.
-Execution of - aborted due to compilation errors.
-########
-
-# Check compile time scope of strict vars pragma
 no strict;
 {
     use strict 'vars' ;
@@ -142,23 +127,6 @@ Global symbol "$joe" requires explicit package name at ./abc line 2.
 Compilation failed in require at - line 2.
 ########
 
---FILE-- abc
-use strict 'vars' ;
-use utf8;
-use open qw( :utf8 :std );
-$jòè = 1 ;
-1;
---FILE-- 
-use utf8;
-use open qw( :utf8 :std );
-$jòè = 1 ;
-require "./abc";
-EXPECT
-Variable "$jòè" is not imported at ./abc line 4.
-Global symbol "$jòè" requires explicit package name at ./abc line 4.
-Compilation failed in require at - line 4.
-########
-
 --FILE-- abc.pm
 use strict 'vars' ;
 $joe = 1 ;
@@ -174,24 +142,6 @@ BEGIN failed--compilation aborted at - line 2.
 ########
 
 --FILE-- abc.pm
-use strict 'vars' ;
-use utf8;
-use open qw( :utf8 :std );
-$jòè = 1 ;
-1;
---FILE-- 
-use utf8;
-use open qw( :utf8 :std );
-$jòè = 1 ;
-use abc;
-EXPECT
-Variable "$jòè" is not imported at abc.pm line 4.
-Global symbol "$jòè" requires explicit package name at abc.pm line 4.
-Compilation failed in require at - line 4.
-BEGIN failed--compilation aborted at - line 4.
-########
-
---FILE-- abc.pm
 package Burp;
 use strict;
 $a = 1;$f = 1;$k = 1; # just to get beyond the limit...
@@ -275,22 +225,6 @@ Execution of - aborted due to compilation errors.
 ########
 
 # Check scope of pragma with eval
-use strict 'vars' ;
-use utf8;
-use open qw( :utf8 :std );
-eval {
-    no strict ;
-    $jòè = 1 ;
-};
-print STDERR $@;
-$jòè = 1 ;
-EXPECT
-Variable "$jòè" is not imported at - line 11.
-Global symbol "$jòè" requires explicit package name at - line 11.
-Execution of - aborted due to compilation errors.
-########
-
-# Check scope of pragma with eval
 no strict ;
 eval '
     $joe = 1 ;
@@ -403,21 +337,6 @@ Global symbol "$fred" requires explicit package name at - line 8.
 Execution of - aborted due to compilation errors.
 ########
 
-# strict vars with elapsed our - error
-use strict 'vars' ;
-use utf8;
-use open qw( :utf8 :std );
-sub fòò {
-    our $frèd;
-    $frèd;
-}
-$frèd ;
-EXPECT
-Variable "$frèd" is not imported at - line 10.
-Global symbol "$frèd" requires explicit package name at - line 10.
-Execution of - aborted due to compilation errors.
-########
-
 # nested our with local - no error
 $fred = 1;
 use strict 'vars';
@@ -460,7 +379,7 @@ our $foo;
 ${foo} = 10;
 our $foo;
 EXPECT
-"our" variable $foo redeclared at - line 7.
+"our" variable $foo masks earlier declaration in same scope at - line 7.
 ########
 
 # multiple our declarations in same scope, same package, warning
@@ -471,14 +390,12 @@ use warnings;
 our $foo;
 {
     our $foo;
-    our $foo;
     package Foo;
     our $foo;
 }
 EXPECT
 "our" variable $foo redeclared at - line 9.
 	(Did you mean "local" instead of "our"?)
-"our" variable $foo redeclared at - line 10.
 ########
 
 --FILE-- abc
@@ -496,7 +413,7 @@ ok
 ########
 
 # Make sure the strict vars failure still occurs
-# now that the '@i should be written as \@i' failure does not occur
+# now that the `@i should be written as \@i' failure does not occur
 # 20000522 mjd@plover.com (MJD)
 use strict 'vars';
 no warnings;
@@ -504,72 +421,3 @@ no warnings;
 EXPECT
 Global symbol "@i_like_crackers" requires explicit package name at - line 7.
 Execution of - aborted due to compilation errors.
-########
-
-# [perl #21914] New bug > 5.8.0. Used to dump core.
-use strict 'vars';
-@k = <$k>;
-EXPECT
-Global symbol "@k" requires explicit package name at - line 4.
-Global symbol "$k" requires explicit package name at - line 4.
-Execution of - aborted due to compilation errors.
-########
-# [perl #26910] hints not propagated into (?{...})
-use strict 'vars';
-qr/(?{$foo++})/;
-EXPECT
-Global symbol "$foo" requires explicit package name at - line 3.
-Execution of - aborted due to compilation errors.
-########
-# Regex compilation errors weren't UTF-8 clean.
-use strict 'vars';
-use utf8;
-use open qw( :utf8 :std );
-qr/(?{$fòò++})/;
-EXPECT
-Global symbol "$fòò" requires explicit package name at - line 5.
-Execution of - aborted due to compilation errors.
-########
-# [perl #73712] 'Variable is not imported' should be suppressible
-$dweck;
-use strict 'vars';
-no warnings;
-eval q/$dweck/;
-EXPECT
-########
-# [perl #112316] strict vars getting confused by nulls
-# Assigning to a package whose name contains a null
-BEGIN { *Foo:: = *{"foo\0bar::"} }
-package foo;
-*Foo::bar = [];
-use strict;
-eval 'package Foo; @bar = 1' or die;
-EXPECT
-########
-# [perl #112316] strict vars getting confused by nulls
-# Assigning from within a package whose name contains a null
-BEGIN { *Foo:: = *{"foo\0bar::"} }
-package Foo;
-*foo::bar = [];
-use strict;
-eval 'package foo; @bar = 1' or die;
-EXPECT
-########
-# [perl #112316] strict vars getting confused by nulls
-# Assigning from one null package to another, with a common prefix
-BEGIN { *Foo:: = *{"foo\0foo::"};
-        *Bar:: = *{"foo\0bar::"} }
-package Foo;
-*Bar::bar = [];
-use strict;
-eval 'package Bar; @bar = 1' or die;
-EXPECT
-########
-# UTF8 and Latin1 package names equivalent at the byte level
-use utf8;
-# ĵ in UTF-8 is the same as ĵ in Latin-1
-package ĵ;
-*ĵ::bar = [];
-use strict;
-eval 'package ĵ; @bar = 1' or die;
-EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/warnings/7fatal b/gnu/usr.bin/perl/t/lib/warnings/7fatal
index 32d2f19a361..a3e70f8d50f 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/7fatal
+++ b/gnu/usr.bin/perl/t/lib/warnings/7fatal
@@ -35,7 +35,7 @@ use warnings FATAL => 'uninitialized' ;
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
 ########
 
 # Check runtime scope of pragma
@@ -47,7 +47,7 @@ use warnings FATAL => 'all' ;
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
 ########
 
 # Check runtime scope of pragma
@@ -59,7 +59,7 @@ no warnings ;
 &$a ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
 ########
 
 # Check runtime scope of pragma
@@ -71,7 +71,7 @@ no warnings ;
 &$a ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 6.
+Use of uninitialized value in scalar chop at - line 6.
 ########
 
 --FILE-- abc
@@ -105,7 +105,7 @@ my $a ; chop $a ;
 print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at ./abc line 2.
-Use of uninitialized value $a in scalar chop at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
 ########
 
 --FILE-- abc.pm
@@ -119,7 +119,7 @@ my $a ; chop $a ;
 print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at abc.pm line 2.
-Use of uninitialized value $a in scalar chop at - line 3.
+Use of uninitialized value in scalar chop at - line 3.
 ########
 
 # Check scope of pragma with eval
@@ -131,7 +131,7 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value $b in scalar chop at - line 6.
+-- Use of uninitialized value in scalar chop at - line 6.
 The End.
 ########
 
@@ -143,8 +143,8 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value $b in scalar chop at - line 5.
-Use of uninitialized value $b in scalar chop at - line 7.
+-- 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
@@ -156,7 +156,7 @@ eval {
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
@@ -214,7 +214,7 @@ eval q[
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value $b in scalar chop at (eval 1) line 3.
+-- Use of uninitialized value in scalar chop at (eval 1) line 3.
 The End.
 ########
 
@@ -226,8 +226,8 @@ eval '
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
--- Use of uninitialized value $b in scalar chop at (eval 1) line 2.
-Use of uninitialized value $b in scalar chop at - line 7.
+-- 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
@@ -239,7 +239,7 @@ eval '
 my $b ; chop $b ;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 8.
 ########
 
 # Check scope of pragma with eval
@@ -277,7 +277,6 @@ print STDERR "The End.\n" ;
 EXPECT
 Reversed += operator at - line 8.
 ########
-# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings 'void' ;
 
@@ -285,8 +284,7 @@ time ;
 
 {
     use warnings FATAL => qw(void) ;
-    $a = "abc";
-    length $a ;
+    length "abc" ;
 }
 
 join "", 1,2,3 ;
@@ -294,9 +292,8 @@ join "", 1,2,3 ;
 print "done\n" ;
 EXPECT
 Useless use of time in void context at - line 4.
-Useless use of length in void context at - line 9.
+Useless use of length in void context at - line 8.
 ########
-# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings ;
 
@@ -304,8 +301,7 @@ time ;
 
 {
     use warnings FATAL => qw(void) ;
-    $a = "abc";
-    length $a ;
+    length "abc" ;
 }
 
 join "", 1,2,3 ;
@@ -313,7 +309,7 @@ join "", 1,2,3 ;
 print "done\n" ;
 EXPECT
 Useless use of time in void context at - line 4.
-Useless use of length in void context at - line 9.
+Useless use of length in void context at - line 8.
 ########
 
 use warnings FATAL => 'all';
@@ -328,8 +324,8 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
-Use of uninitialized value $b in scalar chop at - line 11.
+Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 11.
 ########
 
 use warnings FATAL => 'all';
@@ -344,8 +340,8 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 8.
-Use of uninitialized value $b in scalar chop at - line 11.
+Use of uninitialized value in scalar chop at - line 8.
+Use of uninitialized value in scalar chop at - line 11.
 ########
 
 use warnings FATAL => 'all';
@@ -359,54 +355,49 @@ use warnings FATAL => 'all';
 my $b ; chop $b;
 print STDERR "The End.\n" ;
 EXPECT
-Use of uninitialized value $b in scalar chop at - line 7.
+Use of uninitialized value in scalar chop at - line 7.
 ########
 
 use warnings FATAL => 'syntax', NONFATAL => 'void' ;
 
-$a = "abc";
-length $a;
+length "abc";
 print STDERR "The End.\n" ;
 EXPECT
-Useless use of length in void context at - line 5.
+Useless use of length in void context at - line 4.
 The End.
 ########
 
 use warnings FATAL => 'all', NONFATAL => 'void' ;
 
-$a = "abc";
-length $a;
+length "abc";
 print STDERR "The End.\n" ;
 EXPECT
-Useless use of length in void context at - line 5.
+Useless use of length in void context at - line 4.
 The End.
 ########
 
 use warnings FATAL => 'all', NONFATAL => 'void' ;
 
 my $a ; chomp $a;
-
-$b = "abc" ;
-length $b;
+length "abc";
 print STDERR "The End.\n" ;
 EXPECT
-Useless use of length in void context at - line 7.
-Use of uninitialized value $a in scalar chomp at - line 4.
+Useless use of length in void context at - line 5.
+Use of uninitialized value in scalar chomp at - line 4.
 ########
 
 use warnings FATAL => 'void', NONFATAL => 'void' ;
-$a = "abc";
-length $a;
+
+length "abc";
 print STDERR "The End.\n" ;
 EXPECT
 Useless use of length in void context at - line 4.
 The End.
 ########
-# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) > 1 ? "Parser leaks OPs, which leak shared hash keys" : ''
 
 use warnings NONFATAL => 'void', FATAL => 'void' ;
-$a = "abc";
-length $a;
+
+length "abc";
 print STDERR "The End.\n" ;
 EXPECT
 Useless use of length in void context at - line 4.
@@ -433,102 +424,3 @@ print STDERR "The End.\n" ;
 EXPECT
 Unsuccessful open on filename containing newline at - line 5.
 close() on unopened filehandle fred at - line 6.
-########
-
-# 'use warnings' test as the basis for the following tests
-use warnings ;
-my $a = oct "7777777777777777777777777777777777778" ;
-my $b =+ 1 ;
-my $c ; chop $c ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 5.
-Integer overflow in octal number at - line 4.
-Illegal octal digit '8' ignored at - line 4.
-Octal number > 037777777777 non-portable at - line 4.
-Use of uninitialized value $c in scalar chop at - line 6.
-The End.
-########
-
-# 'use warnings NONFATAL=>"all"' should be the same as 'use warnings'
-use warnings NONFATAL=>"all" ;
-my $a = oct "7777777777777777777777777777777777778" ;
-my $b =+ 1 ;
-my $c ; chop $c ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 5.
-Integer overflow in octal number at - line 4.
-Illegal octal digit '8' ignored at - line 4.
-Octal number > 037777777777 non-portable at - line 4.
-Use of uninitialized value $c in scalar chop at - line 6.
-The End.
-########
-
-# 'use warnings "NONFATAL"' should be the same as 'use warnings' [perl #120977]
-use warnings "NONFATAL" ;
-my $a = oct "7777777777777777777777777777777777778" ;
-my $b =+ 1 ;
-my $c ; chop $c ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 5.
-Integer overflow in octal number at - line 4.
-Illegal octal digit '8' ignored at - line 4.
-Octal number > 037777777777 non-portable at - line 4.
-Use of uninitialized value $c in scalar chop at - line 6.
-The End.
-########
-
-# 'use warnings "FATAL"' should be the same as 'use warnings FATAL=>"all"' [perl #120977]
-use warnings "FATAL" ;
-{
-    no warnings ;
-    my $a =+ 1 ;
-}
-my $a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 8.
-########
-
-# 'use warnings "FATAL"' should be the same as 'use warnings FATAL=>"all"' [perl #120977]
-use warnings "FATAL" ;
-{
-    no warnings ;
-    my $a = oct "7777777777777777777777777777777777778" ;
-}
-my $a = oct "7777777777777777777777777777777777778" ;
-print STDERR "The End.\n" ;
-EXPECT
-Integer overflow in octal number at - line 8.
-########
-
-# 'no warnings FATAL=>"all"' should be the same as 'no warnings'
-use warnings ;
-{
-    no warnings FATAL=>"all" ;
-    my $a = oct "7777777777777777777777777777777777778" ;
-    my $b =+ 1 ;
-    my $c ; chop $c ;
-}
-my $a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 10.
-The End.
-########
-
-# 'no warnings "FATAL"' should be the same as 'no warnings' [perl #120977]
-use warnings ;
-{
-    no warnings "FATAL" ;
-    my $a = oct "7777777777777777777777777777777777778" ;
-    my $b =+ 1 ;
-    my $c ; chop $c ;
-}
-my $a =+ 1 ;
-print STDERR "The End.\n" ;
-EXPECT
-Reversed += operator at - line 10.
-The End.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/doio b/gnu/usr.bin/perl/t/lib/warnings/doio
index 63250e156c0..bb09aa85520 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/doio
+++ b/gnu/usr.bin/perl/t/lib/warnings/doio
@@ -60,10 +60,10 @@
 __END__
 # doio.c [Perl_do_open9]
 use warnings 'io' ;
-open(F, '|'."$^X -e 1|");
+open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(F);
 no warnings 'io' ;
-open(G, '|'."$^X -e 1|");
+open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(G);
 EXPECT
 Can't open bidirectional pipe at - line 3.
@@ -143,7 +143,7 @@ print $a ;
 no warnings 'uninitialized' ;
 print $b ;
 EXPECT
-Use of uninitialized value $a in print at - line 3.
+Use of uninitialized value in print at - line 3.
 ########
 # doio.c [Perl_my_stat Perl_my_lstat]
 use warnings 'io' ;
@@ -170,84 +170,83 @@ EXPECT
 Use of -l on filehandle STDIN at - line 3.
 Use of -l on filehandle $fh at - line 6.
 ########
-# doio.c [Perl_my_stat]
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'io';
--l ᶠᚻ;
-no warnings 'io';
--l ᶠᚻ;
-EXPECT
-Use of -l on filehandle ᶠᚻ at - line 5.
-########
 # doio.c [Perl_do_aexec5]
+BEGIN {
+    if ($^O eq 'MacOS') {
+	print <<EOM;
+SKIPPED
+# no exec on Mac OS
+EOM
+	exit;
+    }
+}
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
 no warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
 EXPECT
 OPTION regex
-Statement unlikely to be reached at - line .+
-	\(Maybe you meant system\(\) when you said exec\(\)\?\)
 Can't exec "lskdjfalksdjfdjfkls": .+
 ########
 # doio.c [Perl_do_exec3]
+BEGIN {
+    if ($^O eq 'MacOS') {
+	print <<EOM;
+SKIPPED
+# no exec on Mac OS
+EOM
+	exit;
+    }
+}
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls", "abc" ;
 no warnings 'io' ;
 exec "lskdjfalksdjfdjfkls", "abc" ;
 EXPECT
 OPTION regex
-Statement unlikely to be reached at - line .+
-	\(Maybe you meant system\(\) when you said exec\(\)\?\)
 Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
 ########
 # doio.c [win32_execvp]
+BEGIN {
+    if ($^O eq 'MacOS') {
+	print <<EOM;
+SKIPPED
+# no exec on Mac OS
+EOM
+	exit;
+    }
+}
 use warnings 'exec' ;
 exec $^X, "-e0" ;
 EXPECT
 ########
 # doio.c [Perl_nextargv]
 $^W = 0 ;
-# These happen to warn at different points within doio.c
-# This will open read only, and then be caught by an explicit check:
 my $filename = "./temp.dir" ;
-# Whereas these two will fail to open:
-my $dir0 = "./zero.dir" ;
-# but files and directories have a different error message if they don't open:
-my $file3 = "date|" ;
 mkdir $filename, 0777 
   or die "Cannot create directory $filename: $!\n" ;
-mkdir $dir0, 0
-  or die "Cannot create directory dir0: $!\n" ;
 {
-    local (@ARGV) = ($filename, $dir0, $file3) ;
+    local (@ARGV) = ($filename) ;
     local ($^I) = "" ;
     my $x = <> ;
 }
 {
     no warnings 'inplace' ;
-    local (@ARGV) = ($filename, $dir0, $file3) ;
+    local (@ARGV) = ($filename) ;
     local ($^I) = "" ;
     my $x = <> ;
 }
 {
     use warnings 'inplace' ;
-    local (@ARGV) = ($filename, $dir0, $file3) ;
+    local (@ARGV) = ($filename) ;
     local ($^I) = "" ;
     my $x = <> ;
 }
 rmdir $filename ;
-chmod 0777, $dir0 ;
-rmdir $dir0 ;
 EXPECT
-OPTION regex
-Can't do inplace edit: \./temp\.dir is not a regular file at - line 17\.
-Can't do inplace edit: \./zero\.dir is not a regular file at - line 17\.
-Can't open date\|: .*? at - line 17\.
-Can't do inplace edit: \./temp\.dir is not a regular file at - line 29\.
-Can't do inplace edit: \./zero\.dir is not a regular file at - line 29\.
-Can't open date\|: .*? at - line 29\.
+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' ;
@@ -276,139 +275,3 @@ no warnings 'io';
 open FOO, '>', \$x;
 EXPECT
 Can't open a reference at - line 14.
-########
-# doio.c [Perl_do_openn]
-use Config;
-BEGIN {
-    if (!$Config{useperlio}) {
-	print <<EOM;
-SKIPPED
-# warns only with perlio
-EOM
-	exit;
-    }
-}
-use warnings 'io' ;
-close STDOUT;
-open FH1, "../harness"; close FH1;
-no warnings 'io' ;
-open FH2, "../harness"; close FH2;
-EXPECT
-Filehandle STDOUT reopened as FH1 only for input at - line 14.
-########
-# doio.c [Perl_do_openn]
-use Config;
-use utf8;
-use open qw( :utf8 :std );
-BEGIN {
-    if (!$Config{useperlio}) {
-	print <<EOM;
-SKIPPED
-# warns only with perlio
-EOM
-	exit;
-    }
-}
-use warnings 'io' ;
-close STDOUT;
-open ᶠᚻ1, "../harness"; close ᶠᚻ1;
-no warnings 'io' ;
-open ᶠᚻ2, "../harness"; close ᶠᚻ2;
-EXPECT
-Filehandle STDOUT reopened as ᶠᚻ1 only for input at - line 16.
-########
-# doio.c [Perl_do_openn]
-use Config;
-BEGIN {
-    if (!$Config{useperlio}) {
-	print <<EOM;
-SKIPPED
-# warns only with perlio
-EOM
-	exit;
-    }
-}
-use warnings 'io' ;
-close STDIN;
-open my $fh1, ">doiowarn.tmp"; close $fh1;
-no warnings 'io' ;
-open my $fh2, ">doiowarn.tmp"; close $fh2;
-unlink "doiowarn.tmp";
-EXPECT
-Filehandle STDIN reopened as $fh1 only for output at - line 14.
-########
-# doio.c [Perl_do_openn]
-use Config;
-use utf8;
-use open qw( :utf8 :std );
-BEGIN {
-    if (!$Config{useperlio}) {
-	print <<EOM;
-SKIPPED
-# warns only with perlio
-EOM
-	exit;
-    }
-}
-use warnings 'io' ;
-close STDIN;
-open my $ᶠᚻ1, ">doiowarn.tmp"; close $ᶠᚻ1;
-no warnings 'io' ;
-open my $ᶠᚻ2, ">doiowarn.tmp"; close $ᶠᚻ2;
-unlink "doiowarn.tmp";
-EXPECT
-Filehandle STDIN reopened as $ᶠᚻ1 only for output at - line 16.
-########
-# doio.c [Perl_do_openn]
-use Config;
-use utf8;
-use open qw( :utf8 :std );
-BEGIN {
-    if (!$Config{useperlio}) {
-	print <<EOM;
-SKIPPED
-# warns only with perlio
-EOM
-	exit;
-    }
-}
-use warnings 'io' ;
-close STDIN;
-open ᶠᚻ1, ">doiowarn.tmp"; close ᶠᚻ1;
-no warnings 'io' ;
-open ᶠᚻ2, ">doiowarn.tmp"; close ᶠᚻ2;
-unlink "doiowarn.tmp";
-EXPECT
-Filehandle STDIN reopened as ᶠᚻ1 only for output at - line 16.
-########
-open(my $i, "foo\0bar");
-use warnings 'io';
-open(my $i, "foo\0bar");
-EXPECT
-Invalid \0 character in pathname for open: foo\0bar at - line 3.
-########
-chmod(0, "foo\0bar");
-use warnings 'io';
-chmod(0, "foo\0bar");
-EXPECT
-Invalid \0 character in pathname for chmod: foo\0bar at - line 3.
-########
-unlink("foo\0bar", "foo\0bar2");
-use warnings 'io';
-unlink("foo\0bar", "foo\0bar2");
-EXPECT
-Invalid \0 character in pathname for unlink: foo\0bar at - line 3.
-Invalid \0 character in pathname for unlink: foo\0bar2 at - line 3.
-########
-utime(-1, -1, "foo\0bar", "foo\0bar2");
-use warnings 'io';
-utime(-1, -1, "foo\0bar", "foo\0bar2");
-EXPECT
-Invalid \0 character in pathname for utime: foo\0bar at - line 3.
-Invalid \0 character in pathname for utime: foo\0bar2 at - line 3.
-########
-my @foo = glob "foo\0bar";
-use warnings 'io';
-my @bar = glob "foo\0bar";
-EXPECT
-Invalid \0 character in pattern for glob: foo\0bar at - line 3.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/doop b/gnu/usr.bin/perl/t/lib/warnings/doop
index 74c3e907fea..5803b445812 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/doop
+++ b/gnu/usr.bin/perl/t/lib/warnings/doop
@@ -1,4 +1,3 @@
-__END__
 # doop.c
 use utf8 ;
 $_ = "\x80  \xff" ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/mg b/gnu/usr.bin/perl/t/lib/warnings/mg
index 9e3652b71e1..f7c3ebf435c 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/mg
+++ b/gnu/usr.bin/perl/t/lib/warnings/mg
@@ -25,7 +25,7 @@ EXPECT
 ########
 # mg.c
 use warnings 'signal' ;
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') {
     print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
 }
 $|=1;
@@ -35,7 +35,7 @@ SIGINT handler "fred" not defined.
 ########
 # mg.c
 no warnings 'signal' ;
-if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS') {
+if ($^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'VMS' || $^O eq 'MacOS') {
     print "SKIPPED\n# $^O, can't kill() to raise()\n"; exit;
 }
 $|=1;
@@ -46,17 +46,12 @@ EXPECT
 # mg.c
 use warnings 'uninitialized';
 'foo' =~ /(foo)/;
-oct $3;
+length $3;
 EXPECT
-Use of uninitialized value $3 in oct at - line 4.
+Use of uninitialized value in length at - line 4.
 ########
 # mg.c
 use warnings 'uninitialized';
-oct $3;
-EXPECT
-Use of uninitialized value $3 in oct at - line 3.
-########
-# mg.c
-use warnings 'uninitialized';
-$ENV{FOO} = undef; # should not warn
+length $3;
 EXPECT
+Use of uninitialized value in length at - line 3.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/op b/gnu/usr.bin/perl/t/lib/warnings/op
index bca28186a2f..011fd17beb3 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/op
+++ b/gnu/usr.bin/perl/t/lib/warnings/op
@@ -1,14 +1,33 @@
   op.c		AOK
 
-     Use of my $_ is experimental
-	my $_ ;
+     "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 ;
 
-     Scalar value %.*s better written as $%.*s" 
-	@a[3] = 2;
-	@a{3} = 2;
+     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
@@ -64,12 +83,6 @@
      Array @%s missing the @ in argument %d of %s() 
 	push fred ;
  
-     push on reference is experimental			[ck_fun]
-     pop on reference is experimental
-     shift on reference is experimental
-     unshift on reference is experimental
-     splice on reference is experimental
- 
      Hash %%%s missing the %% in argument %d of %s() 
 	keys joe ;
  
@@ -85,18 +98,7 @@
      defined(%hash) is deprecated
      	(Maybe you should just omit the defined()?)
 	my %h ; defined %h ;
-
-     "my %s" used in sort comparison
-
-     $[ used in comparison (did you mean $] ?)
-
-     each on reference is experimental			[ck_each]
-     keys on reference is experimental
-     values on reference is experimental
-
-     length() used on @array (did you mean "scalar(@array)"?)
-     length() used on %hash (did you mean "scalar(keys %hash)"?)
-
+    
      /---/ should probably be written as "---"
         join(/---/, @foo);
 
@@ -104,11 +106,12 @@
         fred() ; sub fred ($$) {}
 
 
-    Package '%s' not found (did you use the incorrect case?)
+     Use of "package" with no arguments is deprecated
+	package;
 
-    Use of /g modifier is meaningless in split
+    Package `%s' not found (did you use the incorrect case?)
 
-    Possible precedence problem on bitwise %c operator	[Perl_ck_bitop]
+    Use of /g modifier is meaningless in split
 
     Mandatory Warnings 
     ------------------
@@ -116,208 +119,106 @@
         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 'experimental::lexical_topic' ;
-my $_;
-CORE::state $_;
-no warnings 'experimental::lexical_topic' ;
-my $_;
-CORE::state $_;
+use warnings 'misc' ;
+my $x ;
+my $x ;
+my $y = my $y ;
+no warnings 'misc' ;
+my $x ;
+my $y ;
 EXPECT
-Use of my $_ is experimental at - line 3.
-Use of state $_ is experimental at - line 4.
+"my" variable $x masks earlier declaration in same scope at - line 4.
+"my" variable $y masks earlier declaration in same statement at - line 5.
 ########
 # op.c
-use warnings 'syntax' ;
-1 if $a = 1 ;
-1 if $a
-  = 1 ;
-no warnings 'syntax' ;
-1 if $a = 1 ;
-1 if $a
-  = 1 ;
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
 EXPECT
-Found = in conditional, should be == at - line 3.
-Found = in conditional, should be == at - line 4.
+Variable "$x" will not stay shared at - line 7.
 ########
 # op.c
-use warnings 'syntax' ;
-use constant foo => 1;
-1 if $a = foo ;
-no warnings 'syntax' ;
-1 if $a = foo ;
+no warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         $x
+      }
+   }
 EXPECT
+
 ########
 # op.c
-use warnings 'syntax' ;
-@a[3];
-@a{3};
-@a["]"];
-@a{"]"};
-@a["}"];
-@a{"}"};
-@a{$_};
-@a{--$_};
-@a[$_];
-@a[--$_];
-no warnings 'syntax' ;
-@a[3];
-@a{3};
+use warnings 'closure' ;
+sub x {
+      our $x;
+      sub y {
+         $x
+      }
+   }
 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.
-Scalar value @a["]"] better written as $a["]"] at - line 5.
-Scalar value @a{"]"} better written as $a{"]"} at - line 6.
-Scalar value @a["}"] better written as $a["}"] at - line 7.
-Scalar value @a{"}"} better written as $a{"}"} at - line 8.
-Scalar value @a{...} better written as $a{...} at - line 9.
-Scalar value @a{...} better written as $a{...} at - line 10.
-Scalar value @a[...] better written as $a[...] at - line 11.
-Scalar value @a[...] better written as $a[...] at - line 12.
+
 ########
 # op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'syntax' ;
-@à[3];
-@à{3};
-no warnings 'syntax' ;
-@à[3];
-@à{3};
+use warnings 'closure' ;
+sub x {
+      my $x;
+      sub y {
+         sub { $x }
+      }
+   }
 EXPECT
-Scalar value @à[3] better written as $à[3] at - line 5.
-Scalar value @à{3} better written as $à{3} at - line 6.
+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 utf8;
-use open qw( :utf8 :std );
 use warnings 'syntax' ;
-@�[3];
-@�{3};
+1 if $a = 1 ;
 no warnings 'syntax' ;
-@�[3];
-@�{3};
+1 if $a = 1 ;
 EXPECT
-Scalar value @�[3] better written as $�[3] at - line 5.
-Scalar value @�{3} better written as $�{3} at - line 6.
+Found = in conditional, should be == at - line 3.
 ########
 # op.c
-# "Scalar value better written as" false positives
-# [perl #28380] and [perl #114024]
-use warnings 'syntax';
-
-# hashes
-@h{qw"a b c"} = 1..3;
-@h{qw'a b c'} = 1..3;
-@h{qw$a b c$} = 1..3;
-@h{qw-a b c-} = 1..3;
-@h{qw#a b c#} = 1..3;
-@h{ qw#a b c#} = 1..3;
-@h{	qw#a b c#} = 1..3; # tab before qw
-@h{qw "a"};
-@h{ qw "a"};
-@h{	qw "a"};
-sub foo() { qw/abc def ghi/ }
-@X{+foo} = ( 1 .. 3 );
-$_ = "abc"; @X{split ""} = ( 1 .. 3 );
-my @s = @f{"}", "a"};
-my @s = @f{"]", "a"};
-@a{$],0};
-@_{0} = /(.*)/;
-@h{m "$re"};
-@h{qx ""} if 0;
-@h{glob ""};
-@h{readline ""};
-@h{m ""};
-use constant phoo => 1..3;
-@h{+phoo}; # rv2av
-{
-    no warnings 'deprecated';
-    @h{each H};
-    @h{values H};
-    @h{keys H};
-}
-@h{sort foo};
-@h{reverse foo};
-@h{caller 0};
-@h{lstat ""};
-@h{stat ""};
-@h{readdir ""};
-@h{system ""} if 0;
-@h{+times} if 0;
-@h{localtime 0};
-@h{gmtime 0};
-@h{eval ""};
-{
-    no warnings 'experimental::autoderef';
-    @h{each $foo} if 0;
-    @h{keys $foo} if 0;
-    @h{values $foo} if 0;
-}
-
-# arrays
-@h[qw"a b c"] = 1..3;
-@h[qw'a b c'] = 1..3;
-@h[qw$a b c$] = 1..3;
-@h[qw-a b c-] = 1..3;
-@h[qw#a b c#] = 1..3;
-@h[ qw#a b c#] = 1..3;
-@h[	qw#a b c#] = 1..3; # tab before qw
-@h[qw "a"];
-@h[ qw "a"];
-@h[	qw "a"];
-sub foo() { qw/abc def ghi/ }
-@X[+foo] = ( 1 .. 3 );
-$_ = "abc"; @X[split ""] = ( 1 .. 3 );
-my @s = @f["}", "a"];
-my @s = @f["]", "a"];
-@a[$],0];
-@_[0] = /(.*)/;
-@h[m "$re"];
-@h[qx ""] if 0;
-@h[glob ""];
-@h[readline ""];
-@h[m ""];
-use constant phoo => 1..3;
-@h[+phoo]; # rv2av
-{
-    no warnings 'deprecated';
-    @h[each H];
-    @h[values H];
-    @h[keys H];
-}
-@h[sort foo];
-@h[reverse foo];
-@h[caller 0];
-@h[lstat ""];
-@h[stat ""];
-@h[readdir ""];
-@h[system ""] if 0;
-@h[+times] if 0;
-@h[localtime 0];
-@h[gmtime 0];
-@h[eval ""];
-{
-    no warnings 'experimental::autoderef';
-    @h[each $foo] if 0;
-    @h[keys $foo] if 0;
-    @h[values $foo] if 0;
-}
+use warnings 'deprecated' ;
+split ;
+no warnings 'deprecated' ;
+split ;
 EXPECT
+Use of implicit split to @_ is deprecated at - line 3.
 ########
 # op.c
-# "Scalar value better written as" should not trigger for syntax errors
-use warnings 'syntax';
-@a[]
+use warnings 'deprecated' ;
+$a = split ;
+no warnings 'deprecated' ;
+$a = split ;
 EXPECT
-syntax error at - line 4, near "[]"
-Execution of - aborted due to compilation errors.
+Use of implicit split to @_ is deprecated at - line 3.
 ########
 # op.c
+use warnings 'deprecated';
 my (@foo, %foo);
 %main::foo->{"bar"};
 %foo->{"bar"};
@@ -337,20 +238,18 @@ $foo = {}; %$foo->{"bar"};
 $main::foo = []; @$main::foo->[34];
 $foo = []; @$foo->[34];
 EXPECT
-Using a hash as a reference is deprecated at - line 3.
 Using a hash as a reference is deprecated at - line 4.
-Using an array as a reference is deprecated at - line 5.
+Using a hash as a reference is deprecated at - line 5.
 Using an array as a reference is deprecated at - line 6.
-Using a hash as a reference is deprecated at - line 7.
+Using an array as a reference is deprecated at - line 7.
 Using a hash as a reference is deprecated at - line 8.
-Using an array as a reference is deprecated at - line 9.
+Using a hash as a reference is deprecated at - line 9.
 Using an array as a reference is deprecated at - line 10.
+Using an array as a reference is deprecated at - line 11.
 ########
 # op.c
-use warnings 'void' ; no warnings 'experimental::smartmatch'; close STDIN ;
-#line 2
-1 x 3 ;			# OP_REPEAT (folded)
-(1) x 3 ;		# OP_REPEAT
+use warnings 'void' ; close STDIN ;
+1 x 3 ;			# OP_REPEAT
 			# OP_GVSV
 wantarray ; 		# OP_WANTARRAY
 			# OP_GV
@@ -401,16 +300,7 @@ eval { getgrnam 1 };	# OP_GGRNAM
 eval { getgrgid 1 };	# OP_GGRGID
 eval { getpwnam 1 };	# OP_GPWNAM
 eval { getpwuid 1 };	# OP_GPWUID
-prototype "foo";	# OP_PROTOTYPE
-$a ~~ $b;		# OP_SMARTMATCH
-$a <=> $b;		# OP_NCMP
-"dsatrewq";
-"diatrewq";
-"igatrewq";
-use 5.015;
-__SUB__			# OP_RUNCV
 EXPECT
-Useless use of a constant ("111") in void context at - line 2.
 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.
@@ -448,13 +338,6 @@ 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.
-Useless use of subroutine prototype in void context at - line 54.
-Useless use of smart match in void context at - line 55.
-Useless use of numeric comparison (<=>) in void context at - line 56.
-Useless use of a constant ("dsatrewq") in void context at - line 57.
-Useless use of a constant ("diatrewq") in void context at - line 58.
-Useless use of a constant ("igatrewq") in void context at - line 59.
-Useless use of __SUB__ in void context at - line 61.
 ########
 # op.c
 use warnings 'void' ; close STDIN ;
@@ -517,7 +400,6 @@ eval { getgrnam 1 };	# OP_GGRNAM
 eval { getgrgid 1 };	# OP_GGRGID
 eval { getpwnam 1 };	# OP_GPWNAM
 eval { getpwuid 1 };	# OP_GPWUID
-prototype "foo";	# OP_PROTOTYPE
 EXPECT
 ########
 # op.c
@@ -730,69 +612,32 @@ Useless use of a variable in void context at - line 6.
 use warnings 'void' ;
 "abc"; # OP_CONST
 7 ; # OP_CONST
-"x" . "y"; # optimized to OP_CONST
-2 + 2; # optimized to OP_CONST
-use constant U => undef;
-U;
-qq/"	\n/;
-5 || print "bad\n";	# test OPpCONST_SHORTCIRCUIT
-print "boo\n" if U;	# test OPpCONST_SHORTCIRCUIT
-if($foo){}elsif(""){}	# test OPpCONST_SHORTCIRCUIT
 no warnings 'void' ;
 "abc"; # OP_CONST
 7 ; # OP_CONST
-"x" . "y"; # optimized to OP_CONST
-2 + 2; # optimized to OP_CONST
-EXPECT
-Useless use of a constant ("abc") in void context at - line 3.
-Useless use of a constant (7) in void context at - line 4.
-Useless use of a constant ("xy") in void context at - line 5.
-Useless use of a constant (4) in void context at - line 6.
-Useless use of a constant (undef) in void context at - line 8.
-Useless use of a constant ("\"\t\n") in void context at - line 9.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'void' ;
-"àḆc"; # OP_CONST
-"Ẋ" . "ƴ"; # optimized to OP_CONST
-ＦＯＯ;     # Bareword optimized to OP_CONST
-use constant ů => undef;
-ů;
-5 || print "bad\n";	# test OPpCONST_SHORTCIRCUIT
-print "boo\n" if ů;	# test OPpCONST_SHORTCIRCUIT
-no warnings 'void' ;
-"àḆc"; # OP_CONST
-"Ẋ" . "ƴ"; # optimized to OP_CONST
 EXPECT
-Useless use of a constant ("\340\x{1e06}c") in void context at - line 5.
-Useless use of a constant ("\x{1e8a}\x{1b4}") in void context at - line 6.
-Useless use of a constant ("\x{ff26}\x{ff2f}\x{ff2f}") in void context at - line 7.
-Useless use of a constant (undef) in void context at - line 9.
+Useless use of a constant in void context at - line 3.
+Useless use of a constant in void context at - line 4.
 ########
 # op.c
 #
 use warnings 'misc' ;
-my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;my $d = 'test';
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
 @a =~ /abc/ ;
-@a2 =~ s/a/b/ ;
-@a3 =~ tr/a/b/ ;
+@a =~ s/a/b/ ;
+@a =~ tr/a/b/ ;
 @$b =~ /abc/ ;
 @$b =~ s/a/b/ ;
 @$b =~ tr/a/b/ ;
 %a =~ /abc/ ;
-%a2 =~ s/a/b/ ;
-%a3 =~ tr/a/b/ ;
+%a =~ s/a/b/ ;
+%a =~ tr/a/b/ ;
 %$c =~ /abc/ ;
 %$c =~ s/a/b/ ;
 %$c =~ tr/a/b/ ;
-$d =~ tr/a/b/d ;
-$d2 =~ tr/a/bc/;
-$d3 =~ tr//b/c;
 {
 no warnings 'misc' ;
-my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; my $d = 'test';
+my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ;
 @a =~ /abc/ ;
 @a =~ s/a/b/ ;
 @a =~ tr/a/b/ ;
@@ -805,56 +650,38 @@ my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; my $d = 'test';
 %$c =~ /abc/ ;
 %$c =~ s/a/b/ ;
 %$c =~ tr/a/b/ ;
-$d =~ tr/a/b/d ;
-$d =~ tr/a/bc/ ;
-$d =~ tr//b/c;
 }
 EXPECT
-Applying pattern match (m//) to @a will act on scalar(@a) at - line 5.
-Applying substitution (s///) to @a2 will act on scalar(@a2) at - line 6.
-Applying transliteration (tr///) to @a3 will act on scalar(@a3) at - line 7.
+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.
+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 %a will act on scalar(%a) at - line 11.
-Applying substitution (s///) to %a2 will act on scalar(%a2) at - line 12.
-Applying transliteration (tr///) to %a3 will act on scalar(%a3) at - line 13.
+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.
-Useless use of /d modifier in transliteration operator at - line 17.
-Replacement list is longer than search list at - line 18.
-Can't modify array dereference in substitution (s///) at - line 6, near "s/a/b/ ;"
-BEGIN not safe after errors--compilation aborted at - line 21.
+Can't modify private array in substitution (s///) at - line 6, near "s/a/b/ ;"
+BEGIN not safe after errors--compilation aborted at - line 18.
 ########
 # op.c
-use warnings 'parenthesis' ;
+use warnings 'syntax' ;
 my $a, $b = (1,2);
-my @foo,%bar,	$quux; # there's a TAB here
-my $x, $y or print;
-no warnings 'parenthesis' ;
+no warnings 'syntax' ;
 my $c, $d = (1,2);
 EXPECT
 Parentheses missing around "my" list at - line 3.
-Parentheses missing around "my" list at - line 4.
-########
-# op.c
-use warnings 'parenthesis' ;
-our $a, $b = (1,2);
-no warnings 'parenthesis' ;
-our $c, $d = (1,2);
-EXPECT
-Parentheses missing around "our" list at - line 3.
 ########
 # op.c
-use warnings 'parenthesis' ;
+use warnings 'syntax' ;
 local $a, $b = (1,2);
-local *f, *g;
-no warnings 'parenthesis' ;
+no warnings 'syntax' ;
 local $c, $d = (1,2);
 EXPECT
 Parentheses missing around "local" list at - line 3.
-Parentheses missing around "local" list at - line 4.
 ########
 # op.c
 use warnings 'bareword' ;
@@ -871,43 +698,28 @@ Bareword found in conditional at - line 3.
 use warnings 'misc' ;
 open FH, "<abc" ;
 $x = 1 if $x = <FH> ;
-$x = 1 if $x
-     = <FH> ;
 no warnings 'misc' ;
 $x = 1 if $x = <FH> ;
-$x = 1 if $x
-     = <FH> ;
 EXPECT
 Value of <HANDLE> construct can be "0"; test with defined() at - line 4.
-Value of <HANDLE> construct can be "0"; test with defined() at - line 5.
 ########
 # op.c
 use warnings 'misc' ;
 opendir FH, "." ;
 $x = 1 if $x = readdir FH ;
-$x = 1 if $x
-    = readdir FH ;
 no warnings 'misc' ;
 $x = 1 if $x = readdir FH ;
-$x = 1 if $x
-    = readdir FH ;
 closedir FH ;
 EXPECT
 Value of readdir() operator can be "0"; test with defined() at - line 4.
-Value of readdir() operator can be "0"; test with defined() at - line 5.
 ########
 # op.c
 use warnings 'misc' ;
 $x = 1 if $x = <*> ;
-$x = 1 if $x
-    = <*> ;
 no warnings 'misc' ;
 $x = 1 if $x = <*> ;
-$x = 1 if $x
-    = <*> ;
 EXPECT
 Value of glob construct can be "0"; test with defined() at - line 3.
-Value of glob construct can be "0"; test with defined() at - line 4.
 ########
 # op.c
 use warnings 'misc' ;
@@ -937,26 +749,13 @@ EXPECT
 Value of readdir() operator can be "0"; test with defined() at - line 4.
 ########
 # op.c
-use warnings 'misc';
-open FH, "<abc";
-($_ = <FH>) // ($_ = 1);
-opendir DH, ".";
-%a = (1,2,3,4) ;
-EXPECT
-########
-# op.c
 use warnings 'redefine' ;
 sub fred {}
 sub fred {}
-sub fred { # warning should be for this line
-}
 no warnings 'redefine' ;
 sub fred {}
-sub fred {
-}
 EXPECT
 Subroutine fred redefined at - line 4.
-Subroutine fred redefined at - line 5.
 ########
 # op.c
 use warnings 'redefine' ;
@@ -968,50 +767,18 @@ EXPECT
 Constant subroutine fred redefined at - line 4.
 ########
 # op.c
-sub fred () { 1 }
-sub fred () { 2 }
-EXPECT
-Constant subroutine fred redefined at - line 3.
-########
-# op.c
-sub fred () { 1 }
-*fred = sub () { 2 };
-EXPECT
-Constant subroutine main::fred redefined at - line 3.
-########
-# op.c
-use feature "lexical_subs", "state";
-my sub fred () { 1 }
-sub fred { 2 };
-my sub george { 1 }
-sub george () { 2 } # should *not* produce redef warnings by default
-state sub phred () { 1 }
-sub phred { 2 };
-state sub jorge { 1 }
-sub jorge () { 2 } # should *not* produce redef warnings by default
-EXPECT
-The lexical_subs feature is experimental at - line 3.
-Prototype mismatch: sub fred () vs none at - line 4.
-Constant subroutine fred redefined at - line 4.
-The lexical_subs feature is experimental at - line 5.
-Prototype mismatch: sub george: none vs () at - line 6.
-The lexical_subs feature is experimental at - line 7.
-Prototype mismatch: sub phred () vs none at - line 8.
-Constant subroutine phred redefined at - line 8.
-The lexical_subs feature is experimental at - line 9.
-Prototype mismatch: sub jorge: none vs () at - line 10.
-########
-# op.c
 no warnings 'redefine' ;
 sub fred () { 1 }
 sub fred () { 2 }
 EXPECT
+Constant subroutine fred redefined at - line 4.
 ########
 # op.c
 no warnings 'redefine' ;
 sub fred () { 1 }
 *fred = sub () { 2 };
 EXPECT
+Constant subroutine main::fred redefined at - line 4.
 ########
 # op.c
 use warnings 'redefine' ;
@@ -1026,85 +793,70 @@ 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 2.
-########
-# op.c [Perl_ck_fun]
-$fred = [];
-push $fred;
-pop $fred;
-shift $fred;
-unshift $fred;
-splice $fred;
-no warnings 'experimental::autoderef' ;
-push $fred;
-pop $fred;
-shift $fred;
-unshift $fred;
-splice $fred;
-EXPECT
-push on reference is experimental at - line 3.
-pop on reference is experimental at - line 4.
-shift on reference is experimental at - line 5.
-unshift on reference is experimental at - line 6.
-splice on reference is experimental at - line 7.
+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 2.
+Hash %FRED missing the % in argument 1 of keys() at - line 3.
 ########
 # op.c
-use warnings 'exec' ;
+BEGIN {
+    if ($^O eq 'MacOS') {
+	print <<EOM;
+SKIPPED
+# no exec on Mac OS
+EOM
+	exit;
+    }
+}
+use warnings 'syntax' ;
 exec "$^X -e 1" ; 
 my $a
 EXPECT
-Statement unlikely to be reached at - line 4.
+Statement unlikely to be reached at - line 13.
 	(Maybe you meant system() when you said exec()?)
 ########
-# op.c, no warning if exec isn't a statement.
-use warnings 'exec' ;
-$a || exec "$^X -e 1" ;
-my $a
-EXPECT
-########
-# op.c
-defined(@a);
-EXPECT
-defined(@array) is deprecated at - line 2.
-	(Maybe you should just omit the defined()?)
-########
 # op.c
+use warnings 'deprecated' ;
 my @a; defined(@a);
 EXPECT
-defined(@array) is deprecated at - line 2.
+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 2.
-	(Maybe you should just omit the defined()?)
-########
-# op.c
-defined(%h);
-EXPECT
-defined(%hash) is deprecated at - line 2.
+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 2.
+defined(%hash) is deprecated at - line 3.
 	(Maybe you should just omit the defined()?)
 ########
 # op.c
-no warnings 'exec' ;
+BEGIN {
+    if ($^O eq 'MacOS') {
+	print <<EOM;
+SKIPPED
+# no exec on Mac OS
+EOM
+	exit;
+    }
+}
+no warnings 'syntax' ;
 exec "$^X -e 1" ; 
 my $a
 EXPECT
@@ -1113,83 +865,8 @@ EXPECT
 # op.c
 sub fred();
 sub fred($) {}
-use constant foo=>bar; sub foo(@);
-use constant bav=>bar; sub bav(); # no warning
-sub btu; sub btu();
 EXPECT
 Prototype mismatch: sub main::fred () vs ($) at - line 3.
-Prototype mismatch: sub foo () vs (@) at - line 4.
-Prototype mismatch: sub btu: none vs () at - line 6.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-sub frèd();
-sub frèd($) {}
-EXPECT
-Prototype mismatch: sub main::frèd () vs ($) at - line 5.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-eval "sub fòò (@\$\0) {}";
-EXPECT
-Prototype after '@' for main::fòò : @$\0 at (eval 1) line 1.
-Illegal character in prototype for main::fòò : @$\0 at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-eval "sub foo (@\0) {}";
-EXPECT
-Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { $::{"foo"} = "\@\$\0L\351on" }
-BEGIN { eval "sub foo (@\$\0L\x{c3}\x{a9}on) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @$\x{0}L... at (eval 1) line 1.
-Illegal character in prototype for main::foo : @$\x{0}L... at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { eval "sub foo (@\0) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @\0 at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\0 at (eval 1) line 1.
-########
-# op.c
-use warnings;
-eval "sub foo (@\xAB) {}";
-EXPECT
-Prototype after '@' for main::foo : @\x{ab} at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\x{ab} at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { eval "sub foo (@\x{30cb}) {}"; }
-EXPECT
-Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1.
-Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-BEGIN { $::{"foo"} = "\x{30cb}" }
-BEGIN { eval "sub foo {}"; }
-EXPECT
-Prototype mismatch: sub main::foo (ニ) vs none at (eval 1) line 1.
 ########
 # op.c
 $^W = 0 ;
@@ -1210,217 +887,12 @@ 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 [S_simplify_sort]
-# [perl #86136]
-my @tests = split /^/, '
-  sort {$a <=> $b} @a;
-  sort {$a cmp $b} @a;
-  { use integer; sort {$a <=> $b} @a}
-  sort {$b <=> $a} @a;
-  sort {$b cmp $a} @a;
-  { use integer; sort {$b <=> $a} @a}
-';
-for my $pragma ('use warnings "syntax";', '') {
-  for my $vars ('', 'my $a;', 'my $b;', 'my ($a,$b);') {
-    for my $inner_stmt ('', 'print;', 'func();') {
-      eval "#line " . ++$line . "01 -\n$pragma\n$vars"
-          . join "", map s/sort \{\K/$inner_stmt/r, @tests;
-      $@ and die;
-    }
-  }
-}
-sub func{}
-use warnings 'syntax';
-my $a;
-# These used to be errors!
-sort { ; } $a <=> $b;
-sort { ; } $a, "<=>";
-sort { ; } $a, $cmp;
-sort $a, $b if $cmpany_name;
-sort if $a + $cmp;
-sort @t; $a + $cmp;
-EXPECT
-"my $a" used in sort comparison at - line 403.
-"my $a" used in sort comparison at - line 404.
-"my $a" used in sort comparison at - line 405.
-"my $a" used in sort comparison at - line 406.
-"my $a" used in sort comparison at - line 407.
-"my $a" used in sort comparison at - line 408.
-"my $a" used in sort comparison at - line 503.
-"my $a" used in sort comparison at - line 504.
-"my $a" used in sort comparison at - line 505.
-"my $a" used in sort comparison at - line 506.
-"my $a" used in sort comparison at - line 507.
-"my $a" used in sort comparison at - line 508.
-"my $a" used in sort comparison at - line 603.
-"my $a" used in sort comparison at - line 604.
-"my $a" used in sort comparison at - line 605.
-"my $a" used in sort comparison at - line 606.
-"my $a" used in sort comparison at - line 607.
-"my $a" used in sort comparison at - line 608.
-"my $b" used in sort comparison at - line 703.
-"my $b" used in sort comparison at - line 704.
-"my $b" used in sort comparison at - line 705.
-"my $b" used in sort comparison at - line 706.
-"my $b" used in sort comparison at - line 707.
-"my $b" used in sort comparison at - line 708.
-"my $b" used in sort comparison at - line 803.
-"my $b" used in sort comparison at - line 804.
-"my $b" used in sort comparison at - line 805.
-"my $b" used in sort comparison at - line 806.
-"my $b" used in sort comparison at - line 807.
-"my $b" used in sort comparison at - line 808.
-"my $b" used in sort comparison at - line 903.
-"my $b" used in sort comparison at - line 904.
-"my $b" used in sort comparison at - line 905.
-"my $b" used in sort comparison at - line 906.
-"my $b" used in sort comparison at - line 907.
-"my $b" used in sort comparison at - line 908.
-"my $a" used in sort comparison at - line 1003.
-"my $b" used in sort comparison at - line 1003.
-"my $a" used in sort comparison at - line 1004.
-"my $b" used in sort comparison at - line 1004.
-"my $a" used in sort comparison at - line 1005.
-"my $b" used in sort comparison at - line 1005.
-"my $b" used in sort comparison at - line 1006.
-"my $a" used in sort comparison at - line 1006.
-"my $b" used in sort comparison at - line 1007.
-"my $a" used in sort comparison at - line 1007.
-"my $b" used in sort comparison at - line 1008.
-"my $a" used in sort comparison at - line 1008.
-"my $a" used in sort comparison at - line 1103.
-"my $b" used in sort comparison at - line 1103.
-"my $a" used in sort comparison at - line 1104.
-"my $b" used in sort comparison at - line 1104.
-"my $a" used in sort comparison at - line 1105.
-"my $b" used in sort comparison at - line 1105.
-"my $b" used in sort comparison at - line 1106.
-"my $a" used in sort comparison at - line 1106.
-"my $b" used in sort comparison at - line 1107.
-"my $a" used in sort comparison at - line 1107.
-"my $b" used in sort comparison at - line 1108.
-"my $a" used in sort comparison at - line 1108.
-"my $a" used in sort comparison at - line 1203.
-"my $b" used in sort comparison at - line 1203.
-"my $a" used in sort comparison at - line 1204.
-"my $b" used in sort comparison at - line 1204.
-"my $a" used in sort comparison at - line 1205.
-"my $b" used in sort comparison at - line 1205.
-"my $b" used in sort comparison at - line 1206.
-"my $a" used in sort comparison at - line 1206.
-"my $b" used in sort comparison at - line 1207.
-"my $a" used in sort comparison at - line 1207.
-"my $b" used in sort comparison at - line 1208.
-"my $a" used in sort comparison at - line 1208.
-########
-# op.c [S_simplify_sort]
-use warnings 'syntax'; use 5.01;
-state $a;
-sort { $a <=> $b } ();
-EXPECT
-"state $a" used in sort comparison at - line 4.
-########
-# op.c [Perl_ck_cmp]
-use warnings 'syntax' ;
-no warnings 'deprecated';
-@a = $[ < 5;
-@a = $[ > 5;
-@a = $[ <= 5;
-@a = $[ >= 5;
-@a = 42 < $[;
-@a = 42 > $[;
-@a = 42 <= $[;
-@a = 42 >= $[;
-use integer;
-@a = $[ < 5;
-@a = $[ > 5;
-@a = $[ <= 5;
-@a = $[ >= 5;
-@a = 42 < $[;
-@a = 42 > $[;
-@a = 42 <= $[;
-@a = 42 >= $[;
-no integer;
-@a = $[ < $5;
-@a = $[ > $5;
-@a = $[ <= $5;
-@a = $[ >= $5;
-@a = $42 < $[;
-@a = $42 > $[;
-@a = $42 <= $[;
-@a = $42 >= $[;
-use integer;
-@a = $[ < $5;
-@a = $[ > $5;
-@a = $[ <= $5;
-@a = $[ >= $5;
-@a = $42 < $[;
-@a = $42 > $[;
-@a = $42 <= $[;
-@a = $42 >= $[;
-EXPECT
-$[ used in numeric lt (<) (did you mean $] ?) at - line 4.
-$[ used in numeric gt (>) (did you mean $] ?) at - line 5.
-$[ used in numeric le (<=) (did you mean $] ?) at - line 6.
-$[ used in numeric ge (>=) (did you mean $] ?) at - line 7.
-$[ used in numeric lt (<) (did you mean $] ?) at - line 8.
-$[ used in numeric gt (>) (did you mean $] ?) at - line 9.
-$[ used in numeric le (<=) (did you mean $] ?) at - line 10.
-$[ used in numeric ge (>=) (did you mean $] ?) at - line 11.
-$[ used in numeric lt (<) (did you mean $] ?) at - line 13.
-$[ used in numeric gt (>) (did you mean $] ?) at - line 14.
-$[ used in numeric le (<=) (did you mean $] ?) at - line 15.
-$[ used in numeric ge (>=) (did you mean $] ?) at - line 16.
-$[ used in numeric lt (<) (did you mean $] ?) at - line 17.
-$[ used in numeric gt (>) (did you mean $] ?) at - line 18.
-$[ used in numeric le (<=) (did you mean $] ?) at - line 19.
-$[ used in numeric ge (>=) (did you mean $] ?) at - line 20.
-########
-# op.c [Perl_ck_each]
-$fred = {};
-keys $fred;
-values $fred;
-each $fred;
-no warnings 'experimental::autoderef' ;
-keys $fred;
-values $fred;
-each $fred;
-EXPECT
-keys on reference is experimental at - line 3.
-values on reference is experimental at - line 4.
-each on reference is experimental at - line 5.
-########
-# op.c [Perl_ck_length]
-use warnings 'syntax' ;
-length(@a);
-length(%b);
-length(@$c);
-length(%$d);
-length($a);
-length(my %h);
-length(my @g);
-EXPECT
-length() used on @a (did you mean "scalar(@a)"?) at - line 3.
-length() used on %b (did you mean "scalar(keys %b)"?) at - line 4.
-length() used on @array (did you mean "scalar(@array)"?) at - line 5.
-length() used on %hash (did you mean "scalar(keys %hash)"?) at - line 6.
-length() used on %h (did you mean "scalar(keys %h)"?) at - line 8.
-length() used on @g (did you mean "scalar(@g)"?) at - line 9.
-########
 # op.c
 use warnings 'syntax' ;
 join /---/, 'x', 'y', 'z';
 EXPECT
 /---/ should probably be written as "---" at - line 3.
 ########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'syntax' ;
-join /～～～/, 'x', 'y', 'z';
-EXPECT
-/～～～/ should probably be written as "～～～" at - line 5.
-########
 # op.c [Perl_peep]
 use warnings 'prototype' ;
 fred() ; 
@@ -1495,6 +967,16 @@ Useless use of push with no values at - line 4.
 Useless use of unshift with no values at - line 5.
 ########
 # op.c
+use warnings 'deprecated' ;
+package;
+no warnings 'deprecated' ;
+package;
+EXPECT
+Use of "package" with no arguments is deprecated at - line 3.
+Global symbol "BEGIN" requires explicit package name at - line 4.
+BEGIN not safe after errors--compilation aborted at - line 4.
+########
+# op.c
 # 20020401 mjd@plover.com at suggestion of jfriedl@yahoo.com
 use warnings 'regexp';
 split /blah/g, "blah";
@@ -1502,422 +984,3 @@ no warnings 'regexp';
 split /blah/g, "blah";
 EXPECT
 Use of /g modifier is meaningless in split at - line 4.
-########
-# op.c
-use warnings 'precedence';
-$a = $b & $c == $d;
-$a = $b ^ $c != $d;
-$a = $b | $c > $d;
-$a = $b < $c & $d;
-$a = $b >= $c ^ $d;
-$a = $b <= $c | $d;
-$a = $b <=> $c & $d;
-$a &= $b == $c; $a |= $b == $c; $a ^= $b == $c; # shouldn't warn
-no warnings 'precedence';
-$a = $b & $c == $d;
-$a = $b ^ $c != $d;
-$a = $b | $c > $d;
-$a = $b < $c & $d;
-$a = $b >= $c ^ $d;
-$a = $b <= $c | $d;
-$a = $b <=> $c & $d;
-EXPECT
-Possible precedence problem on bitwise & operator at - line 3.
-Possible precedence problem on bitwise ^ operator at - line 4.
-Possible precedence problem on bitwise | operator at - line 5.
-Possible precedence problem on bitwise & operator at - line 6.
-Possible precedence problem on bitwise ^ operator at - line 7.
-Possible precedence problem on bitwise | operator at - line 8.
-Possible precedence problem on bitwise & operator at - line 9.
-########
-# op.c
-use integer;
-use warnings 'precedence';
-$a = $b & $c == $d;
-$a = $b ^ $c != $d;
-$a = $b | $c > $d;
-$a = $b < $c & $d;
-$a = $b >= $c ^ $d;
-$a = $b <= $c | $d;
-$a = $b <=> $c & $d;
-no warnings 'precedence';
-$a = $b & $c == $d;
-$a = $b ^ $c != $d;
-$a = $b | $c > $d;
-$a = $b < $c & $d;
-$a = $b >= $c ^ $d;
-$a = $b <= $c | $d;
-$a = $b <=> $c & $d;
-EXPECT
-Possible precedence problem on bitwise & operator at - line 4.
-Possible precedence problem on bitwise ^ operator at - line 5.
-Possible precedence problem on bitwise | operator at - line 6.
-Possible precedence problem on bitwise & operator at - line 7.
-Possible precedence problem on bitwise ^ operator at - line 8.
-Possible precedence problem on bitwise | operator at - line 9.
-Possible precedence problem on bitwise & operator at - line 10.
-########
-# op.c
-
-# ok	=> local() has desired effect;
-# ignore=> local() silently ignored
-
-use warnings 'syntax';
-
-local(undef);		# OP_UNDEF		ignore
-sub lval : lvalue {};
-local(lval());		# OP_ENTERSUB
-local($x **= 1);	# OP_POW
-local($x *=  1);	# OP_MULTIPLY
-local($x /=  1);	# OP_DIVIDE
-local($x %=  1);	# OP_MODULO
-local($x x=  1);	# OP_REPEAT
-local($x +=  1);	# OP_ADD
-local($x -=  1);	# OP_SUBTRACT
-local($x .=  1);	# OP_CONCAT
-local($x <<= 1);	# OP_LEFT_SHIFT
-local($x >>= 1);	# OP_RIGHT_SHIFT
-local($x &=  1);	# OP_BIT_AND
-local($x ^=  1);	# OP_BIT_XOR
-local($x |=  1);	# OP_BIT_OR
-{
-    use integer;
-    local($x *= 1);	# OP_I_MULTIPLY
-    local($x /= 1);	# OP_I_DIVIDE
-    local($x %= 1);	# OP_I_MODULO
-    local($x += 1);	# OP_I_ADD
-    local($x -= 1);	# OP_I_SUBTRACT
-}
-local($x?$y:$z) = 1;	# OP_COND_EXPR		ok
-# these two are fatal run-time errors instead
-#local(@$a);		# OP_RV2AV		ok
-#local(%$a);		# OP_RV2HV		ok
-local(*a);		# OP_RV2GV		ok
-local(@a[1,2]);		# OP_ASLICE		ok
-local(@a{1,2});		# OP_HSLICE		ok
-local(@a = (1,2));	# OP_AASSIGN
-local($$x);		# OP_RV2SV		ok
-local($#a);		# OP_AV2ARYLEN
-local($x =   1);	# OP_SASSIGN
-local($x &&= 1);	# OP_ANDASSIGN
-local($x ||= 1);	# OP_ORASSIGN
-local($x //= 1);	# OP_DORASSIGN
-local($a[0]);		# OP_AELEMFAST		ok
-
-local(substr($x,0,1));	# OP_SUBSTR
-local(pos($x));		# OP_POS
-local(vec($x,0,1));	# OP_VEC
-local($a[$b]);		# OP_AELEM		ok
-local($a{$b});		# OP_HELEM		ok
-
-no warnings 'syntax';
-EXPECT
-Useless localization of subroutine entry at - line 10.
-Useless localization of exponentiation (**) at - line 11.
-Useless localization of multiplication (*) at - line 12.
-Useless localization of division (/) at - line 13.
-Useless localization of modulus (%) at - line 14.
-Useless localization of repeat (x) at - line 15.
-Useless localization of addition (+) at - line 16.
-Useless localization of subtraction (-) at - line 17.
-Useless localization of concatenation (.) or string at - line 18.
-Useless localization of left bitshift (<<) at - line 19.
-Useless localization of right bitshift (>>) at - line 20.
-Useless localization of bitwise and (&) at - line 21.
-Useless localization of bitwise xor (^) at - line 22.
-Useless localization of bitwise or (|) at - line 23.
-Useless localization of integer multiplication (*) at - line 26.
-Useless localization of integer division (/) at - line 27.
-Useless localization of integer modulus (%) at - line 28.
-Useless localization of integer addition (+) at - line 29.
-Useless localization of integer subtraction (-) at - line 30.
-Useless localization of list assignment at - line 39.
-Useless localization of array length at - line 41.
-Useless localization of scalar assignment at - line 42.
-Useless localization of logical and assignment (&&=) at - line 43.
-Useless localization of logical or assignment (||=) at - line 44.
-Useless localization of defined or assignment (//=) at - line 45.
-Useless localization of substr at - line 48.
-Useless localization of match position at - line 49.
-Useless localization of vec at - line 50.
-########
-# op.c
-my $x1 if 0;
-my @x2 if 0;
-my %x3 if 0;
-my ($x4) if 0;
-my ($x5,@x6, %x7) if 0;
-0 && my $z1;
-0 && my (%z2);
-# these shouldn't warn
-our $x if 0;
-our $x unless 0;
-if (0) { my $w1 }
-if (my $w2) { $a=1 }
-if ($a && (my $w3 = 1)) {$a = 2}
-
-EXPECT
-Deprecated use of my() in false conditional at - line 2.
-Deprecated use of my() in false conditional at - line 3.
-Deprecated use of my() in false conditional at - line 4.
-Deprecated use of my() in false conditional at - line 5.
-Deprecated use of my() in false conditional at - line 6.
-Deprecated use of my() in false conditional at - line 7.
-Deprecated use of my() in false conditional at - line 8.
-########
-# op.c
-$[ = 1;
-($[) = 1;
-use warnings 'deprecated';
-$[ = 2;
-($[) = 2;
-no warnings 'deprecated';
-$[ = 3;
-($[) = 3;
-EXPECT
-Use of assignment to $[ is deprecated at - line 2.
-Use of assignment to $[ is deprecated at - line 3.
-Use of assignment to $[ is deprecated at - line 5.
-Use of assignment to $[ is deprecated at - line 6.
-########
-# op.c
-use warnings 'void';
-@x = split /y/, "z";
-$x = split /y/, "z";
-     split /y/, "z";
-no warnings 'void';
-@x = split /y/, "z";
-$x = split /y/, "z";
-     split /y/, "z";
-EXPECT
-Useless use of split in void context at - line 5.
-########
-# op.c
-use warnings 'redefine' ;
-use utf8;
-use open qw( :utf8 :std );
-sub frèd {}
-sub frèd {}
-no warnings 'redefine' ;
-sub frèd {}
-EXPECT
-Subroutine frèd redefined at - line 6.
-########
-# op.c
-use warnings 'redefine' ;
-use utf8;
-use open qw( :utf8 :std );
-sub frèd () { 1 }
-sub frèd () { 1 }
-no warnings 'redefine' ;
-sub frèd () { 1 }
-EXPECT
-Constant subroutine frèd redefined at - line 6.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-sub frèd () { 1 }
-sub frèd () { 2 }
-EXPECT
-Constant subroutine frèd redefined at - line 5.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-sub frèd () { 1 }
-*frèd = sub () { 2 };
-EXPECT
-Constant subroutine main::frèd redefined at - line 5.
-########
-# op.c
-use warnings 'redefine' ;
-use utf8;
-use open qw( :utf8 :std );
-sub ᚠርƊ {}
-sub ᚠርƊ {}
-no warnings 'redefine' ;
-sub ᚠርƊ {}
-EXPECT
-Subroutine ᚠርƊ redefined at - line 6.
-########
-# op.c
-use warnings 'redefine' ;
-use utf8;
-use open qw( :utf8 :std );
-sub ᚠርƊ () { 1 }
-sub ᚠርƊ () { 1 }
-no warnings 'redefine' ;
-sub ᚠርƊ () { 1 }
-EXPECT
-Constant subroutine ᚠርƊ redefined at - line 6.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-sub ᚠርƊ () { 1 }
-sub ᚠርƊ () { 2 }
-EXPECT
-Constant subroutine ᚠርƊ redefined at - line 5.
-########
-# op.c
-use utf8;
-use open qw( :utf8 :std );
-sub ᚠርƊ () { 1 }
-*ᚠርƊ = sub () { 2 };
-EXPECT
-Constant subroutine main::ᚠርƊ redefined at - line 5.
-########
-# OPTION regex
-sub DynaLoader::dl_error {};
-use warnings;
-# We're testing that the warnings report the same line number:
-eval <<'EOC' or die $@;
-{
-    DynaLoader::boot_DynaLoader("DynaLoader");
-}
-EOC
-eval <<'EOC' or die $@;
-BEGIN {
-    DynaLoader::boot_DynaLoader("DynaLoader");
-}
-1
-EOC
-EXPECT
-OPTION regex
-\ASubroutine DynaLoader::dl_error redefined at \(eval 1\) line 2\.
-?(?s).*
-Subroutine DynaLoader::dl_error redefined at \(eval 2\) line 2\.
-########
-# op.c
-use warnings;
-sub do_warn_1  { return $a or $b; }
-sub do_warn_2  { return $a and $b; }
-sub do_warn_3  { return $a xor $b; }
-sub do_warn_4  { die $a or $b; }
-sub do_warn_5  { die $a and $b; }
-sub do_warn_6  { die $a xor $b; }
-sub do_warn_7  { exit $a or $b; }
-sub do_warn_8  { exit $a and $b; }
-sub do_warn_9  { exit $a xor $b; }
-
-# Since exit is an unary operator, it is even stronger than
-# || and &&.
-sub do_warn_10 { exit $a || $b; }
-sub do_warn_11 { exit $a && $b; }
-
-sub do_warn_12 { goto $a or $b; }
-sub do_warn_13 { goto $a and $b; }
-sub do_warn_14 { goto $a xor $b; }
-sub do_warn_15 { next $a or $b while(1);  }
-sub do_warn_16 { next $a and $b while(1); }
-sub do_warn_17 { next $a xor $b while(1); }
-sub do_warn_18 { last $a or $b while(1);  }
-sub do_warn_19 { last $a and $b while(1); }
-sub do_warn_20 { last $a xor $b while(1); }
-sub do_warn_21 { redo $a or $b while(1); }
-sub do_warn_22 { redo $a and $b while(1); }
-sub do_warn_23 { redo $a xor $b while(1); }
-# These get re-written to "(return/die $a) and $b"
-sub do_warn_24 { $b if return $a; }
-sub do_warn_25 { $b if die $a; }
-EXPECT
-Possible precedence issue with control flow operator at - line 3.
-Possible precedence issue with control flow operator at - line 4.
-Possible precedence issue with control flow operator at - line 5.
-Possible precedence issue with control flow operator at - line 6.
-Possible precedence issue with control flow operator at - line 7.
-Possible precedence issue with control flow operator at - line 8.
-Possible precedence issue with control flow operator at - line 9.
-Possible precedence issue with control flow operator at - line 10.
-Possible precedence issue with control flow operator at - line 11.
-Possible precedence issue with control flow operator at - line 15.
-Possible precedence issue with control flow operator at - line 16.
-Possible precedence issue with control flow operator at - line 18.
-Possible precedence issue with control flow operator at - line 19.
-Possible precedence issue with control flow operator at - line 20.
-Possible precedence issue with control flow operator at - line 21.
-Possible precedence issue with control flow operator at - line 22.
-Possible precedence issue with control flow operator at - line 23.
-Possible precedence issue with control flow operator at - line 24.
-Possible precedence issue with control flow operator at - line 25.
-Possible precedence issue with control flow operator at - line 26.
-Possible precedence issue with control flow operator at - line 27.
-Possible precedence issue with control flow operator at - line 28.
-Possible precedence issue with control flow operator at - line 29.
-Possible precedence issue with control flow operator at - line 31.
-Possible precedence issue with control flow operator at - line 32.
-########
-# op.c
-#  (same as above, except these should not warn)
-use constant FEATURE => 1;
-use constant MISSING_FEATURE => 0;
-
-sub dont_warn_1  { MISSING_FEATURE and return or dont_warn_3(); }
-sub dont_warn_2  { FEATURE || return and dont_warn_3(); }
-sub dont_warn_3  { not FEATURE and return or dont_warn_3(); }
-sub dont_warn_4  { !MISSING_FEATURE || return and dont_warn_3(); }
-sub dont_warn_5  { MISSING_FEATURE and die or dont_warn_3(); }
-sub dont_warn_6  { FEATURE || die and dont_warn_3(); }
-sub dont_warn_7  { not FEATURE and die or dont_warn_3(); }
-sub dont_warn_8  { !MISSING_FEATURE || die and dont_warn_3(); }
-sub dont_warn_9  { MISSING_FEATURE and goto $a or dont_warn_3(); }
-sub dont_warn_10 { FEATURE || goto $a and dont_warn_3(); }
-sub dont_warn_11 { not FEATURE and goto $a or dont_warn_3(); }
-sub dont_warn_12 { !MISSING_FEATURE || goto $a and dont_warn_3(); }
-
-sub dont_warn_13 { MISSING_FEATURE and exit $a or dont_warn_3(); }
-sub dont_warn_14 { FEATURE || exit $a and dont_warn_3(); }
-sub dont_warn_15 { not FEATURE and exit $a or dont_warn_3(); }
-sub dont_warn_16 { !MISSING_FEATURE || exit $a and dont_warn_3(); }
-
-sub dont_warn_17 { MISSING_FEATURE and next or dont_warn_3() while(1); }
-sub dont_warn_18 { FEATURE || next and dont_warn_3() while(1); }
-sub dont_warn_19 { not FEATURE and next or dont_warn_3() while(1); }
-sub dont_warn_20 { !MISSING_FEATURE || next and dont_warn_3() while(1); }
-sub dont_warn_21 { MISSING_FEATURE and redo or dont_warn_3() while(1); }
-sub dont_warn_22 { FEATURE || redo and dont_warn_3() while(1); }
-sub dont_warn_23 { not FEATURE and redo or dont_warn_3() while(1); }
-sub dont_warn_24 { !MISSING_FEATURE || redo and dont_warn_3() while(1); }
-sub dont_warn_25 { MISSING_FEATURE and last or dont_warn_3() while(1); }
-sub dont_warn_26 { FEATURE || last and dont_warn_3() while(1); }
-sub dont_warn_27 { not FEATURE and last or dont_warn_3() while(1); }
-sub dont_warn_28 { !MISSING_FEATURE || last and dont_warn_3() while(1); }
-
-# These are weird, but at least not ambiguous.
-sub dont_warn_29 { return ($a or $b); }
-sub dont_warn_30 { return ($a and $b); }
-sub dont_warn_31 { return ($a xor $b); }
-sub dont_warn_32 { die ($a or $b); }
-sub dont_warn_33 { die ($a and $b); }
-sub dont_warn_34 { die ($a xor $b); }
-sub dont_warn_35 { goto ($a or $b); }
-sub dont_warn_36 { goto ($a and $b); }
-sub dont_warn_37 { goto ($a xor $b); }
-sub dont_warn_38 { next ($a or $b) while(1);  }
-sub dont_warn_39 { next ($a and $b) while(1); }
-sub dont_warn_40 { next ($a xor $b) while(1); }
-sub dont_warn_41 { last ($a or $b) while(1);  }
-sub dont_warn_42 { last ($a and $b) while(1); }
-sub dont_warn_43 { last ($a xor $b) while(1); }
-sub dont_warn_44 { redo ($a or $b) while(1);  }
-sub dont_warn_45 { redo ($a and $b) while(1); }
-sub dont_warn_46 { redo ($a xor $b) while(1); }
-EXPECT
-########
-use feature "signatures";
-sub aaa { 2 }
-sub bbb ($a) { 4 }
-$aaa = sub { 2 };
-$bbb = sub ($a) { 4 };
-EXPECT
-The signatures feature is experimental at - line 3.
-The signatures feature is experimental at - line 5.
-########
-no warnings "experimental::signatures";
-use feature "signatures";
-sub aaa { 2 }
-sub bbb ($a) { 4 }
-$aaa = sub { 2 };
-$bbb = sub ($a) { 4 };
-EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/warnings/perlio b/gnu/usr.bin/perl/t/lib/warnings/perlio
index 0ccc5a884f4..63279ee0fe8 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/perlio
+++ b/gnu/usr.bin/perl/t/lib/warnings/perlio
@@ -8,16 +8,16 @@
     Setting cnt to %d, ptr implies %d
 
 
-Invalid separator character %c%c%c in PerlIO layer specification %s
+perlio: invalid separator character %c%c%c in layer specification list %s
 
     open(F, ">:-aa", "bb")
 
 
-Argument list not closed for PerlIO layer \"%.*s\""
+perlio: argument list not closed for layer \"%.*s\""
 
     open(F, ">:aa(", "bb")
 
-Unknown PerlIO layer \"%.*s\"
+perlio: unknown layer \"%.*s\"
 
     # PerlIO/xyz.pm has 1;
     open(F, ">xyz", "bb")
@@ -31,7 +31,7 @@ use warnings 'layer';
 open(F, ">:-aa", "bb");
 close F;
 EXPECT
-Invalid separator character '-' in PerlIO layer specification -aa at - line 6.
+perlio: invalid separator character '-' in layer specification list -aa at - line 6.
 ########
 
 # perlio [PerlIO_parse_layers]
@@ -41,10 +41,10 @@ use warnings 'layer';
 open(F, ">:aa(", "bb");
 close F;
 EXPECT
-Argument list not closed for PerlIO layer "aa(" at - line 6.
+perlio: argument list not closed for layer "aa(" at - line 6.
 ########
 
---FILE-- PerlIO_test_dir/xyz.pm
+--FILE-- PerlIO/xyz.pm
 1;
 --FILE--
 # perlio [PerlIO_parse_layers]
@@ -55,4 +55,4 @@ open(F, ">:xyz", "bb");
 close F;
 END { 1 while unlink "bb" } # KEEP THIS WITH THE LAST TEST.
 EXPECT
-Unknown PerlIO layer "xyz" at - line 5.
+perlio: unknown layer "xyz".
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp b/gnu/usr.bin/perl/t/lib/warnings/pp
index ab8f9516518..5ed7aa08916 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp
@@ -6,6 +6,9 @@
   Attempt to use reference as lvalue in substr 
     $a = "ab" ; $b = \$a ;  substr($b, 1,1) = $b
 
+  Use of uninitialized value in ref-to-glob cast	[pp_rv2gv()]
+	*b = *{ undef()}
+
   Use of uninitialized value in scalar dereference	[pp_rv2sv()]
 	my $a = undef ; my $b = $$a
 
@@ -37,35 +40,18 @@ use warnings 'substr' ;
 $a = "ab" ; 
 $b = \$a ;  
 substr($b, 1,1) = "ab" ;
-$b = \$a;
-substr($b, 1,1) = "\x{100}" ;
 no warnings 'substr' ;
-$b = \$a;
 substr($b, 1,1) = "ab" ;
-$b = \$a;
-substr($b, 1,1) = "\x{100}" ;
 EXPECT
 Attempt to use reference as lvalue in substr at - line 5.
-Attempt to use reference as lvalue in substr at - line 7.
 ########
 # pp.c
-use warnings 'misc' ;
-@a = qw( a b c );
-splice(@a, 4, 0, 'e') ;
-@a = qw( a b c );
-splice(@a, 4, 1) ;
-@a = qw( a b c );
-splice(@a, 4) ;
-no warnings 'misc' ;
-@a = qw( a b c );
-splice(@a, 4, 0, 'e') ;
-@a = qw( a b c );
-splice(@a, 4, 1) ;
-@a = qw( a b c );
-splice(@a, 4) ;
+use warnings 'uninitialized' ;
+*x = *{ undef() };
+no warnings 'uninitialized' ;
+*y = *{ undef() };
 EXPECT
-splice() offset past end of array at - line 4.
-splice() offset past end of array at - line 6.
+Use of uninitialized value in ref-to-glob cast at - line 3.
 ########
 # pp.c
 use warnings 'uninitialized';
@@ -73,7 +59,7 @@ $x = undef; $y = $$x;
 no warnings 'uninitialized' ;
 $u = undef; $v = $$u;
 EXPECT
-Use of uninitialized value $x in scalar dereference at - line 3.
+Use of uninitialized value in scalar dereference at - line 3.
 ########
 # pp.c
 use warnings 'misc' ;
@@ -102,18 +88,6 @@ EXPECT
 Constant subroutine foo undefined at - line 4.
 ########
 # pp.c
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'misc';
-sub �ᶱ () { 1 }
-undef &�ᶱ;
-no warnings 'misc';
-sub Æš () { 2 }
-undef &Æš;
-EXPECT
-Constant subroutine �ᶱ undefined at - line 6.
-########
-# pp.c
 use warnings 'misc';
 $foo = sub () { 3 };
 undef &$foo;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_hot b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
index 4e63073bff8..c008dd5f106 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_hot
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
@@ -44,6 +44,9 @@
   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";
+
   Use of reference "%s" as array index [pp_aelem]
     $x[\1]
 
@@ -54,22 +57,10 @@ $f = $a = "abc" ;
 print $f $a;
 no warnings 'unopened' ;
 print $f $a;
-use warnings;
-no warnings 'unopened' ;
-print $f $a;
 EXPECT
 print() on unopened filehandle abc at - line 4.
 ########
 # pp_hot.c [pp_print]
-use warnings 'unopened' ;
-$SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
-print {"a\0b"} "anc";
-print {"\0b"} "anc";
-EXPECT
-print() on unopened filehandle a\0b at - line 4.
-print() on unopened filehandle \0b at - line 5.
-########
-# pp_hot.c [pp_print]
 use warnings 'io' ;
 # There is no guarantee that STDOUT is output only, or STDIN input only.
 # Certainly on some BSDs (at least FreeBSD, Darwin, BSDi) file descriptors
@@ -99,24 +90,6 @@ Filehandle FH opened only for input at - line 19.
 Filehandle FOO opened only for input at - line 20.
 ########
 # pp_hot.c [pp_print]
-$SIG{__WARN__} = sub { warn $_[0] =~ s/\0/\\0/rug; };
-use warnings 'io' ;
-my $file = "./xcv" ; unlink $file ;
-open (FH, ">$file") or die $! ;
-close FH or die $! ;
-die "There is no file $file" unless -f $file ;
-open ("a\0b", "<$file") or die $! ;
-print {"a\0b"} "anc" ;
-open ("\0b", "<$file") or die $! ;
-print {"\0b"} "anc" ;
-close "a\0b" or die $! ;
-close "\0b" or die $! ;
-unlink $file ;
-EXPECT
-Filehandle a\0b opened only for input at - line 9.
-Filehandle \0b opened only for input at - line 11.
-########
-# pp_hot.c [pp_print]
 use warnings 'closed' ;
 close STDIN ;
 print STDIN "anc";
@@ -127,9 +100,6 @@ no warnings 'closed' ;
 print STDIN "anc";
 opendir STDIN, ".";
 print STDIN "anc";
-use warnings;
-no warnings 'closed' ;
-print STDIN "anc";
 EXPECT
 print() on closed filehandle STDIN at - line 4.
 print() on closed filehandle STDIN at - line 6.
@@ -143,7 +113,7 @@ my $fh = *STDOUT{IO};
 close STDOUT or die "Can't close STDOUT";
 print $fh "Shouldn't print anything, but shouldn't SEGV either\n";
 EXPECT
-print() on closed filehandle __ANONIO__ at - line 7.
+print() on closed filehandle at - line 7.
 ########
 # pp_hot.c [pp_print]
 package foo;
@@ -169,7 +139,7 @@ my @b = @$a;
 no warnings 'uninitialized' ;
 my @c = @$a;
 EXPECT
-Use of uninitialized value $a in array dereference at - line 4.
+Use of uninitialized value in array dereference at - line 4.
 ########
 # pp_hot.c [pp_rv2hv]
 use warnings 'uninitialized' ;
@@ -178,7 +148,7 @@ my %b = %$a;
 no warnings 'uninitialized' ;
 my %c = %$a;
 EXPECT
-Use of uninitialized value $a in hash dereference at - line 4.
+Use of uninitialized value in hash dereference at - line 4.
 ########
 # pp_hot.c [pp_aassign]
 use warnings 'misc' ;
@@ -210,19 +180,6 @@ readline() on closed filehandle STDIN at - line 4.
 	(Are you trying to call readline() on dirhandle STDIN?)
 ########
 # 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 STDIN at - line 3.
-readline() on closed filehandle STDIN at - line 4.
-	(Are you trying to call readline() on dirhandle STDIN?)
-########
-# pp_hot.c [Perl_do_readline]
 use warnings 'io' ;
 my $file = "./xcv" ; unlink $file ;
 open (FH, ">$file") or die $! ;
@@ -306,11 +263,37 @@ a($x . $y);	# should warn twice
 $x .= $y;	# should warn once
 $y .= $y;	# should warn once
 EXPECT
-Use of uninitialized value $x in concatenation (.) or string at - line 5.
-Use of uninitialized value $x in concatenation (.) or string at - line 6.
-Use of uninitialized value $y in concatenation (.) or string at - line 6.
-Use of uninitialized value $y in concatenation (.) or string at - line 7.
-Use of uninitialized value $y in concatenation (.) or string at - line 8.
+Use of uninitialized value in concatenation (.) or string at - line 5.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 6.
+Use of uninitialized value in concatenation (.) or string at - line 7.
+Use of uninitialized value in concatenation (.) or string at - line 8.
+########
+# 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";
+$yy = 19;
+$x     = "ok $yy\n";
+$yy = 9;
+$x     = 1 . $yy;
+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.
 ########
 # pp_hot.c [pp_aelem]
 {
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_sys b/gnu/usr.bin/perl/t/lib/warnings/pp_sys
index 69993275a2d..be8bb6244c2 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_sys
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_sys
@@ -103,12 +103,6 @@
 
   getc() on closed filehandle			[pp_getc]
 
-  Non-string passed as bitmask			[pp_sselect]
-
-  %s too large					[pp_gmtime]
-
-  %s failed					[pp_gmtime]
-
 __END__
 # pp_sys.c [pp_untie]
 use warnings 'untie' ;
@@ -135,57 +129,21 @@ Filehandle STDIN opened only for input at - line 5.
 use warnings 'closed' ;
 format STDIN =
 .
-format FOO =
-.
 close STDIN;
 write STDIN;
-write FOO;
 opendir STDIN, ".";
 write STDIN;
 closedir STDIN;
-opendir FOO, ".";
-write FOO;
-closedir FOO;
 no warnings 'closed' ;
 write STDIN;
-write FOO;
 opendir STDIN, ".";
-opendir FOO, ".";
 write STDIN;
-write FOO;
 EXPECT
+write() on closed filehandle STDIN at - line 6.
 write() on closed filehandle STDIN at - line 8.
-write() on closed filehandle STDIN at - line 11.
 	(Are you trying to call write() on dirhandle STDIN?)
 ########
 # pp_sys.c [pp_leavewrite]
-use warnings 'unopened';
-format STDIN =
-.
-format FOO =
-.
-close STDIN;
-write STDIN;
-write FOO;
-opendir STDIN, ".";
-write STDIN;
-closedir STDIN;
-opendir FOO, ".";
-write FOO;
-closedir FOO;
-no warnings 'unopened';
-write STDIN;
-write FOO;
-opendir STDIN, ".";
-opendir FOO, ".";
-write STDIN;
-write FOO;
-EXPECT
-write() on unopened filehandle FOO at - line 9.
-write() on unopened filehandle FOO at - line 14.
-	(Are you trying to call write() on dirhandle FOO?)
-########
-# pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
 format STDOUT_TOP =
 abc
@@ -237,14 +195,6 @@ EXPECT
 Filehandle STDIN opened only for input at - line 3.
 ########
 # pp_sys.c [pp_send]
-use warnings 'io' ;
-syswrite STDIN, "fred";
-no warnings 'io' ;
-syswrite STDIN, "fred";
-EXPECT
-Filehandle STDIN opened only for input at - line 3.
-########
-# pp_sys.c [pp_send]
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
@@ -294,7 +244,7 @@ flock() on unopened filehandle FOO at - line 19.
 flock() on unopened filehandle at - line 20.
 ########
 # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
-use warnings 'closed';
+use warnings 'io' ;
 use Config; 
 BEGIN { 
   if ( $^O ne 'VMS' and ! $Config{d_socket}) {
@@ -336,29 +286,7 @@ getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
 closedir STDIN;
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-opendir FOO, ".";
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-closedir FOO;
-no warnings 'closed';
+no warnings 'io' ;
 send STDIN, "fred", 1;
 bind STDIN, "fred" ;
 connect STDIN, "fred" ;
@@ -380,27 +308,6 @@ setsockopt STDIN, 1,2,3;
 getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept FOO, "fred" ;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-opendir FOO, ".";
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
 EXPECT
 send() on closed socket STDIN at - line 22.
 bind() on closed socket STDIN at - line 23.
@@ -433,146 +340,6 @@ getsockname() on closed socket STDIN at - line 41.
 getpeername() on closed socket STDIN at - line 42.
 	(Are you trying to call getpeername() on dirhandle STDIN?)
 ########
-# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
-use warnings 'unopened';
-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;
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-opendir FOO, ".";
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-closedir FOO;
-no warnings 'unopened';
-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;
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept FOO, "fred" ;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-opendir FOO, ".";
-send FOO, "fred", 1;
-bind FOO, "fred" ;
-connect FOO, "fred" ;
-listen FOO, 2;
-accept "fred", FOO;
-shutdown FOO, 0;
-setsockopt FOO, 1,2,3;
-getsockopt FOO, 1,2;
-getsockname FOO;
-getpeername FOO;
-EXPECT
-send() on unopened socket FOO at - line 44.
-bind() on unopened socket FOO at - line 45.
-connect() on unopened socket FOO at - line 46.
-listen() on unopened socket FOO at - line 47.
-accept() on unopened socket FOO at - line 48.
-shutdown() on unopened socket FOO at - line 49.
-setsockopt() on unopened socket FOO at - line 50.
-getsockopt() on unopened socket FOO at - line 51.
-getsockname() on unopened socket FOO at - line 52.
-getpeername() on unopened socket FOO at - line 53.
-send() on unopened socket FOO at - line 55.
-	(Are you trying to call send() on dirhandle FOO?)
-bind() on unopened socket FOO at - line 56.
-	(Are you trying to call bind() on dirhandle FOO?)
-connect() on unopened socket FOO at - line 57.
-	(Are you trying to call connect() on dirhandle FOO?)
-listen() on unopened socket FOO at - line 58.
-	(Are you trying to call listen() on dirhandle FOO?)
-accept() on unopened socket FOO at - line 59.
-	(Are you trying to call accept() on dirhandle FOO?)
-shutdown() on unopened socket FOO at - line 60.
-	(Are you trying to call shutdown() on dirhandle FOO?)
-setsockopt() on unopened socket FOO at - line 61.
-	(Are you trying to call setsockopt() on dirhandle FOO?)
-getsockopt() on unopened socket FOO at - line 62.
-	(Are you trying to call getsockopt() on dirhandle FOO?)
-getsockname() on unopened socket FOO at - line 63.
-	(Are you trying to call getsockname() on dirhandle FOO?)
-getpeername() on unopened socket FOO at - line 64.
-	(Are you trying to call getpeername() on dirhandle FOO?)
-########
 # pp_sys.c [pp_stat]
 use warnings 'newline' ;
 stat "abc\ndef";
@@ -588,21 +355,16 @@ close STDIN ;
 stat(STDIN) ;
 -T HOCUS;
 stat(POCUS);
-stat "../test.pl";
-stat *foo;
 no warnings qw(unopened closed) ;
 -T STDIN ;
 stat(STDIN);
 -T HOCUS;
 stat(POCUS);
-stat "../test.pl";
-stat *foo;
 EXPECT
 -T on closed filehandle STDIN at - line 4.
 stat() on closed filehandle STDIN at - line 5.
 -T on unopened filehandle HOCUS at - line 6.
 stat() on unopened filehandle POCUS at - line 7.
-stat() on unopened filehandle foo at - line 9.
 ########
 # pp_sys.c [pp_fttext]
 use warnings 'newline' ;
@@ -627,18 +389,9 @@ my $a = sysread(F, $a,10) ;
 no warnings 'io' ;
 my $a = sysread(F, $a,10) ;
 close F ;
-use warnings 'io' ;
-sysread(F, $a, 10);
-read(F, $a, 10);
-sysread(NONEXISTENT, $a, 10);
-read(NONEXISTENT, $a, 10);
 unlink $file ;
 EXPECT
 Filehandle F opened only for output at - line 12.
-sysread() on closed filehandle F at - line 17.
-read() on closed filehandle F at - line 18.
-sysread() on unopened filehandle NONEXISTENT at - line 19.
-read() on unopened filehandle NONEXISTENT at - line 20.
 ########
 # pp_sys.c [pp_binmode]
 use warnings 'unopened' ;
@@ -650,13 +403,10 @@ binmode() on unopened filehandle at - line 4.
 ########
 # pp_sys.c [pp_lstat]
 use warnings 'io';
-open FH, "../harness" or die "# $!";
+open FH, "harness" or die "# $!";
 lstat FH;
-lstat *FH;
-lstat \*FH;
 open my $fh, $0 or die "# $!";
 lstat $fh;
-lstat *FH{IO};
 no warnings 'io';
 lstat FH;
 lstat $fh;
@@ -664,28 +414,7 @@ close FH;
 close $fh;
 EXPECT
 lstat() on filehandle FH at - line 4.
-lstat() on filehandle FH at - line 5.
-lstat() on filehandle FH at - line 6.
-lstat() on filehandle $fh at - line 8.
-lstat() on filehandle at - line 9.
-########
-
-# pp_sys.c [pp_lstat]
-use warnings 'io';
-use utf8;
-use open qw( :utf8 :std );
-open ᶠḨ, "../harness" or die "# $!";
-lstat ᶠḨ;
-open my $ｆᚺ, $0 or die "# $!";
-lstat $ｆᚺ;
-no warnings 'io';
-lstat ᶠḨ;
-lstat $ｆᚺ;
-close ᶠḨ;
-close $ｆᚺ;
-EXPECT
-lstat() on filehandle ᶠḨ at - line 7.
-lstat() on filehandle $ｆᚺ at - line 9.
+lstat() on filehandle $fh at - line 6.
 ########
 # pp_sys.c [pp_getc]
 use warnings qw(unopened closed) ;
@@ -708,212 +437,3 @@ EXPECT
 getc() on unopened filehandle FOO at - line 3.
 getc() on closed filehandle STDIN at - line 5.
 getc() on closed filehandle FH2 at - line 12.
-########
-# pp_sys.c [pp_sselect]
-use warnings 'misc';
-$x = 1;
-select $x, undef, undef, 1;
-sub TIESCALAR{bless[]} sub FETCH {"hello"} sub STORE{}
-tie $y, "";
-select $y, undef, undef, 1;
-no warnings 'misc';
-select $x, undef, undef, 1;
-EXPECT
-Non-string passed as bitmask at - line 4.
-########
-use Config;
-BEGIN {
-    if (!$Config{d_fchdir}) {
-	print <<EOM;
-SKIPPED
-# fchdir not present
-EOM
-	exit;
-    }
-}
-opendir FOO, '.'; closedir FOO;
-open BAR, '.'; close BAR;
-opendir $dh, '.'; closedir $dh;
-open $fh, '.'; close $fh;
-chdir FOO;
-chdir BAR;
-chdir $dh;
-chdir $fh;
-use warnings qw(unopened closed) ;
-chdir FOO;
-chdir BAR;
-chdir $dh;
-chdir $fh;
-EXPECT
-chdir() on unopened filehandle FOO at - line 20.
-chdir() on closed filehandle BAR at - line 21.
-chdir() on unopened filehandle $dh at - line 22.
-chdir() on closed filehandle $fh at - line 23.
-########
-# pp_sys.c [pp_open]
-use warnings;
-opendir FOO, ".";
-opendir my $foo, ".";
-open FOO, "../harness";
-open $foo, "../harness";
-no warnings qw(io deprecated);
-open FOO, "../harness";
-open $foo, "../harness";
-EXPECT
-Opening dirhandle FOO also as a file at - line 5.
-Opening dirhandle $foo also as a file at - line 6.
-########
-
-# pp_sys.c [pp_open]
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-opendir ＦＯＯ, ".";
-opendir $ｆ��, ".";
-open ＦＯＯ, "../harness";
-open $ｆ��, "../harness";
-no warnings qw(io deprecated);
-open ＦＯＯ, "../harness";
-open $ｆ��, "../harness";
-EXPECT
-Opening dirhandle ＦＯＯ also as a file at - line 8.
-Opening dirhandle $ｆ�� also as a file at - line 9.
-########
-# pp_sys.c [pp_open_dir]
-use warnings;
-open FOO, "../harness";
-open my $foo, "../harness";
-opendir FOO, ".";
-opendir $foo, ".";
-no warnings qw(io deprecated);
-opendir FOO, ".";
-opendir $foo, ".";
-EXPECT
-Opening filehandle FOO also as a directory at - line 5.
-Opening filehandle $foo also as a directory at - line 6.
-########
-
-# pp_sys.c [pp_open_dir]
-use utf8;
-use open qw( :utf8 :std );
-use warnings;
-use warnings;
-open ＦＯＯ, "../harness";
-open $ｆ��, "../harness";
-opendir ＦＯＯ, ".";
-opendir $ｆ��, ".";
-no warnings qw(io deprecated);
-opendir ＦＯＯ, ".";
-opendir $ｆ��, ".";
-EXPECT
-Opening filehandle ＦＯＯ also as a directory at - line 9.
-Opening filehandle $ｆ�� also as a directory at - line 10.
-########
-# pp_sys.c [pp_*dir]
-use Config ;
-BEGIN {
-    if ( ! $Config{d_telldir}) {
-        print <<EOM ;
-SKIPPED
-# telldir not present
-EOM
-        exit
-    }
-}
-#line 2
-use warnings 'io';
-opendir FOO, ".";
-opendir $foo, ".";
-closedir FOO;
-closedir $foo;
-
-readdir(FOO);
-telldir(FOO);
-seekdir(FOO, 0);
-rewinddir(FOO);
-closedir(FOO);
-
-readdir($foo);
-telldir($foo);
-seekdir($foo, 0);
-rewinddir($foo);
-closedir($foo);
-
-EXPECT
-readdir() attempted on invalid dirhandle FOO at - line 8.
-telldir() attempted on invalid dirhandle FOO at - line 9.
-seekdir() attempted on invalid dirhandle FOO at - line 10.
-rewinddir() attempted on invalid dirhandle FOO at - line 11.
-closedir() attempted on invalid dirhandle FOO at - line 12.
-readdir() attempted on invalid dirhandle $foo at - line 14.
-telldir() attempted on invalid dirhandle $foo at - line 15.
-seekdir() attempted on invalid dirhandle $foo at - line 16.
-rewinddir() attempted on invalid dirhandle $foo at - line 17.
-closedir() attempted on invalid dirhandle $foo at - line 18.
-########
-
-# pp_sys.c [pp_*dir]
-use Config ;
-BEGIN {
-    if ( ! $Config{d_telldir}) {
-        print <<EOM ;
-SKIPPED
-# telldir not present
-EOM
-        exit
-    }
-}
-#line 3
-use utf8;
-use open qw( :utf8 :std );
-use warnings 'io';
-opendir ＦＯＯ, ".";
-opendir $ｆ��, ".";
-opendir ＦＯＯ, ".";
-opendir $ｆ��, ".";
-closedir ＦＯＯ;
-closedir $ｆ��;
-
-readdir(ＦＯＯ);
-telldir(ＦＯＯ);
-seekdir(ＦＯＯ, 0);
-rewinddir(ＦＯＯ);
-closedir(ＦＯＯ);
-
-readdir($ｆ��);
-telldir($ｆ��);
-seekdir($ｆ��, 0);
-rewinddir($ｆ��);
-closedir($ｆ��);
-
-EXPECT
-readdir() attempted on invalid dirhandle ＦＯＯ at - line 13.
-telldir() attempted on invalid dirhandle ＦＯＯ at - line 14.
-seekdir() attempted on invalid dirhandle ＦＯＯ at - line 15.
-rewinddir() attempted on invalid dirhandle ＦＯＯ at - line 16.
-closedir() attempted on invalid dirhandle ＦＯＯ at - line 17.
-readdir() attempted on invalid dirhandle $ｆ�� at - line 19.
-telldir() attempted on invalid dirhandle $ｆ�� at - line 20.
-seekdir() attempted on invalid dirhandle $ｆ�� at - line 21.
-rewinddir() attempted on invalid dirhandle $ｆ�� at - line 22.
-closedir() attempted on invalid dirhandle $ｆ�� at - line 23.
-########
-# pp_sys.c [pp_gmtime]
-BEGIN {
-    print <<EOM;
-SKIPPED
-# NaN values not produced consistently in 5.20.x
-EOM
-    exit;
-}
-gmtime("NaN");
-localtime("NaN");
-use warnings "overflow";
-gmtime("NaN");
-localtime("NaN");
-
-EXPECT
-gmtime(NaN) too large at - line 6.
-gmtime(NaN) failed at - line 6.
-localtime(NaN) too large at - line 7.
-localtime(NaN) failed at - line 7.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp
index b55959e0703..e9a8d70a5d9 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/regcomp
+++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp
@@ -1,9 +1,218 @@
-  regcomp.c	These tests have been moved to t/re/reg_mesg.t
-		except for those that explicitly test line numbers.
+  regcomp.c	AOK
+
+  Quantifier unexpected on zero-length expression [S_study_chunk] 
+
+  (?p{}) is deprecated - use (??{})  [S_reg]
+    $a =~ /(?p{'x'})/ ;
+    
+
+  Useless (%s%c) - %suse /%c modifier [S_reg] 
+  Useless (%sc) - %suse /gc modifier [S_reg] 
+
+
+
+  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/
+
+  POSIX syntax [%c %c] belongs inside character classes	[S_checkposixcc] 
+
+
+  Character class [:%.*s:] unknown	[S_regpposixcc]
+
+  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] 
+
+  False [] range \"%*.*s\" [S_regclass]
 
 __END__
-use warnings 'regexp';
-$r=qr/(??{ q"\\b+" })/;
-"a" =~ /a$r/; # warning should come from this line
+# regcomp.c [S_regpiece]
+use warnings 'regexp' ;
+my $a = "ABC123" ; 
+$a =~ /(?=a)*/ ;
+no warnings 'regexp' ;
+$a =~ /(?=a)*/ ;
+EXPECT
+(?=a)* matches null string many times in regex; marked by <-- HERE in m/(?=a)* <-- HERE / at - line 4.
+########
+# regcomp.c [S_regatom]
+$x = '\m' ;
+use warnings 'regexp' ;
+$a =~ /a$x/ ;
+no warnings 'regexp' ;
+$a =~ /a$x/ ;
+EXPECT
+Unrecognized escape \m passed through in regex; marked by <-- HERE in m/a\m <-- HERE / at - line 4.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[:alpha:]/;
+/[:zog:]/;
+no warnings 'regexp' ;
+/[:alpha:]/;
+/[:zog:]/;
+EXPECT
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:alpha:] <-- HERE / at - line 5.
+POSIX syntax [: :] belongs inside character classes in regex; marked by <-- HERE in m/[:zog:] <-- HERE / at - line 6.
+########
+# regcomp.c [S_checkposixcc]
+#
+use warnings 'regexp' ;
+$_ = "" ;
+/[.zog.]/;
+no warnings 'regexp' ;
+/[.zog.]/;
+EXPECT
+POSIX syntax [. .] belongs inside character classes in regex; marked by <-- HERE in m/[.zog.] <-- HERE / at - line 5.
+POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/[.zog.] <-- HERE /
+########
+# 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
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 5.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 6.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 7.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 8.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 9.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 10.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 11.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ 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
+False [] range "a-\d" in regex; marked by <-- HERE in m/[a-\d <-- HERE ]/ at - line 12.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE b]/ at - line 13.
+False [] range "\s-" in regex; marked by <-- HERE in m/[\s- <-- HERE \d]/ at - line 14.
+False [] range "\d-" in regex; marked by <-- HERE in m/[\d- <-- HERE \s]/ at - line 15.
+False [] range "a-[:digit:]" in regex; marked by <-- HERE in m/[a-[:digit:] <-- HERE ]/ at - line 16.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE b]/ at - line 17.
+False [] range "[:alpha:]-" in regex; marked by <-- HERE in m/[[:alpha:]- <-- HERE [:digit:]]/ at - line 18.
+False [] range "[:digit:]-" in regex; marked by <-- HERE in m/[[:digit:]- <-- HERE [:alpha:]]/ at - line 19.
+########
+# regcomp.c [S_regclass S_regclassutf8]
+use warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+no warnings 'regexp' ;
+$a =~ /[a\zb]/ ;
+EXPECT
+Unrecognized escape \z in character class passed through in regex; marked by <-- HERE in m/[a\z <-- HERE b]/ at - line 3.
+
+########
+# regcomp.c [S_study_chunk]
+use warnings 'deprecated' ;
+$a = "xx" ;
+$a =~ /(?p{'x'})/ ;
+no warnings ;
+use warnings 'regexp' ;
+$a =~ /(?p{'x'})/ ;
+use warnings;
+no warnings 'deprecated' ;
+no warnings 'regexp' ;
+no warnings 'syntax' ;
+$a =~ /(?p{'x'})/ ;
+EXPECT
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 4.
+(?p{}) is deprecated - use (??{}) in regex; marked by <-- HERE in m/(?p <-- HERE {'x'})/ at - line 7.
+########
+# regcomp.c [S_reg]
+use warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+no warnings 'regexp' ;
+$a = qr/(?c)/;
+$a = qr/(?-c)/;
+$a = qr/(?g)/;
+$a = qr/(?-g)/;
+$a = qr/(?o)/;
+$a = qr/(?-o)/;
+$a = qr/(?g-o)/;
+$a = qr/(?g-c)/;
+$a = qr/(?o-cg)/;  # (?c) means (?g) error won't be thrown
+$a = qr/(?ogc)/;
+#EXPECT
 EXPECT
-\b+ matches null string many times in regex; marked by <-- HERE in m/\b+ <-- HERE / at - line 3.
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?c <-- HERE )/ at - line 3.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?-c <-- HERE )/ at - line 4.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE )/ at - line 5.
+Useless (?-g) - don't use /g modifier in regex; marked by <-- HERE in m/(?-g <-- HERE )/ at - line 6.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE )/ at - line 7.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?-o <-- HERE )/ at - line 8.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -o)/ at - line 9.
+Useless (?-o) - don't use /o modifier in regex; marked by <-- HERE in m/(?g-o <-- HERE )/ at - line 9.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?g <-- HERE -c)/ at - line 10.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?g-c <-- HERE )/ at - line 10.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE -cg)/ at - line 11.
+Useless (?-c) - don't use /gc modifier in regex; marked by <-- HERE in m/(?o-c <-- HERE g)/ at - line 11.
+Useless (?o) - use /o modifier in regex; marked by <-- HERE in m/(?o <-- HERE gc)/ at - line 12.
+Useless (?g) - use /g modifier in regex; marked by <-- HERE in m/(?og <-- HERE c)/ at - line 12.
+Useless (?c) - use /gc modifier in regex; marked by <-- HERE in m/(?ogc <-- HERE )/ at - line 12.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/utf8 b/gnu/usr.bin/perl/t/lib/warnings/utf8
index 9004731cc6f..6635f02d755 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/utf8
+++ b/gnu/usr.bin/perl/t/lib/warnings/utf8
@@ -1,7 +1,7 @@
 
   utf8.c AOK
 
-     [utf8_to_uvchr_buf]
+     [utf8_to_uv]
      Malformed UTF-8 character
 	my $a = ord "\x80" ;
 
@@ -11,10 +11,10 @@
 
      [utf16_to_utf8]
      Malformed UTF-16 surrogate		
-     <<<<<< Add a test when something actually calls utf16_to_utf8
+     <<<<<< Add a test when somethig actually calls utf16_to_utf8
 
 __END__
-# utf8.c [utf8_to_uvchr_buf] -W
+# utf8.c [utf8_to_uv] -W
 BEGIN {
     if (ord('A') == 193) {
         print "SKIPPED\n# ebcdic platforms do not generate Malformed UTF-8 warnings.";
@@ -34,540 +34,103 @@ Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately af
 Malformed UTF-8 character (unexpected non-continuation byte 0x73, immediately after start byte 0xf8) at - line 14.
 ########
 use warnings 'utf8';
-my $d7ff  = uc(chr(0xD7FF));
-my $d800  = uc(chr(0xD800));
-my $dfff  = uc(chr(0xDFFF));
-my $e000  = uc(chr(0xE000));
-my $feff  = uc(chr(0xFEFF));
-my $fffd  = uc(chr(0xFFFD));
-my $fffe  = uc(chr(0xFFFE));
-my $ffff  = uc(chr(0xFFFF));
-my $hex4  = uc(chr(0x10000));
-my $hex5  = uc(chr(0x100000));
-my $maxm1 = uc(chr(0x10FFFE));
-my $max   = uc(chr(0x10FFFF));
-my $nonUnicode =  uc(chr(0x110000));
+my $d7ff  = chr(0xD7FF);
+my $d800  = chr(0xD800);
+my $dfff  = chr(0xDFFF);
+my $e000  = chr(0xE000);
+my $feff  = chr(0xFEFF);
+my $fffd  = chr(0xFFFD);
+my $fffe  = chr(0xFFFE);
+my $ffff  = chr(0xFFFF);
+my $hex4  = chr(0x10000);
+my $hex5  = chr(0x100000);
+my $maxm1 = chr(0x10FFFE);
+my $max   = chr(0x10FFFF);
 no warnings 'utf8';
-my $d7ff  = uc(chr(0xD7FF));
-my $d800  = uc(chr(0xD800));
-my $dfff  = uc(chr(0xDFFF));
-my $e000  = uc(chr(0xE000));
-my $feff  = uc(chr(0xFEFF));
-my $fffd  = uc(chr(0xFFFD));
-my $fffe  = uc(chr(0xFFFE));
-my $ffff  = uc(chr(0xFFFF));
-my $hex4  = uc(chr(0x10000));
-my $hex5  = uc(chr(0x100000));
-my $maxm1 = uc(chr(0x10FFFE));
-my $max   = uc(chr(0x10FFFF));
-my $nonUnicode =  uc(chr(0x110000));
-EXPECT
-Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 3.
-Operation "uc" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
-Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 14.
-########
-use warnings 'utf8';
-my $d800  = uc(chr(0xD800));
-my $nonUnicode =  uc(chr(0x110000));
-no warnings 'surrogate';
-my $d800  = uc(chr(0xD800));
-my $nonUnicode =  uc(chr(0x110000));
-EXPECT
-Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
-Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
-Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 6.
-########
-use warnings 'utf8';
-my $d800  = uc(chr(0xD800));
-my $nonUnicode =  uc(chr(0x110000));
-my $big_nonUnicode = uc(chr(0x8000_0000));
-no warnings 'non_unicode';
-my $d800  = uc(chr(0xD800));
-my $nonUnicode =  uc(chr(0x110000));
-my $big_nonUnicode = uc(chr(0x8000_0000));
-EXPECT
-Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 2.
-Operation "uc" returns its argument for non-Unicode code point 0x110000 at - line 3.
-Operation "uc" returns its argument for non-Unicode code point 0x80000000 at - line 4.
-Operation "uc" returns its argument for UTF-16 surrogate U+D800 at - line 6.
-########
-use warnings 'utf8';
-my $d7ff  = lc pack("U", 0xD7FF);
-my $d800  = lc pack("U", 0xD800);
-my $dfff  = lc pack("U", 0xDFFF);
-my $e000  = lc pack("U", 0xE000);
-my $feff  = lc pack("U", 0xFEFF);
-my $fffd  = lc pack("U", 0xFFFD);
-my $fffe  = lc pack("U", 0xFFFE);
-my $ffff  = lc pack("U", 0xFFFF);
-my $hex4  = lc pack("U", 0x10000);
-my $hex5  = lc pack("U", 0x100000);
-my $maxm1 = lc pack("U", 0x10FFFE);
-my $max   = lc pack("U", 0x10FFFF);
-my $nonUnicode =  lc(pack("U", 0x110000));
-no warnings 'utf8';
-my $d7ff  = lc pack("U", 0xD7FF);
-my $d800  = lc pack("U", 0xD800);
-my $dfff  = lc pack("U", 0xDFFF);
-my $e000  = lc pack("U", 0xE000);
-my $feff  = lc pack("U", 0xFEFF);
-my $fffd  = lc pack("U", 0xFFFD);
-my $fffe  = lc pack("U", 0xFFFE);
-my $ffff  = lc pack("U", 0xFFFF);
-my $hex4  = lc pack("U", 0x10000);
-my $hex5  = lc pack("U", 0x100000);
-my $maxm1 = lc pack("U", 0x10FFFE);
-my $max   = lc pack("U", 0x10FFFF);
-my $nonUnicode =  lc(pack("U", 0x110000));
-EXPECT
-Operation "lc" returns its argument for UTF-16 surrogate U+D800 at - line 3.
-Operation "lc" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
-Operation "lc" returns its argument for non-Unicode code point 0x110000 at - line 14.
-########
-use warnings 'utf8';
-my $d7ff  = ucfirst "\x{D7FF}";
-my $d800  = ucfirst "\x{D800}";
-my $dfff  = ucfirst "\x{DFFF}";
-my $e000  = ucfirst "\x{E000}";
-my $feff  = ucfirst "\x{FEFF}";
-my $fffd  = ucfirst "\x{FFFD}";
-my $fffe  = ucfirst "\x{FFFE}";
-my $ffff  = ucfirst "\x{FFFF}";
-my $hex4  = ucfirst "\x{10000}";
-my $hex5  = ucfirst "\x{100000}";
-my $maxm1 = ucfirst "\x{10FFFE}";
-my $max   = ucfirst "\x{10FFFF}";
-my $nonUnicode =  ucfirst "\x{110000}";
-no warnings 'utf8';
-my $d7ff  = ucfirst "\x{D7FF}";
-my $d800  = ucfirst "\x{D800}";
-my $dfff  = ucfirst "\x{DFFF}";
-my $e000  = ucfirst "\x{E000}";
-my $feff  = ucfirst "\x{FEFF}";
-my $fffd  = ucfirst "\x{FFFD}";
-my $fffe  = ucfirst "\x{FFFE}";
-my $ffff  = ucfirst "\x{FFFF}";
-my $hex4  = ucfirst "\x{10000}";
-my $hex5  = ucfirst "\x{100000}";
-my $maxm1 = ucfirst "\x{10FFFE}";
-my $max   = ucfirst "\x{10FFFF}";
-my $nonUnicode =  ucfirst "\x{110000}";
-EXPECT
-Operation "ucfirst" returns its argument for UTF-16 surrogate U+D800 at - line 3.
-Operation "ucfirst" returns its argument for UTF-16 surrogate U+DFFF at - line 4.
-Operation "ucfirst" returns its argument for non-Unicode code point 0x110000 at - line 14.
-########
-# NAME Matching \p{} against above-Unicode
-use warnings 'utf8';
-chr(0xD7FF) =~ /\p{Any}/;
-chr(0xD800) =~ /\p{Any}/;
-chr(0xDFFF) =~ /\p{Any}/;
-chr(0xE000) =~ /\p{Any}/;
-chr(0xFEFF) =~ /\p{Any}/;
-chr(0xFFFD) =~ /\p{Any}/;
-chr(0xFFFE) =~ /\p{Any}/;
-chr(0xFFFF) =~ /\p{Any}/;
-chr(0x10000) =~ /\p{Any}/;
-chr(0x100000) =~ /\p{Any}/;
-chr(0x10FFFE) =~ /\p{Any}/;
-chr(0x10FFFF) =~ /\p{Any}/;
-chr(0x110000) =~ /[\p{Any}]/;
-chr(0x110001) =~ /[\w\p{Any}]/;
-chr(0x10FFFF) =~ /\p{All}/;
-chr(0x110002) =~ /[\w\p{All}]/;
-chr(0x110003) =~ /[\p{XPosixWord}]/;
-chr(0x110004) =~ /[\P{XPosixWord}]/;
-chr(0x110005) =~ /^[\p{Unassigned}]/;
-chr(0x110006) =~ /^[\P{Unassigned}]/;
-# Only Unicode properties give non-Unicode warnings, and only those properties
-# which do match above Unicode; and not when something else in the class
-# matches above Unicode.  Below we test three ways where something outside the
-# property may match non-Unicode: a code point above it, a class \S that we
-# know at compile time doesn't, and a class \W whose values aren't (at the time
-# of this writing) specified at compile time, but which wouldn't match
-chr(0x110050) =~ /\w/;
-chr(0x110051) =~ /\W/;
-chr(0x110052) =~ /\d/;
-chr(0x110053) =~ /\D/;
-chr(0x110054) =~ /\s/;
-chr(0x110055) =~ /\S/;
-chr(0x110056) =~ /[[:word:]]/;
-chr(0x110057) =~ /[[:^word:]]/;
-chr(0x110058) =~ /[[:alnum:]]/;
-chr(0x110059) =~ /[[:^alnum:]]/;
-chr(0x11005A) =~ /[[:space:]]/;
-chr(0x11005B) =~ /[[:^space:]]/;
-chr(0x11005C) =~ /[[:digit:]]/;
-chr(0x11005D) =~ /[[:^digit:]]/;
-chr(0x11005E) =~ /[[:alpha:]]/;
-chr(0x11005F) =~ /[[:^alpha:]]/;
-chr(0x110060) =~ /[[:ascii:]]/;
-chr(0x110061) =~ /[[:^ascii:]]/;
-chr(0x110062) =~ /[[:cntrl:]]/;
-chr(0x110063) =~ /[[:^cntrl:]]/;
-chr(0x110064) =~ /[[:graph:]]/;
-chr(0x110065) =~ /[[:^graph:]]/;
-chr(0x110066) =~ /[[:lower:]]/;
-chr(0x110067) =~ /[[:^lower:]]/;
-chr(0x110068) =~ /[[:print:]]/;
-chr(0x110069) =~ /[[:^print:]]/;
-chr(0x11006A) =~ /[[:punct:]]/;
-chr(0x11006B) =~ /[[:^punct:]]/;
-chr(0x11006C) =~ /[[:upper:]]/;
-chr(0x11006D) =~ /[[:^upper:]]/;
-chr(0x11006E) =~ /[[:xdigit:]]/;
-chr(0x11006F) =~ /[[:^xdigit:]]/;
-chr(0x110070) =~ /[[:blank:]]/;
-chr(0x110071) =~ /[[:^blank:]]/;
-chr(0x111010) =~ /[\W\p{Unassigned}]/;
-chr(0x111011) =~ /[\W\P{Unassigned}]/;
-chr(0x112010) =~ /[\S\p{Unassigned}]/;
-chr(0x112011) =~ /[\S\P{Unassigned}]/;
-chr(0x113010) =~ /[\x{110000}\p{Unassigned}]/;
-chr(0x113011) =~ /[\x{110000}\P{Unassigned}]/;
-no warnings 'utf8';
-chr(0xD7FF) =~ /\p{Any}/;
-chr(0xD800) =~ /\p{Any}/;
-chr(0xDFFF) =~ /\p{Any}/;
-chr(0xE000) =~ /\p{Any}/;
-chr(0xFEFF) =~ /\p{Any}/;
-chr(0xFFFD) =~ /\p{Any}/;
-chr(0xFFFE) =~ /\p{Any}/;
-chr(0xFFFF) =~ /\p{Any}/;
-chr(0x10000) =~ /\p{Any}/;
-chr(0x100000) =~ /\p{Any}/;
-chr(0x10FFFE) =~ /\p{Any}/;
-chr(0x10FFFF) =~ /\p{Any}/;
-chr(0x110000) =~ /[\p{Any}]/;
-chr(0x110001) =~ /[\w\p{Any}]/;
-chr(0x10FFFF) =~ /\p{All}/;
-chr(0x110002) =~ /[\w\p{All}]/;
-chr(0x110003) =~ /[\p{XPosixWord}]/;
-chr(0x110004) =~ /[\P{XPosixWord}]/;
-chr(0x110005) =~ /^[\p{Unassigned}]/;
-chr(0x110006) =~ /^[\P{Unassigned}]/;
-chr(0x110050) =~ /\w/;
-chr(0x110051) =~ /\W/;
-chr(0x110052) =~ /\d/;
-chr(0x110053) =~ /\D/;
-chr(0x110054) =~ /\s/;
-chr(0x110055) =~ /\S/;
-chr(0x110056) =~ /[[:word:]]/;
-chr(0x110057) =~ /[[:^word:]]/;
-chr(0x110058) =~ /[[:alnum:]]/;
-chr(0x110059) =~ /[[:^alnum:]]/;
-chr(0x11005A) =~ /[[:space:]]/;
-chr(0x11005B) =~ /[[:^space:]]/;
-chr(0x11005C) =~ /[[:digit:]]/;
-chr(0x11005D) =~ /[[:^digit:]]/;
-chr(0x11005E) =~ /[[:alpha:]]/;
-chr(0x11005F) =~ /[[:^alpha:]]/;
-chr(0x110060) =~ /[[:ascii:]]/;
-chr(0x110061) =~ /[[:^ascii:]]/;
-chr(0x110062) =~ /[[:cntrl:]]/;
-chr(0x110063) =~ /[[:^cntrl:]]/;
-chr(0x110064) =~ /[[:graph:]]/;
-chr(0x110065) =~ /[[:^graph:]]/;
-chr(0x110066) =~ /[[:lower:]]/;
-chr(0x110067) =~ /[[:^lower:]]/;
-chr(0x110068) =~ /[[:print:]]/;
-chr(0x110069) =~ /[[:^print:]]/;
-chr(0x11006A) =~ /[[:punct:]]/;
-chr(0x11006B) =~ /[[:^punct:]]/;
-chr(0x11006C) =~ /[[:upper:]]/;
-chr(0x11006D) =~ /[[:^upper:]]/;
-chr(0x11006E) =~ /[[:xdigit:]]/;
-chr(0x11006F) =~ /[[:^xdigit:]]/;
-chr(0x110070) =~ /[[:blank:]]/;
-chr(0x110071) =~ /[[:^blank:]]/;
-chr(0x111010) =~ /[\W\p{Unassigned}]/;
-chr(0x111011) =~ /[\W\P{Unassigned}]/;
-chr(0x112010) =~ /[\S\p{Unassigned}]/;
-chr(0x112011) =~ /[\S\P{Unassigned}]/;
-chr(0x113010) =~ /[\x{110000}\p{Unassigned}]/;
-chr(0x113011) =~ /[\x{110000}\P{Unassigned}]/;
-EXPECT
-Matched non-Unicode code point 0x110005 against Unicode property; may not be portable at - line 20.
-Matched non-Unicode code point 0x110006 against Unicode property; may not be portable at - line 21.
-########
-# NAME Matching Unicode property against above-Unicode code point outputs a warning even if optimizer rejects the match (in synthetic start class)
-# Now have to make FATAL to guarantee being output
-use warnings FATAL => 'non_unicode';
-"\x{110000}" =~ /b?\p{Space}/;
-EXPECT
-Matched non-Unicode code point 0x110000 against Unicode property; may not be portable at - line 3.
-########
-# NAME Matching POSIX class property against above-Unicode code point doesn't output a warning
-use warnings 'non_unicode';
-use warnings FATAL => 'non_unicode';
-"\x{110000}" =~ /b?[[:space:]]/;
-EXPECT
+my $d7ff  = chr(0xD7FF);
+my $d800  = chr(0xD800);
+my $dfff  = chr(0xDFFF);
+my $e000  = chr(0xE000);
+my $feff  = chr(0xFEFF);
+my $fffd  = chr(0xFFFD);
+my $fffe  = chr(0xFFFE);
+my $ffff  = chr(0xFFFF);
+my $hex4  = chr(0x10000);
+my $hex5  = chr(0x100000);
+my $maxm1 = chr(0x10FFFE);
+my $max   = chr(0x10FFFF);
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 8.
+Unicode character 0xffff is illegal at - line 9.
+Unicode character 0x10fffe is illegal at - line 12.
+Unicode character 0x10ffff is illegal at - line 13.
 ########
 use warnings 'utf8';
-chr(0x110000) =~ /\p{Any}/;
-########
-# NAME utf8, non_unicode warnings categories work on Matched non-Unicode code point warning
-use warnings qw(utf8 non_unicode);
-chr(0x110000) =~ /^\p{Unassigned}/;
-no warnings 'non_unicode';
-chr(0x110001) =~ /\p{Unassigned}/;
-use warnings 'non_unicode';
+my $d7ff  = pack("U", 0xD7FF);
+my $d800  = pack("U", 0xD800);
+my $dfff  = pack("U", 0xDFFF);
+my $e000  = pack("U", 0xE000);
+my $feff  = pack("U", 0xFEFF);
+my $fffd  = pack("U", 0xFFFD);
+my $fffe  = pack("U", 0xFFFE);
+my $ffff  = pack("U", 0xFFFF);
+my $hex4  = pack("U", 0x10000);
+my $hex5  = pack("U", 0x100000);
+my $maxm1 = pack("U", 0x10FFFE);
+my $max   = pack("U", 0x10FFFF);
 no warnings 'utf8';
-chr(0x110002) =~ /\p{Unassigned}/;
-EXPECT
-Matched non-Unicode code point 0x110000 against Unicode property; may not be portable at - line 2.
-########
-# NAME optimizable regnode should still give non_unicode warnings when fatalized
-use warnings 'utf8';
-use warnings FATAL => 'non_unicode';
-chr(0x110000) =~ /\p{lb=cr}/;
-EXPECT
-Matched non-Unicode code point 0x110000 against Unicode property; may not be portable at - line 3.
+my $d7ff  = pack("U", 0xD7FF);
+my $d800  = pack("U", 0xD800);
+my $dfff  = pack("U", 0xDFFF);
+my $e000  = pack("U", 0xE000);
+my $feff  = pack("U", 0xFEFF);
+my $fffd  = pack("U", 0xFFFD);
+my $fffe  = pack("U", 0xFFFE);
+my $ffff  = pack("U", 0xFFFF);
+my $hex4  = pack("U", 0x10000);
+my $hex5  = pack("U", 0x100000);
+my $maxm1 = pack("U", 0x10FFFE);
+my $max   = pack("U", 0x10FFFF);
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 8.
+Unicode character 0xffff is illegal at - line 9.
+Unicode character 0x10fffe is illegal at - line 12.
+Unicode character 0x10ffff is illegal at - line 13.
 ########
-# NAME optimizable regnode should not give non_unicode warnings when warnings are off
-no warnings 'non_unicode';
-chr(0x110000) =~ /\p{lb=cr}/;
-EXPECT
-########
-# NAME 'All' matches above-Unicode without any warning
-use warnings qw(utf8 non_unicode);
-chr(0x110000) =~ /\p{All}/;
-EXPECT
-########
-require "../test.pl";
-use warnings 'utf8';
-sub Is_Super { return '!utf8::Any' }
-# The extra char is to avoid an optimization that avoids the problem when the
-# property is the only non-latin1 char in a class
-print "\x{1100000}" =~ /^[\p{Is_Super}\x{100}]$/, "\n";
-EXPECT
-1
-########
-require "../test.pl";
-use warnings 'utf8';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D7FF}", "\n";
-print $fh "\x{D800}", "\n";
-print $fh "\x{DFFF}", "\n";
-print $fh "\x{E000}", "\n";
-print $fh "\x{FDCF}", "\n";
-print $fh "\x{FDD0}", "\n";
-print $fh "\x{FDEF}", "\n";
-print $fh "\x{FDF0}", "\n";
-print $fh "\x{FEFF}", "\n";
-print $fh "\x{FFFD}", "\n";
-print $fh "\x{FFFE}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{10000}", "\n";
-print $fh "\x{1FFFE}", "\n";
-print $fh "\x{1FFFF}", "\n";
-print $fh "\x{2FFFE}", "\n";
-print $fh "\x{2FFFF}", "\n";
-print $fh "\x{3FFFE}", "\n";
-print $fh "\x{3FFFF}", "\n";
-print $fh "\x{4FFFE}", "\n";
-print $fh "\x{4FFFF}", "\n";
-print $fh "\x{5FFFE}", "\n";
-print $fh "\x{5FFFF}", "\n";
-print $fh "\x{6FFFE}", "\n";
-print $fh "\x{6FFFF}", "\n";
-print $fh "\x{7FFFE}", "\n";
-print $fh "\x{7FFFF}", "\n";
-print $fh "\x{8FFFE}", "\n";
-print $fh "\x{8FFFF}", "\n";
-print $fh "\x{9FFFE}", "\n";
-print $fh "\x{9FFFF}", "\n";
-print $fh "\x{AFFFE}", "\n";
-print $fh "\x{AFFFF}", "\n";
-print $fh "\x{BFFFE}", "\n";
-print $fh "\x{BFFFF}", "\n";
-print $fh "\x{CFFFE}", "\n";
-print $fh "\x{CFFFF}", "\n";
-print $fh "\x{DFFFE}", "\n";
-print $fh "\x{DFFFF}", "\n";
-print $fh "\x{EFFFE}", "\n";
-print $fh "\x{EFFFF}", "\n";
-print $fh "\x{FFFFE}", "\n";
-print $fh "\x{FFFFF}", "\n";
-print $fh "\x{100000}", "\n";
-print $fh "\x{10FFFE}", "\n";
-print $fh "\x{10FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
-Unicode surrogate U+DFFF is illegal in UTF-8 at - line 7.
-Unicode non-character U+FDD0 is illegal for open interchange at - line 10.
-Unicode non-character U+FDEF is illegal for open interchange at - line 11.
-Unicode non-character U+FFFE is illegal for open interchange at - line 15.
-Unicode non-character U+FFFF is illegal for open interchange at - line 16.
-Unicode non-character U+1FFFE is illegal for open interchange at - line 18.
-Unicode non-character U+1FFFF is illegal for open interchange at - line 19.
-Unicode non-character U+2FFFE is illegal for open interchange at - line 20.
-Unicode non-character U+2FFFF is illegal for open interchange at - line 21.
-Unicode non-character U+3FFFE is illegal for open interchange at - line 22.
-Unicode non-character U+3FFFF is illegal for open interchange at - line 23.
-Unicode non-character U+4FFFE is illegal for open interchange at - line 24.
-Unicode non-character U+4FFFF is illegal for open interchange at - line 25.
-Unicode non-character U+5FFFE is illegal for open interchange at - line 26.
-Unicode non-character U+5FFFF is illegal for open interchange at - line 27.
-Unicode non-character U+6FFFE is illegal for open interchange at - line 28.
-Unicode non-character U+6FFFF is illegal for open interchange at - line 29.
-Unicode non-character U+7FFFE is illegal for open interchange at - line 30.
-Unicode non-character U+7FFFF is illegal for open interchange at - line 31.
-Unicode non-character U+8FFFE is illegal for open interchange at - line 32.
-Unicode non-character U+8FFFF is illegal for open interchange at - line 33.
-Unicode non-character U+9FFFE is illegal for open interchange at - line 34.
-Unicode non-character U+9FFFF is illegal for open interchange at - line 35.
-Unicode non-character U+AFFFE is illegal for open interchange at - line 36.
-Unicode non-character U+AFFFF is illegal for open interchange at - line 37.
-Unicode non-character U+BFFFE is illegal for open interchange at - line 38.
-Unicode non-character U+BFFFF is illegal for open interchange at - line 39.
-Unicode non-character U+CFFFE is illegal for open interchange at - line 40.
-Unicode non-character U+CFFFF is illegal for open interchange at - line 41.
-Unicode non-character U+DFFFE is illegal for open interchange at - line 42.
-Unicode non-character U+DFFFF is illegal for open interchange at - line 43.
-Unicode non-character U+EFFFE is illegal for open interchange at - line 44.
-Unicode non-character U+EFFFF is illegal for open interchange at - line 45.
-Unicode non-character U+FFFFE is illegal for open interchange at - line 46.
-Unicode non-character U+FFFFF is illegal for open interchange at - line 47.
-Unicode non-character U+10FFFE is illegal for open interchange at - line 49.
-Unicode non-character U+10FFFF is illegal for open interchange at - line 50.
-Code point 0x110000 is not Unicode, may not be portable at - line 51.
-########
-require "../test.pl";
-use warnings 'utf8';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D800}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Unicode surrogate U+D800 is illegal in UTF-8 at - line 5.
-Unicode non-character U+FFFF is illegal for open interchange at - line 6.
-Code point 0x110000 is not Unicode, may not be portable at - line 7.
-########
-require "../test.pl";
-use warnings 'utf8';
-no warnings 'surrogate';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D800}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Unicode non-character U+FFFF is illegal for open interchange at - line 7.
-Code point 0x110000 is not Unicode, may not be portable at - line 8.
-########
-require "../test.pl";
 use warnings 'utf8';
-no warnings 'nonchar';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D800}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
-Code point 0x110000 is not Unicode, may not be portable at - line 8.
-########
-require "../test.pl";
-use warnings 'utf8';
-no warnings 'non_unicode';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D800}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Unicode surrogate U+D800 is illegal in UTF-8 at - line 6.
-Unicode non-character U+FFFF is illegal for open interchange at - line 7.
-########
-# NAME C<use warnings "nonchar"> works in isolation
-require "../test.pl";
-use warnings 'nonchar';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{FFFF}", "\n";
-close $fh;
-EXPECT
-Unicode non-character U+FFFF is illegal for open interchange at - line 5.
-########
-# NAME C<use warnings "surrogate"> works in isolation
-require "../test.pl";
-use warnings 'surrogate';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D800}", "\n";
-close $fh;
-EXPECT
-Unicode surrogate U+D800 is illegal in UTF-8 at - line 5.
-########
-# NAME C<use warnings "non_unicode"> works in isolation
-require "../test.pl";
-use warnings 'non_unicode';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
-Code point 0x110000 is not Unicode, may not be portable at - line 5.
-########
-require "../test.pl";
+my $d7ff  = "\x{D7FF}";
+my $d800  = "\x{D800}";
+my $dfff  = "\x{DFFF}";
+my $e000  = "\x{E000}";
+my $feff  = "\x{FEFF}";
+my $fffd  = "\x{FFFD}";
+my $fffe  = "\x{FFFE}";
+my $ffff  = "\x{FFFF}";
+my $hex4  = "\x{10000}";
+my $hex5  = "\x{100000}";
+my $maxm1 = "\x{10FFFE}";
+my $max   = "\x{10FFFF}";
 no warnings 'utf8';
-my $file = tempfile();
-open(my $fh, "+>:utf8", $file);
-print $fh "\x{D7FF}", "\n";
-print $fh "\x{D800}", "\n";
-print $fh "\x{DFFF}", "\n";
-print $fh "\x{E000}", "\n";
-print $fh "\x{FDCF}", "\n";
-print $fh "\x{FDD0}", "\n";
-print $fh "\x{FDEF}", "\n";
-print $fh "\x{FDF0}", "\n";
-print $fh "\x{FEFF}", "\n";
-print $fh "\x{FFFD}", "\n";
-print $fh "\x{FFFE}", "\n";
-print $fh "\x{FFFF}", "\n";
-print $fh "\x{10000}", "\n";
-print $fh "\x{1FFFE}", "\n";
-print $fh "\x{1FFFF}", "\n";
-print $fh "\x{2FFFE}", "\n";
-print $fh "\x{2FFFF}", "\n";
-print $fh "\x{3FFFE}", "\n";
-print $fh "\x{3FFFF}", "\n";
-print $fh "\x{4FFFE}", "\n";
-print $fh "\x{4FFFF}", "\n";
-print $fh "\x{5FFFE}", "\n";
-print $fh "\x{5FFFF}", "\n";
-print $fh "\x{6FFFE}", "\n";
-print $fh "\x{6FFFF}", "\n";
-print $fh "\x{7FFFE}", "\n";
-print $fh "\x{7FFFF}", "\n";
-print $fh "\x{8FFFE}", "\n";
-print $fh "\x{8FFFF}", "\n";
-print $fh "\x{9FFFE}", "\n";
-print $fh "\x{9FFFF}", "\n";
-print $fh "\x{AFFFE}", "\n";
-print $fh "\x{AFFFF}", "\n";
-print $fh "\x{BFFFE}", "\n";
-print $fh "\x{BFFFF}", "\n";
-print $fh "\x{CFFFE}", "\n";
-print $fh "\x{CFFFF}", "\n";
-print $fh "\x{DFFFE}", "\n";
-print $fh "\x{DFFFF}", "\n";
-print $fh "\x{EFFFE}", "\n";
-print $fh "\x{EFFFF}", "\n";
-print $fh "\x{FFFFE}", "\n";
-print $fh "\x{FFFFF}", "\n";
-print $fh "\x{100000}", "\n";
-print $fh "\x{10FFFE}", "\n";
-print $fh "\x{10FFFF}", "\n";
-print $fh "\x{110000}", "\n";
-close $fh;
-EXPECT
+my $d7ff  = "\x{D7FF}";
+my $d800  = "\x{D800}";
+my $dfff  = "\x{DFFF}";
+my $e000  = "\x{E000}";
+my $feff  = "\x{FEFF}";
+my $fffd  = "\x{FFFD}";
+my $fffe  = "\x{FFFE}";
+my $ffff  = "\x{FFFF}";
+my $hex4  = "\x{10000}";
+my $hex5  = "\x{100000}";
+my $maxm1 = "\x{10FFFE}";
+my $max   = "\x{10FFFF}";
+EXPECT
+UTF-16 surrogate 0xd800 at - line 3.
+UTF-16 surrogate 0xdfff at - line 4.
+Unicode character 0xfffe is illegal at - line 8.
+Unicode character 0xffff is illegal at - line 9.
+Unicode character 0x10fffe is illegal at - line 12.
+Unicode character 0x10ffff is illegal at - line 13.
diff --git a/gnu/usr.bin/perl/t/op/alarm.t b/gnu/usr.bin/perl/t/op/alarm.t
index 82691c5cf2d..8fb92964a3a 100644
--- a/gnu/usr.bin/perl/t/op/alarm.t
+++ b/gnu/usr.bin/perl/t/op/alarm.t
@@ -13,52 +13,39 @@ BEGIN {
     }
 }
 
-plan tests => 5;
+plan tests => 4;
 my $Perl = which_perl();
 
-my ($start_time, $end_time);
-
+my $start_time = time;
 eval {
-    local $SIG{ALRM} = sub { $end_time = time; die "ALARM!\n" };
-    $start_time = time;
+    local $SIG{ALRM} = sub { die "ALARM!\n" };
     alarm 3;
 
     # perlfunc recommends against using sleep in combination with alarm.
-    1 while (($end_time = time) - $start_time < 6);
-    alarm 0;
+    1 while (time - $start_time < 6);
 };
 alarm 0;
-my $diff = $end_time - $start_time;
+my $diff = time - $start_time;
 
 # alarm time might be one second less than you said.
 is( $@, "ALARM!\n",             'alarm w/$SIG{ALRM} vs inf loop' );
-ok( abs($diff - 3) <= 1,   "   right time (waited $diff secs for 3-sec alarm)" );
+ok( abs($diff - 3) <= 1,   "   right time" );
 
 
+my $start_time = time;
 eval {
-    local $SIG{ALRM} = sub { $end_time = time; die "ALARM!\n" };
-    $start_time = time;
+    local $SIG{ALRM} = sub { die "ALARM!\n" };
     alarm 3;
     system(qq{$Perl -e "sleep 6"});
-    $end_time = time;
-    alarm 0;
 };
 alarm 0;
-$diff = $end_time - $start_time;
+$diff = time - $start_time;
 
 # alarm time might be one second less than you said.
 is( $@, "ALARM!\n",             'alarm w/$SIG{ALRM} vs system()' );
 
 {
     local $TODO = "Why does system() block alarm() on $^O?"
-		if $^O eq 'VMS' || $^O eq 'dos';
+		if $^O eq 'VMS' || $^O eq'MacOS' || $^O eq 'dos';
     ok( abs($diff - 3) <= 1,   "   right time (waited $diff secs for 3-sec alarm)" );
 }
-
-
-{
-    local $SIG{"ALRM"} = sub { die };
-    eval { alarm(1); my $x = qx($Perl -e "sleep 3"); alarm(0); };
-    chomp (my $foo = "foo\n");
-    ok($foo eq "foo", '[perl #33928] chomp() fails after alarm(), `sleep`');
-}
diff --git a/gnu/usr.bin/perl/t/op/caller.t b/gnu/usr.bin/perl/t/op/caller.t
index 54a6bac0a73..751a161de2a 100644
--- a/gnu/usr.bin/perl/t/op/caller.t
+++ b/gnu/usr.bin/perl/t/op/caller.t
@@ -5,12 +5,13 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 95 );
 }
 
+plan( tests => 20 );
+
 my @c;
 
-BEGIN { print "# Tests with caller(0)\n"; }
+print "# Tests with caller(0)\n";
 
 @c = caller(0);
 ok( (!@c), "caller(0) in main program" );
@@ -19,7 +20,7 @@ eval { @c = caller(0) };
 is( $c[3], "(eval)", "subroutine name in an eval {}" );
 ok( !$c[4], "hasargs false in an eval {}" );
 
-eval q{ @c = caller(0) };
+eval q{ @c = (Caller(0))[3] };
 is( $c[3], "(eval)", "subroutine name in an eval ''" );
 ok( !$c[4], "hasargs false in an eval ''" );
 
@@ -31,14 +32,8 @@ ok( $c[4], "hasargs true with anon sub" );
 sub foo { @c = caller(0) }
 my $fooref = delete $::{foo};
 $fooref -> ();
-is( $c[3], "main::__ANON__", "deleted subroutine name" );
-ok( $c[4], "hasargs true with deleted sub" );
-
-BEGIN {
- require strict;
- is +(caller 0)[1], __FILE__,
-  "[perl #68712] filenames after require in a BEGIN block"
-}
+is( $c[3], "(unknown)", "unknown subroutine name" );
+ok( $c[4], "hasargs true with unknown sub" );
 
 print "# Tests with caller(1)\n";
 
@@ -66,270 +61,5 @@ ok( $c[4], "hasargs true with anon sub" );
 sub foo2 { f() }
 my $fooref2 = delete $::{foo2};
 $fooref2 -> ();
-is( $c[3], "main::__ANON__", "deleted subroutine name" );
-ok( $c[4], "hasargs true with deleted sub" );
-
-# See if caller() returns the correct warning mask
-
-sub show_bits
-{
-    my $in = shift;
-    my $out = '';
-    foreach (unpack('W*', $in)) {
-        $out .= sprintf('\x%02x', $_);
-    }
-    return $out;
-}
-
-sub check_bits
-{
-    local $Level = $Level + 2;
-    my ($got, $exp, $desc) = @_;
-    if (! ok($got eq $exp, $desc)) {
-        diag('     got: ' . show_bits($got));
-        diag('expected: ' . show_bits($exp));
-    }
-}
-
-sub testwarn {
-    my $w = shift;
-    my $id = shift;
-    check_bits( (caller(0))[9], $w, "warnings match caller ($id)");
-}
-
-{
-    no warnings;
-    # Build the warnings mask dynamically
-    my ($default, $registered);
-    BEGIN {
-	for my $i (0..$warnings::LAST_BIT/2 - 1) {
-	    vec($default, $i, 2) = 1;
-	}
-	$registered = $default;
-	vec($registered, $warnings::LAST_BIT/2, 2) = 1;
-    }
-
-    # The repetition number must be set to the value of $BYTES in
-    # lib/warnings.pm
-    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 15, 'all bits off via "no warnings"' ) }
-    testwarn("\0" x 15, 'no bits');
-
-    use warnings;
-    BEGIN { check_bits( ${^WARNING_BITS}, $default,
-			'default bits on via "use warnings"' ); }
-    BEGIN { testwarn($default, 'all'); }
-    # run-time :
-    # the warning mask has been extended by warnings::register
-    testwarn($registered, 'ahead of w::r');
-
-    use warnings::register;
-    BEGIN { check_bits( ${^WARNING_BITS}, $registered,
-			'warning bits on via "use warnings::register"' ) }
-    testwarn($registered, 'following w::r');
-}
-
-
-# The next two cases test for a bug where caller ignored evals if
-# the DB::sub glob existed but &DB::sub did not (for example, if 
-# $^P had been set but no debugger has been loaded).  The tests
-# thus assume that there is no &DB::sub: if there is one, they 
-# should both pass  no matter whether or not this bug has been
-# fixed.
-
-my $debugger_test =  q<
-    my @stackinfo = caller(0);
-    return scalar @stackinfo;
->;
-
-sub pb { return (caller(0))[3] }
-
-my $i = eval $debugger_test;
-is( $i, 11, "do not skip over eval (and caller returns 10 elements)" );
-
-is( eval 'pb()', 'main::pb', "actually return the right function name" );
-
-my $saved_perldb = $^P;
-$^P = 16;
-$^P = $saved_perldb;
-
-$i = eval $debugger_test;
-is( $i, 11, 'do not skip over eval even if $^P had been on at some point' );
-is( eval 'pb()', 'main::pb', 'actually return the right function name even if $^P had been on at some point' );
-
-print "# caller can now return the compile time state of %^H\n";
-
-sub hint_exists {
-    my $key = shift;
-    my $level = shift;
-    my @results = caller($level||0);
-    exists $results[10]->{$key};
-}
-
-sub hint_fetch {
-    my $key = shift;
-    my $level = shift;
-    my @results = caller($level||0);
-    $results[10]->{$key};
-}
-
-{
-    my $tmpfile = tempfile();
-
-    open my $fh, '>', $tmpfile or die "open $tmpfile: $!";
-    print $fh <<'EOP';
-#!perl -wl
-use strict;
-
-{
-    package KAZASH ;
-
-    sub DESTROY {
-	print "DESTROY";
-    }
-}
-
-@DB::args = bless [], 'KAZASH';
-
-print $^P;
-print scalar @DB::args;
-
-{
-    local $^P = shift;
-}
-
-@DB::args = (); # At this point, the object should be freed.
-
-print $^P;
-print scalar @DB::args;
-
-# It shouldn't leak.
-EOP
-    close $fh;
-
-    foreach (0, 1) {
-        my $got = runperl(progfile => $tmpfile, args => [$_]);
-        $got =~ s/\s+/ /gs;
-        like($got, qr/\s*0 1 DESTROY 0 0\s*/,
-             "\@DB::args doesn't leak with \$^P = $_");
-    }
-}
-
-# This also used to leak [perl #97010]:
-{
-    my $gone;
-    sub fwib::DESTROY { ++$gone }
-    package DB;
-    sub { () = caller(0) }->(); # initialise PL_dbargs
-    @args = bless[],'fwib';
-    sub { () = caller(0) }->(); # clobber @args without initialisation
-    ::is $gone, 1, 'caller does not leak @DB::args elems when AvREAL';
-}
-
-# And this crashed [perl #93320]:
-sub {
-  package DB;
-  ()=caller(0);
-  undef *DB::args;
-  ()=caller(0);
-}->();
-pass 'No crash when @DB::args is freed between caller calls';
-
-# This also crashed:
-package glelp;
-sub TIEARRAY { bless [] }
-sub EXTEND   {         }
-sub CLEAR    {        }
-sub FETCH    { $_[0][$_[1]] }
-sub STORE    { $_[0][$_[1]] = $_[2] }
-package DB;
-tie @args, 'glelp';
-eval { sub { () = caller 0; } ->(1..3) };
-::like $@, qr "^Cannot set tied \@DB::args at ",
-              'caller dies with tie @DB::args';
-::ok tied @args, '@DB::args is still tied';
-untie @args;
-package main;
-
-# [perl #113486]
-fresh_perl_is <<'END', "ok\n", {},
-  { package foo; sub bar { main::bar() } }
-  sub bar {
-    delete $::{"foo::"};
-    my $x = \($1+2);
-    my $y = \($1+2); # this is the one that reuses the mem addr, but
-    my $z = \($1+2);  # try the others just in case
-    s/2// for $$x, $$y, $$z; # now SvOOK
-    $x = caller;
-    print "ok\n";
-};
-foo::bar
-END
-    "No crash when freed stash is reused for PV with offset hack";
-
-is eval "(caller 0)[6]", "(caller 0)[6]",
-  'eval text returned by caller does not include \n;';
-
-if (1) {
-    is (sub { (caller)[2] }->(), __LINE__,
-      '[perl #115768] caller gets line numbers from nulled cops');
-}
-# Test it at the end of the program, too.
-fresh_perl_is(<<'115768', 2, {},
-  if (1) {
-    foo();
-  }
-  sub foo { print +(caller)[2] }
-115768
-    '[perl #115768] caller gets line numbers from nulled cops (2)');
-
-# PL_linestr should not be modifiable
-eval '"${;BEGIN{  ${\(caller 2)[6]} = *foo  }}"';
-pass "no assertion failure after modifying eval text via caller";
-
-is eval "<<END;\nfoo\nEND\n(caller 0)[6]",
-        "<<END;\nfoo\nEND\n(caller 0)[6]",
-        'here-docs do not gut eval text';
-is eval "s//<<END/e;\nfoo\nEND\n(caller 0)[6]",
-        "s//<<END/e;\nfoo\nEND\n(caller 0)[6]",
-        'here-docs in quote-like ops do not gut eval text';
-
-# The bitmask should be assignable to ${^WARNING_BITS} without resulting in
-# different warnings settings.
-{
- my $ bits = sub { (caller 0)[9] }->();
- my $w;
- local $SIG{__WARN__} = sub { $w++ };
- eval '
-   use warnings;
-   BEGIN { ${^WARNING_BITS} = $bits }
-   local $^W = 1;
-   () = 1 + undef;
-   $^W = 0;
-   () = 1 + undef;
- ';
- is $w, 1, 'value from (caller 0)[9] (bitmask) works in ${^WARNING_BITS}';
-}
-
-# This was fixed with commit d4d03940c58a0177, which fixed bug #78742
-fresh_perl_is <<'END', "__ANON__::doof\n", {},
-package foo;
-BEGIN {undef %foo::}
-sub doof { caller(0) }
-print +(doof())[3];
-END
-    "caller should not SEGV when the current package is undefined";
-
-# caller should not SEGV when the eval entry has been cleared #120998
-fresh_perl_is <<'END', 'main', {},
-$SIG{__DIE__} = \&dbdie;
-eval '/x';
-sub dbdie {
-    @x = caller(1);
-    print $x[0];
-}
-END
-    "caller should not SEGV for eval '' stack frames";
-
-$::testing_caller = 1;
-
-do './op/caller.pl' or die $@;
+is( $c[3], "(unknown)", "unknown subroutine name" );
+ok( $c[4], "hasargs true with unknown sub" );
diff --git a/gnu/usr.bin/perl/t/op/chdir.t b/gnu/usr.bin/perl/t/op/chdir.t
index 2c6535bde93..2932b922ea6 100644
--- a/gnu/usr.bin/perl/t/op/chdir.t
+++ b/gnu/usr.bin/perl/t/op/chdir.t
@@ -5,35 +5,14 @@ BEGIN {
     # chdir() works!  Instead, we'll hedge our bets and put both
     # possibilities into @INC.
     @INC = qw(t . lib ../lib);
-    require "test.pl";
-    # Really want to know if chdir is working, as the build process will all go
-    # wrong if it is not.
-    if (is_miniperl() && !eval {require File::Spec::Functions; 1}) {
-	push @INC, qw(dist/Cwd/lib dist/Cwd ../dist/Cwd/lib ../dist/Cwd);
-    }
-    plan(tests => 48);
 }
 
 use Config;
+require "test.pl";
+plan(tests => 31);
 
 my $IsVMS   = $^O eq 'VMS';
-
-my $vms_unix_rpt = 0;
-my $vms_efs = 0;
-if ($IsVMS) {
-    if (eval 'require VMS::Feature') {
-        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
-        $vms_efs = VMS::Feature::current("efs_charset");
-    } else {
-        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
-        my $efs_charset = $ENV{'DECC$EFS_CHARSET'} || '';
-        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
-        $vms_efs = $efs_charset =~ /^[ET1]/i; 
-    }
-}
-
-# For an op regression test, I don't want to rely on "use constant" working.
-my $has_fchdir = ($Config{d_fchdir} || "") eq "define";
+my $IsMacOS = $^O eq 'MacOS';
 
 # Might be a little early in the testing process to start using these,
 # but I can't think of a way to write this test without them.
@@ -42,9 +21,7 @@ use File::Spec::Functions qw(:DEFAULT splitdir rel2abs splitpath);
 # Can't use Cwd::abs_path() because it has different ideas about
 # path separators than File::Spec.
 sub abs_path {
-    my $d = rel2abs(curdir);
-    $d = lc($d) if $^O =~ /^uwin/;
-    $d;
+    $IsVMS ? uc(rel2abs(curdir)) : rel2abs(curdir);
 }
 
 my $Cwd = abs_path;
@@ -52,14 +29,8 @@ my $Cwd = abs_path;
 # Let's get to a known position
 SKIP: {
     my ($vol,$dir) = splitpath(abs_path,1);
-    my $test_dir = 't';
-    my $compare_dir = (splitdir($dir))[-1];
-
-    # VMS is case insensitive but will preserve case in EFS mode.
-    # So we must normalize the case for the compare.
- 
-    $compare_dir = lc($compare_dir) if $IsVMS;
-    skip("Already in t/", 2) if $compare_dir eq $test_dir;
+    my $test_dir = $IsVMS ? 'T' : 't';
+    skip("Already in t/", 2) if (splitdir($dir))[-1] eq $test_dir;
 
     ok( chdir($test_dir),     'chdir($test_dir)');
     is( abs_path, catdir($Cwd, $test_dir),    '  abs_path() agrees' );
@@ -67,70 +38,6 @@ SKIP: {
 
 $Cwd = abs_path;
 
-SKIP: {
-    skip("no fchdir", 16) unless $has_fchdir;
-    my $has_dirfd = ($Config{d_dirfd} || $Config{d_dir_dd_fd} || "") eq "define";
-    ok(opendir(my $dh, "."), "opendir .");
-    ok(open(my $fh, "<", "op"), "open op");
-    ok(chdir($fh), "fchdir op");
-    ok(-f "chdir.t", "verify that we are in op");
-    if ($has_dirfd) {
-       ok(chdir($dh), "fchdir back");
-    }
-    else {
-       eval { chdir($dh); };
-       like($@, qr/^The dirfd function is unimplemented at/, "dirfd is unimplemented");
-       chdir ".." or die $!;
-    }
-
-    # same with bareword file handles
-    no warnings 'once';
-    *DH = $dh;
-    *FH = $fh;
-    ok(chdir FH, "fchdir op bareword");
-    ok(-f "chdir.t", "verify that we are in op");
-    if ($has_dirfd) {
-       ok(chdir DH, "fchdir back bareword");
-    }
-    else {
-       eval { chdir(DH); };
-       like($@, qr/^The dirfd function is unimplemented at/, "dirfd is unimplemented");
-       chdir ".." or die $!;
-    }
-    ok(-d "op", "verify that we are back");
-
-    # And now the ambiguous case
-    {
-	no warnings qw<io deprecated>;
-	ok(opendir(H, "op"), "opendir op") or diag $!;
-	ok(open(H, "<", "base"), "open base") or diag $!;
-    }
-    if ($has_dirfd) {
-	ok(chdir(H), "fchdir to op");
-	ok(-f "chdir.t", "verify that we are in 'op'");
-	chdir ".." or die $!;
-    }
-    else {
-	eval { chdir(H); };
-	like($@, qr/^The dirfd function is unimplemented at/,
-	     "dirfd is unimplemented");
-	SKIP: {
-	    skip("dirfd is unimplemented");
-	}
-    }
-    ok(closedir(H), "closedir");
-    ok(chdir(H), "fchdir to base");
-    ok(-f "cond.t", "verify that we are in 'base'");
-    chdir ".." or die $!;
-}
-
-SKIP: {
-    skip("has fchdir", 1) if $has_fchdir;
-    opendir(my $dh, "op");
-    eval { chdir($dh); };
-    like($@, qr/^The fchdir function is unimplemented at/, "fchdir is unimplemented");
-}
-
 # The environment variables chdir() pays attention to.
 my @magic_envs = qw(HOME LOGDIR SYS$LOGIN);
 
@@ -138,7 +45,7 @@ sub check_env {
     my($key) = @_;
 
     # Make sure $ENV{'SYS$LOGIN'} is only honored on VMS.
-    if( $key eq 'SYS$LOGIN' && !$IsVMS ) {
+    if( $key eq 'SYS$LOGIN' && !$IsVMS && !$IsMacOS ) {
         ok( !chdir(),         "chdir() on $^O ignores only \$ENV{$key} set" );
         is( abs_path, $Cwd,   '  abs_path() did not change' );
         pass( "  no need to test SYS\$LOGIN on $^O" ) for 1..7;
@@ -186,8 +93,10 @@ sub clean_env {
         next if $IsVMS && $env eq 'SYS$LOGIN';
         next if $IsVMS && $env eq 'HOME' && !$Config{'d_setenv'};
 
-	# On VMS, %ENV is many layered.
-	delete $ENV{$env} while exists $ENV{$env};
+        unless ($IsMacOS) { # ENV on MacOS is "special" :-)
+            # On VMS, %ENV is many layered.
+            delete $ENV{$env} while exists $ENV{$env};
+        }
     }
 
     # The following means we won't really be testing for non-existence,
@@ -201,10 +110,6 @@ END {
 
     # Restore the environment for VMS (and doesn't hurt for anyone else)
     @ENV{@magic_envs} = @Saved_Env{@magic_envs};
-
-    # On VMS this must be deleted or process table is wrong on exit
-    # when this script is run interactively.
-    delete $ENV{'SYS$LOGIN'} if $IsVMS;
 }
 
 
@@ -220,7 +125,7 @@ foreach my $key (@magic_envs) {
 
 {
     clean_env;
-    if ($IsVMS && !$Config{'d_setenv'}) {
+    if (($IsVMS || $IsMacOS) && !$Config{'d_setenv'}) {
         pass("Can't reset HOME, so chdir() test meaningless");
     } else {
         ok( !chdir(),                   'chdir() w/o any ENV set' );
diff --git a/gnu/usr.bin/perl/t/op/gmagic.t b/gnu/usr.bin/perl/t/op/gmagic.t
index bcf1322578c..ab6d2ee3e65 100644
--- a/gnu/usr.bin/perl/t/op/gmagic.t
+++ b/gnu/usr.bin/perl/t/op/gmagic.t
@@ -1,188 +1,54 @@
 #!./perl -w
 
 BEGIN {
+    $| = 1;
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
 }
 
-use strict;
+print "1..18\n";
 
+my $t = 1;
 tie my $c => 'Tie::Monitor';
 
-sub expected_tie_calls {
-    my ($obj, $rexp, $wexp, $tn) = @_;
-    local $::Level = $::Level + 1;
-    my ($rgot, $wgot) = $obj->init();
-    is ($rgot, $rexp, $tn ? "number of fetches when $tn" : ());
-    is ($wgot, $wexp, $tn ? "number of stores when $tn" : ());
+sub ok {
+    my($ok, $got, $exp, $rexp, $wexp) = @_;
+    my($rgot, $wgot) = (tied $c)->init(0);
+    print $ok ? "ok $t\n" : "# expected $exp, got $got\nnot ok $t\n";
+    ++$t;
+    if ($rexp == $rgot && $wexp == $wgot) {
+	print "ok $t\n";
+    } else {
+	print "# read $rgot expecting $rexp\n" if $rgot != $rexp;
+	print "# wrote $wgot expecting $wexp\n" if $wgot != $wexp;
+	print "not ok $t\n";
+    }
+    ++$t;
 }
 
-# Use ok() instead of is(), cmp_ok() etc, to strictly control number of accesses
+sub ok_undef { ok(!defined($_[0]), shift, "undef", @_) }
+sub ok_numeric { ok($_[0] == $_[1], @_) }
+sub ok_string { ok($_[0] eq $_[1], @_) }
+
 my($r, $s);
-ok($r = $c + 0 == 0, 'the thing itself');
-expected_tie_calls(tied $c, 1, 0);
-ok($r = "$c" eq '0', 'the thing itself');
-expected_tie_calls(tied $c, 1, 0);
+# the thing itself
+ok_numeric($r = $c + 0, 0, 1, 0);
+ok_string($r = "$c", '0', 1, 0);
 
-ok($c . 'x' eq '0x', 'concat');
-expected_tie_calls(tied $c, 1, 0);
-ok('x' . $c eq 'x0', 'concat');
-expected_tie_calls(tied $c, 1, 0);
+# concat
+ok_string($c . 'x', '0x', 1, 0);
+ok_string('x' . $c, 'x0', 1, 0);
 $s = $c . $c;
-ok($s eq '00', 'concat');
-expected_tie_calls(tied $c, 2, 0);
+ok_string($s, '00', 2, 0);
 $r = 'x';
 $s = $c = $r . 'y';
-ok($s eq 'xy', 'concat');
-expected_tie_calls(tied $c, 1, 1);
+ok_string($s, 'xy', 1, 1);
 $s = $c = $c . 'x';
-ok($s eq '0x', 'concat');
-expected_tie_calls(tied $c, 2, 1);
+ok_string($s, '0x', 2, 1);
 $s = $c = 'x' . $c;
-ok($s eq 'x0', 'concat');
-expected_tie_calls(tied $c, 2, 1);
+ok_string($s, 'x0', 2, 1);
 $s = $c = $c . $c;
-ok($s eq '00', 'concat');
-expected_tie_calls(tied $c, 3, 1);
-
-$s = chop($c);
-ok($s eq '0', 'multiple magic in core functions');
-expected_tie_calls(tied $c, 1, 1);
-
-$c = *strat;
-$s = $c;
-ok($s eq *strat,
-   'Assignment should not ignore magic when the last thing assigned was a glob');
-expected_tie_calls(tied $c, 1, 1);
-
-package o { use overload '""' => sub { "foo\n" } }
-$c = bless [], o::;
-chomp $c;
-expected_tie_calls(tied $c, 1, 2, 'chomping a ref');
-
-{
-    my $outfile = tempfile();
-    open my $h, ">$outfile" or die  "$0 cannot close $outfile: $!";
-    print $h "bar\n";
-    close $h or die "$0 cannot close $outfile: $!";    
-
-    $c = *foo;                                         # 1 write
-    open $h, $outfile;
-    sysread $h, $c, 3, 7;                              # 1 read; 1 write
-    is $c, "*main::bar", 'what sysread wrote';         # 1 read
-    expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
-    close $h or die "$0 cannot close $outfile: $!";
-
- # Do this again, with a utf8 handle
-    $c = *foo;                                         # 1 write
-    open $h, "<:utf8", $outfile;
-    sysread $h, $c, 3, 7;                              # 1 read; 1 write
-    is $c, "*main::bar", 'what sysread wrote';         # 1 read
-    expected_tie_calls(tied $c, 2, 2, 'calling sysread with tied buf');
-    close $h or die "$0 cannot close $outfile: $!";
-
-    unlink_all $outfile;
-}
-
-# autovivication of aelem, helem, of rv2sv combined with get-magic
-{
-    my $true = 1;
-    my $s;
-    tie $$s, "Tie::Monitor";
-    $$s = undef;
-    $$s->[0] = 73;
-    is($$s->[0], 73);
-    expected_tie_calls(tied $$s, 3, 2);
-
-    my @a;
-    tie $a[0], "Tie::Monitor";
-    $a[0] = undef;
-    $a[0][0] = 73;
-    is($a[0][0], 73);
-    expected_tie_calls(tied $a[0], 3, 2);
-
-    my %h;
-    tie $h{foo}, "Tie::Monitor";
-    $h{foo} = undef;
-    $h{foo}{bar} = 73;
-    is($h{foo}{bar}, 73);
-    expected_tie_calls(tied $h{foo}, 3, 2);
-
-    # Similar tests, but with obscured autovivication by using dummy list or "?:" operator
-    $$s = undef;
-    ${ (), $$s }[0] = 73;
-    is( $$s->[0], 73);
-    expected_tie_calls(tied $$s, 3, 2);
-
-    $$s = undef;
-    ( ! $true ? undef : $$s )->[0] = 73;
-    is( $$s->[0], 73);
-    expected_tie_calls(tied $$s, 3, 2);
-
-    $$s = undef;
-    ( $true ? $$s : undef )->[0] = 73;
-    is( $$s->[0], 73);
-    expected_tie_calls(tied $$s, 3, 2);
-}
-
-# A plain *foo should not call get-magic on *foo.
-# This method of scalar-tying an immutable glob relies on details of the
-# current implementation that are subject to change. This test may need to
-# be rewritten if they do change.
-my $tyre = tie $::{gelp} => 'Tie::Monitor';
-# Compilation of this eval autovivifies the *gelp glob.
-eval '$tyre->init(0); () = \*gelp';
-my($rgot, $wgot) = $tyre->init(0);
-ok($rgot == 0, 'a plain *foo causes no get-magic');
-ok($wgot == 0, 'a plain *foo causes no set-magic');
-
-# get-magic when exiting a non-lvalue sub in potentially autovivify-
-# ing context
-{
-  no strict;
-
-  my $tied_to = tie $_{elem}, "Tie::Monitor";
-  () = sub { delete $_{elem} }->()->[3];
-  expected_tie_calls $tied_to, 1, 0,
-     'mortal magic var is implicitly returned in autoviv context';
-
-  $tied_to = tie $_{elem}, "Tie::Monitor";
-  () = sub { return delete $_{elem} }->()->[3];
-  expected_tie_calls $tied_to, 1, 0,
-      'mortal magic var is explicitly returned in autoviv context';
-
-  $tied_to = tie $_{elem}, "Tie::Monitor";
-  my $rsub;
-  $rsub = sub { if ($_[0]) { delete $_{elem} } else { &$rsub(1)->[3] } };
-  &$rsub;
-  expected_tie_calls $tied_to, 1, 0,
-    'mortal magic var is implicitly returned in recursive autoviv context';
-
-  $tied_to = tie $_{elem}, "Tie::Monitor";
-  $rsub = sub {
-    if ($_[0]) { return delete $_{elem} } else { &$rsub(1)->[3] }
-  };
-  &$rsub;
-  expected_tie_calls $tied_to, 1, 0,
-    'mortal magic var is explicitly returned in recursive autoviv context';
-
-  $tied_to = tie $_{elem}, "Tie::Monitor";
-  my $x = \sub { delete $_{elem} }->();
-  expected_tie_calls $tied_to, 1, 0,
-     'mortal magic var is implicitly returned to refgen';
-  is tied $$x, undef,
-     'mortal magic var is copied when implicitly returned';
-
-  $tied_to = tie $_{elem}, "Tie::Monitor";
-  $x = \sub { return delete $_{elem} }->();
-  expected_tie_calls $tied_to, 1, 0,
-     'mortal magic var is explicitly returned to refgen';
-  is tied $$x, undef,
-     'mortal magic var is copied when explicitly returned';
-}
-
-done_testing();
+ok_string($s, '00', 3, 1);
 
 # adapted from Tie::Counter by Abigail
 package Tie::Monitor;
diff --git a/gnu/usr.bin/perl/t/op/inccode.t b/gnu/usr.bin/perl/t/op/inccode.t
index 1a0b9197cd3..1a3d3cf3e1a 100644
--- a/gnu/usr.bin/perl/t/op/inccode.t
+++ b/gnu/usr.bin/perl/t/op/inccode.t
@@ -5,34 +5,28 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = qw(. ../lib);
-    require './test.pl';
 }
 
-use Config;
+use File::Spec;
 
-my $can_fork   = 0;
-my $has_perlio = $Config{useperlio};
+require "test.pl";
+plan(tests => 44);
 
-unless (is_miniperl()) {
-    if ($Config{d_fork} && eval 'require POSIX; 1') {
-	$can_fork = 1;
-    }
-}
-
-use strict;
-
-plan(tests => 68 + !is_miniperl() * (3 + 14 * $can_fork));
+my @tempfiles = ();
 
 sub get_temp_fh {
-    my $f = tempfile();
+    my $f = "DummyModule0000";
+    1 while -e ++$f;
+    push @tempfiles, $f;
     open my $fh, ">$f" or die "Can't create $f: $!";
-    print $fh "package ".substr($_[0],0,-3).";\n1;\n";
-    print $fh $_[1] if @_ > 1;
+    print $fh "package ".substr($_[0],0,-3)."; 1;";
     close $fh or die "Couldn't close: $!";
     open $fh, $f or die "Can't open $f: $!";
     return $fh;
 }
 
+END { 1 while unlink @tempfiles }
+
 sub fooinc {
     my ($self, $filename) = @_;
     if (substr($filename,0,3) eq 'Foo') {
@@ -179,220 +173,10 @@ is( $INC{'Toto.pm'}, 'xyz',	   '  val Toto.pm is correct in %INC' );
 
 pop @INC;
 
-push @INC, sub {
-    my ($self, $filename) = @_;
-    if ($filename eq 'abc.pl') {
-	return get_temp_fh($filename, qq(return "abc";\n));
-    }
-    else {
-	return undef;
-    }
-};
-
-my $ret = "";
-$ret ||= do 'abc.pl';
-is( $ret, 'abc', 'do "abc.pl" sees return value' );
-
-{
-    my $got;
-    #local @INC; # local fails on tied @INC
-    my @old_INC = @INC; # because local doesn't work on tied arrays
-    @INC = ('lib', 'lib/Devel', sub { $got = $_[1]; return undef; });
-    foreach my $filename ('/test_require.pm', './test_require.pm',
-			  '../test_require.pm') {
-	local %INC;
-	undef $got;
-	undef $test_require::loaded;
-	eval { require $filename; };
-	is($got, $filename, "the coderef sees the pathname $filename");
-	is($test_require::loaded, undef, 'no module is loaded' );
-    }
-
-    local %INC;
-    undef $got;
-    undef $test_require::loaded;
-
-    eval { require 'test_require.pm'; };
-    is($got, undef, 'the directory is scanned for test_require.pm');
-    is($test_require::loaded, 1, 'the module is loaded');
-    @INC = @old_INC;
-}
-
-# this will segfault if it fails
-
-sub PVBM () { 'foo' }
-{ my $dummy = index 'foo', PVBM }
-
-# I don't know whether these requires should succeed or fail. 5.8 failed
-# all of them; 5.10 with an ordinary constant in place of PVBM lets the
-# latter two succeed. For now I don't care, as long as they don't
-# segfault :).
-
-unshift @INC, sub { PVBM };
-eval 'require foo';
-ok( 1, 'returning PVBM doesn\'t segfault require' );
-eval 'use foo';
-ok( 1, 'returning PVBM doesn\'t segfault use' );
-shift @INC;
-unshift @INC, sub { \PVBM };
-eval 'require foo';
-ok( 1, 'returning PVBM ref doesn\'t segfault require' );
-eval 'use foo';
-ok( 1, 'returning PVBM ref doesn\'t segfault use' );
-shift @INC;
-
-# [perl #92252]
-{
-    my $die = sub { die };
-    my $data = [];
-    unshift @INC, sub { $die, $data };
-
-    my $initial_sub_refcnt = &Internals::SvREFCNT($die);
-    my $initial_data_refcnt = &Internals::SvREFCNT($data);
-
-    do "foo";
-    is(&Internals::SvREFCNT($die), $initial_sub_refcnt, "no leaks");
-    is(&Internals::SvREFCNT($data), $initial_data_refcnt, "no leaks");
-
-    do "bar";
-    is(&Internals::SvREFCNT($die), $initial_sub_refcnt, "no leaks");
-    is(&Internals::SvREFCNT($data), $initial_data_refcnt, "no leaks");
-
-    shift @INC;
-}
-
-unshift @INC, sub { \(my $tmp = '$_ = "are temps freed prematurely?"') };
-eval { require foom };
-is $_||$@, "are temps freed prematurely?",
-           "are temps freed prematurely when returned from inc filters?";
-shift @INC;
-
-# [perl #120657]
-sub fake_module {
-    my (undef,$module_file) = @_;
-    !1
-}
+my $filename = $^O eq 'MacOS' ? ':Foo:Foo.pm' : './Foo.pm';
 {
-    local @INC = @INC;
-    unshift @INC, (\&fake_module)x2;
-    eval { require "${\'bralbalhablah'}" };
-    like $@, qr/^Can't locate/,
-        'require PADTMP passing freed var when @INC has multiple subs';

-}    
-
-SKIP: {
-    skip ("Not applicable when run from inccode-tie.t", 6) if tied @INC;
-    require Tie::Scalar;
-    package INCtie {
-        sub TIESCALAR { bless \my $foo }
-        sub FETCH { study; our $count++; ${$_[0]} }
-    }
-    local @INC = undef;
-    my $t = tie $INC[0], 'INCtie';
-    my $called;
-    $$t = sub { $called ++; !1 };
-    delete $INC{'foo.pm'}; # in case another test uses foo
-    eval { require foo };
-    is $INCtie::count, 2, # 2nd time for "Can't locate" -- XXX correct?
-        'FETCH is called once on undef scalar-tied @INC elem';
-    is $called, 1, 'sub in scalar-tied @INC elem is called';
-    () = "$INC[0]"; # force a fetch, so the SV is ROK
-    $INCtie::count = 0;
-    eval { require foo };
-    is $INCtie::count, 2,
-        'FETCH is called once on scalar-tied @INC elem holding ref';
-    is $called, 2, 'sub in scalar-tied @INC elem holding ref is called';
-    $$t = [];
-    $INCtie::count = 0;
-    eval { require foo };
-    is $INCtie::count, 1,
-       'FETCH called once on scalar-tied @INC elem returning array';
-    $$t = "string";
-    $INCtie::count = 0;
-    eval { require foo };
-    is $INCtie::count, 2,
-       'FETCH called once on scalar-tied @INC elem returning string';
-}
-
-
-exit if is_miniperl();
-
-SKIP: {
-    skip( "No PerlIO available", 3 ) unless $has_perlio;
-    pop @INC;
-
-    push @INC, sub {
-        my ($cr, $filename) = @_;
-        my $module = $filename; $module =~ s,/,::,g; $module =~ s/\.pm$//;
-        open my $fh, '<',
-             \"package $module; sub complain { warn q() }; \$::file = __FILE__;"
-	    or die $!;
-        $INC{$filename} = "/custom/path/to/$filename";
-        return $fh;
-    };
-
-    require Publius::Vergilius::Maro;
-    is( $INC{'Publius/Vergilius/Maro.pm'},
-        '/custom/path/to/Publius/Vergilius/Maro.pm', '%INC set correctly');
-    is( our $file, '/custom/path/to/Publius/Vergilius/Maro.pm',
-        '__FILE__ set correctly' );
-    {
-        my $warning;
-        local $SIG{__WARN__} = sub { $warning = shift };
-        Publius::Vergilius::Maro::complain();
-        like( $warning, qr{something's wrong at /custom/path/to/Publius/Vergilius/Maro.pm}, 'warn() reports correct file source' );
-    }
-}
-pop @INC;
-
-if ($can_fork) {
-    require PerlIO::scalar;
-    # This little bundle of joy generates n more recursive use statements,
-    # with each module chaining the next one down to 0. If it works, then we
-    # can safely nest subprocesses
-    my $use_filter_too;
-    push @INC, sub {
-	return unless $_[1] =~ /^BBBLPLAST(\d+)\.pm/;
-	my $pid = open my $fh, "-|";
-	if ($pid) {
-	    # Parent
-	    return $fh unless $use_filter_too;
-	    # Try filters and state in addition.
-	    return ($fh, sub {s/$_[1]/pass/; return}, "die")
-	}
-	die "Can't fork self: $!" unless defined $pid;
-
-	# Child
-	my $count = $1;
-	# Lets force some fun with odd sized reads.
-	$| = 1;
-	print 'push @main::bbblplast, ';
-	print "$count;\n";
-	if ($count--) {
-	    print "use BBBLPLAST$count;\n";
-	}
-	if ($use_filter_too) {
-	    print "die('In $_[1]');";
-	} else {
-	    print "pass('In $_[1]');";
-	}
-	print '"Truth"';
-	POSIX::_exit(0);
-	die "Can't get here: $!";
-    };
-
-    @::bbblplast = ();
-    require BBBLPLAST5;
-    is ("@::bbblplast", "0 1 2 3 4 5", "All ran");
-
-    foreach (keys %INC) {
-	delete $INC{$_} if /^BBBLPLAST/;
-    }
-
-    @::bbblplast = ();
-    $use_filter_too = 1;
-
-    require BBBLPLAST5;
-
-    is ("@::bbblplast", "0 1 2 3 4 5", "All ran with a filter");
+    local @INC;
+    @INC = sub { $filename = 'seen'; return undef; };
+    eval { require $filename; };
+    is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
 }
diff --git a/gnu/usr.bin/perl/t/op/lc.t b/gnu/usr.bin/perl/t/op/lc.t
index 38d2b6b6706..1fbb3e1afbf 100644
--- a/gnu/usr.bin/perl/t/op/lc.t
+++ b/gnu/usr.bin/perl/t/op/lc.t
@@ -1,128 +1,112 @@
 #!./perl
 
-# This file is intentionally encoded in latin-1.
-
-BEGIN {
-    chdir 't';
-    @INC = '../lib';
-    require Config; import Config;
-    require './test.pl';
-    require './loc_tools.pl';   # Contains find_utf8_ctype_locale()
-}
-
-use feature qw( fc );
-
-plan tests => 134 + 4 * 256;
-
-is(lc(undef),	   "", "lc(undef) is ''");
-is(lcfirst(undef), "", "lcfirst(undef) is ''");
-is(uc(undef),	   "", "uc(undef) is ''");
-is(ucfirst(undef), "", "ucfirst(undef) is ''");
-
-{
-    no feature 'fc';
-    is(CORE::fc(undef), "", "fc(undef) is ''");
-    is(CORE::fc(''),    "", "fc('') is ''");
-
-    local $@;
-    eval { fc("eeyup") };
-    like($@, qr/Undefined subroutine &main::fc/, "fc() throws an exception,");
-
-    {
-        use feature 'fc';
-        local $@;
-        eval { fc("eeyup") };
-        ok(!$@, "...but works after requesting the feature");
+print "1..51\n";
+
+my $test = 1;
+
+sub ok {
+    if ($_[0]) {
+	if ($_[1]) {
+	    print "ok $test - $_[1]\n";
+	} else {
+	    print "ok $test\n";
+	}
+    } else {
+	if ($_[1]) {
+	    print "not ok $test - $_[1]\n";
+	} else {
+	    print "not ok $test\n";
+	}
     }
+    $test++;
 }
 
 $a = "HELLO.* world";
 $b = "hello.* WORLD";
 
-is("\Q$a\E."      , "HELLO\\.\\*\\ world.", '\Q\E HELLO.* world');
-is("\u$a"         , "HELLO\.\* world",      '\u');
-is("\l$a"         , "hELLO\.\* world",      '\l');
-is("\U$a"         , "HELLO\.\* WORLD",      '\U');
-is("\L$a"         , "hello\.\* world",      '\L');
-is("\F$a"         , "hello\.\* world",      '\F');
-
-is(quotemeta($a)  , "HELLO\\.\\*\\ world",  'quotemeta');
-is(ucfirst($a)    , "HELLO\.\* world",      'ucfirst');
-is(lcfirst($a)    , "hELLO\.\* world",      'lcfirst');
-is(uc($a)         , "HELLO\.\* WORLD",      'uc');
-is(lc($a)         , "hello\.\* world",      'lc');
-is(fc($a)         , "hello\.\* world",      'fc');
-
-is("\Q$b\E."      , "hello\\.\\*\\ WORLD.", '\Q\E hello.* WORLD');
-is("\u$b"         , "Hello\.\* WORLD",      '\u');
-is("\l$b"         , "hello\.\* WORLD",      '\l');
-is("\U$b"         , "HELLO\.\* WORLD",      '\U');
-is("\L$b"         , "hello\.\* world",      '\L');
-is("\F$b"         , "hello\.\* world",      '\F');
-
-is(quotemeta($b)  , "hello\\.\\*\\ WORLD",  'quotemeta');
-is(ucfirst($b)    , "Hello\.\* WORLD",      'ucfirst');
-is(lcfirst($b)    , "hello\.\* WORLD",      'lcfirst');
-is(uc($b)         , "HELLO\.\* WORLD",      'uc');
-is(lc($b)         , "hello\.\* world",      'lc');
-is(fc($b)         , "hello\.\* world",      'fc');
+ok("\Q$a\E."      eq "HELLO\\.\\*\\ world.", '\Q\E HELLO.* world');
+ok("\u$a"         eq "HELLO\.\* world",      '\u');
+ok("\l$a"         eq "hELLO\.\* world",      '\l');
+ok("\U$a"         eq "HELLO\.\* WORLD",      '\U');
+ok("\L$a"         eq "hello\.\* world",      '\L');
+
+ok(quotemeta($a)  eq "HELLO\\.\\*\\ world",  'quotemeta');
+ok(ucfirst($a)    eq "HELLO\.\* world",      'ucfirst');
+ok(lcfirst($a)    eq "hELLO\.\* world",      'lcfirst');
+ok(uc($a)         eq "HELLO\.\* WORLD",      'uc');
+ok(lc($a)         eq "hello\.\* world",      'lc');
+
+ok("\Q$b\E."      eq "hello\\.\\*\\ WORLD.", '\Q\E hello.* WORLD');
+ok("\u$b"         eq "Hello\.\* WORLD",      '\u');
+ok("\l$b"         eq "hello\.\* WORLD",      '\l');
+ok("\U$b"         eq "HELLO\.\* WORLD",      '\U');
+ok("\L$b"         eq "hello\.\* world",      '\L');
+
+ok(quotemeta($b)  eq "hello\\.\\*\\ WORLD",  'quotemeta');
+ok(ucfirst($b)    eq "Hello\.\* WORLD",      'ucfirst');
+ok(lcfirst($b)    eq "hello\.\* WORLD",      'lcfirst');
+ok(uc($b)         eq "HELLO\.\* WORLD",      'uc');
+ok(lc($b)         eq "hello\.\* world",      'lc');
 
 # \x{100} is LATIN CAPITAL LETTER A WITH MACRON; its bijective lowercase is
 # \x{101}, LATIN SMALL LETTER A WITH MACRON.
-# Which is also its foldcase.
 
 $a = "\x{100}\x{101}Aa";
 $b = "\x{101}\x{100}aA";
 
-is("\Q$a\E."      , "\x{100}\x{101}Aa.", '\Q\E \x{100}\x{101}Aa');
-is("\u$a"         , "\x{100}\x{101}Aa",  '\u');
-is("\l$a"         , "\x{101}\x{101}Aa",  '\l');
-is("\U$a"         , "\x{100}\x{100}AA",  '\U');
-is("\L$a"         , "\x{101}\x{101}aa",  '\L');
-is("\F$a"         , "\x{101}\x{101}aa",  '\F');
-
-is(quotemeta($a)  , "\x{100}\x{101}Aa",  'quotemeta');
-is(ucfirst($a)    , "\x{100}\x{101}Aa",  'ucfirst');
-is(lcfirst($a)    , "\x{101}\x{101}Aa",  'lcfirst');
-is(uc($a)         , "\x{100}\x{100}AA",  'uc');
-is(lc($a)         , "\x{101}\x{101}aa",  'lc');
-is(fc($a)         , "\x{101}\x{101}aa",  'fc');
-
-is("\Q$b\E."      , "\x{101}\x{100}aA.", '\Q\E \x{101}\x{100}aA');
-is("\u$b"         , "\x{100}\x{100}aA",  '\u');
-is("\l$b"         , "\x{101}\x{100}aA",  '\l');
-is("\U$b"         , "\x{100}\x{100}AA",  '\U');
-is("\L$b"         , "\x{101}\x{101}aa",  '\L');
-is("\F$b"         , "\x{101}\x{101}aa",  '\F');
-
-is(quotemeta($b)  , "\x{101}\x{100}aA",  'quotemeta');
-is(ucfirst($b)    , "\x{100}\x{100}aA",  'ucfirst');
-is(lcfirst($b)    , "\x{101}\x{100}aA",  'lcfirst');
-is(uc($b)         , "\x{100}\x{100}AA",  'uc');
-is(lc($b)         , "\x{101}\x{101}aa",  'lc');
-is(fc($b)         , "\x{101}\x{101}aa",  'fc');
+ok("\Q$a\E."      eq "\x{100}\x{101}Aa.", '\Q\E \x{100}\x{101}Aa');
+ok("\u$a"         eq "\x{100}\x{101}Aa",  '\u');
+ok("\l$a"         eq "\x{101}\x{101}Aa",  '\l');
+ok("\U$a"         eq "\x{100}\x{100}AA",  '\U');
+ok("\L$a"         eq "\x{101}\x{101}aa",  '\L');
+
+ok(quotemeta($a)  eq "\x{100}\x{101}Aa",  'quotemeta');
+ok(ucfirst($a)    eq "\x{100}\x{101}Aa",  'ucfirst');
+ok(lcfirst($a)    eq "\x{101}\x{101}Aa",  'lcfirst');
+ok(uc($a)         eq "\x{100}\x{100}AA",  'uc');
+ok(lc($a)         eq "\x{101}\x{101}aa",  'lc');
+
+ok("\Q$b\E."      eq "\x{101}\x{100}aA.", '\Q\E \x{101}\x{100}aA');
+ok("\u$b"         eq "\x{100}\x{100}aA",  '\u');
+ok("\l$b"         eq "\x{101}\x{100}aA",  '\l');
+ok("\U$b"         eq "\x{100}\x{100}AA",  '\U');
+ok("\L$b"         eq "\x{101}\x{101}aa",  '\L');
+
+ok(quotemeta($b)  eq "\x{101}\x{100}aA",  'quotemeta');
+ok(ucfirst($b)    eq "\x{100}\x{100}aA",  'ucfirst');
+ok(lcfirst($b)    eq "\x{101}\x{100}aA",  'lcfirst');
+ok(uc($b)         eq "\x{100}\x{100}AA",  'uc');
+ok(lc($b)         eq "\x{101}\x{101}aa",  'lc');
 
 # \x{DF} is LATIN SMALL LETTER SHARP S, its uppercase is SS or \x{53}\x{53};
 # \x{149} is LATIN SMALL LETTER N PRECEDED BY APOSTROPHE, its uppercase is
 # \x{2BC}\x{E4} or MODIFIER LETTER APOSTROPHE and N.
 
-is(latin1_to_native("\U\x{DF}aB\x{149}cD"), latin1_to_native("SSAB\x{2BC}NCD"),
+# In EBCDIC \x{DF} is LATIN SMALL LETTER Y WITH DIAERESIS,
+# and it's uppercase is \x{178}, LATIN CAPITAL LETTER Y WITH DIAERESIS.
+
+if (ord("A") == 193) { # EBCDIC
+    ok("\U\x{DF}aB\x{149}cD" eq "\x{178}AB\x{2BC}NCD",
        "multicharacter uppercase");
+} elsif (ord("A") == 65) {
+    ok("\U\x{DF}aB\x{149}cD" eq "SSAB\x{2BC}NCD",
+       "multicharacter uppercase");
+} else {
+    ok(0, "what is your encoding?");
+}
 
 # The \x{DF} is its own lowercase, ditto for \x{149}.
 # There are no single character -> multiple characters lowercase mappings.
 
-is(latin1_to_native("\L\x{DF}aB\x{149}cD"), latin1_to_native("\x{DF}ab\x{149}cd"),
+if (ord("A") == 193) { # EBCDIC
+    ok("\LaB\x{149}cD" eq "ab\x{149}cd",
        "multicharacter lowercase");
-
-# \x{DF} is LATIN SMALL LETTER SHARP S, its foldcase is ss or \x{73}\x{73};
-# \x{149} is LATIN SMALL LETTER N PRECEDED BY APOSTROPHE, its foldcase is
-# \x{2BC}\x{6E} or MODIFIER LETTER APOSTROPHE and n.
-# Note that is this further tested in t/uni/fold.t
-
-is(latin1_to_native("\F\x{DF}aB\x{149}cD"), latin1_to_native("ssab\x{2BC}ncd"),
-       "multicharacter foldcase");
-
+} elsif (ord("A") == 65) {
+    ok("\L\x{DF}aB\x{149}cD" eq "\x{DF}ab\x{149}cd",
+       "multicharacter lowercase");
+} else {
+    ok(0, "what is your encoding?");
+}
 
 # titlecase is used for \u / ucfirst.
 
@@ -132,221 +116,23 @@ is(latin1_to_native("\F\x{DF}aB\x{149}cD"), latin1_to_native("ssab\x{2BC}ncd"),
 # \x{587} itself
 # and its uppercase is
 # \x{535}\x{552} ARMENIAN CAPITAL LETTER ECH + ARMENIAN CAPITAL LETTER YIWN
-# The foldcase is \x{565}\x{582} ARMENIAN SMALL LETTER ECH + ARMENIAN SMALL LETTER YIWN
 
 $a = "\x{587}";
 
-is("\L\x{587}" , "\x{587}",        "ligature lowercase");
-is("\u\x{587}" , "\x{535}\x{582}", "ligature titlecase");
-is("\U\x{587}" , "\x{535}\x{552}", "ligature uppercase");
-is("\F\x{587}" , "\x{565}\x{582}", "ligature foldcase");
+ok("\L\x{587}" eq "\x{587}",        "ligature lowercase");
+ok("\u\x{587}" eq "\x{535}\x{582}", "ligature titlecase");
+ok("\U\x{587}" eq "\x{535}\x{552}", "ligature uppercase");
 
 # mktables had problems where many-to-one case mappings didn't work right.
-# The lib/uni/fold.t should give the fourth folding, "casefolding", a good
+# The lib/unifold.t should give the fourth folding, "casefolding", a good
 # workout.
-# \x{01C4} is LATIN CAPITAL LETTER DZ WITH CARON
-# \x{01C5} is LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON
-# \x{01C6} is LATIN SMALL LETTER DZ WITH CARON
-# \x{03A3} is GREEK CAPITAL LETTER SIGMA
-# \x{03C2} is GREEK SMALL LETTER FINAL SIGMA
-# \x{03C3} is GREEK SMALL LETTER SIGMA
-
-is(lc("\x{1C4}") , "\x{1C6}",      "U+01C4 lc is U+01C6");
-is(lc("\x{1C5}") , "\x{1C6}",      "U+01C5 lc is U+01C6, too");
-
-is(ucfirst("\x{3C2}") , "\x{3A3}", "U+03C2 ucfirst is U+03A3");
-is(ucfirst("\x{3C3}") , "\x{3A3}", "U+03C3 ucfirst is U+03A3, too");
-
-is(uc("\x{1C5}") , "\x{1C4}",      "U+01C5 uc is U+01C4");
-is(uc("\x{1C6}") , "\x{1C4}",      "U+01C6 uc is U+01C4, too");
-
-# #18107: A host of bugs involving [ul]c{,first}. AMS 20021106
-$a = "\x{3c3}foo.bar"; # \x{3c3} == GREEK SMALL LETTER SIGMA.
-$b = "\x{3a3}FOO.BAR"; # \x{3a3} == GREEK CAPITAL LETTER SIGMA.
-
-($c = $b) =~ s/(\w+)/lc($1)/ge;
-is($c , $a, "Using s///e to change case.");
-
-($c = $a) =~ s/(\p{IsWord}+)/uc($1)/ge;
-is($c , $b, "Using s///e to change case.");
-
-($c = $a) =~ s/(\p{IsWord}+)/fc($1)/ge;
-is($c , $a, "Using s///e to foldcase.");
-
-($c = $b) =~ s/(\p{IsWord}+)/lcfirst($1)/ge;
-is($c , "\x{3c3}FOO.bAR", "Using s///e to change case.");
-
-($c = $a) =~ s/(\p{IsWord}+)/ucfirst($1)/ge;
-is($c , "\x{3a3}foo.Bar", "Using s///e to change case.");
-
-# #18931: perl5.8.0 bug in \U..\E processing
-# Test case from Nicholas Clark.
-for my $a (0,1) {
-    $_ = 'abcdefgh';
-    $_ .= chr 256;
-    chop;
-    /(.*)/;
-    is(uc($1), "ABCDEFGH", "[perl #18931]");
-}
-
-{
-    foreach (0, 1) {
-	$a = v10.v257;
-	chop $a;
-	$a =~ s/^(\s*)(\w*)/$1\u$2/;
-	is($a, v10, "[perl #18857]");
-    } 
-}
-
-
-# [perl #38619] Bug in lc and uc (interaction between UTF-8, substr, and lc/uc)
 
-for ("a\x{100}", "xyz\x{100}") {
-    is(substr(uc($_), 0), uc($_), "[perl #38619] uc");
-}
-for ("A\x{100}", "XYZ\x{100}") {
-    is(substr(lc($_), 0), lc($_), "[perl #38619] lc");
-}
-for ("a\x{100}", "ßyz\x{100}") { # ß to Ss (different length)
-    is(substr(ucfirst($_), 0), ucfirst($_), "[perl #38619] ucfirst");
-}
-
-#fc() didn't exist back then, but coverage is coverage.
-for ("a\x{100}", "ßyz\x{100}", "xyz\x{100}", "XYZ\x{100}") { # ß to Ss (different length)
-    is(substr(fc($_), 0), fc($_), "[perl #38619] fc");
-}
+ok(lc("\x{1C4}") eq "\x{1C6}",      "U+01C4 lc is U+01C6");
+ok(lc("\x{1C5}") eq "\x{1C6}",      "U+01C5 lc is U+01C6, too");
 
-# Related to [perl #38619]
-# the original report concerns PERL_MAGIC_utf8.
-# these cases concern PERL_MAGIC_regex_global.
+ok(ucfirst("\x{3C2}") eq "\x{3A3}", "U+03C2 ucfirst is U+03A3");
+ok(ucfirst("\x{3C3}") eq "\x{3A3}", "U+03C3 ucfirst is U+03A3, too");
 
-for (map { $_ } "a\x{100}", "abc\x{100}", "\x{100}") {
-    chop; # get ("a", "abc", "") in utf8
-    my $return =  uc($_) =~ /\G(.?)/g;
-    my $result = $return ? $1 : "not";
-    my $expect = (uc($_) =~ /(.?)/g)[0];
-    is($return, 1,       "[perl #38619]");
-    is($result, $expect, "[perl #38619]");
-}
-
-for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
-    chop; # get ("A", "ABC", "") in utf8
-    my $return =  lc($_) =~ /\G(.?)/g;
-    my $result = $return ? $1 : "not";
-    my $expect = (lc($_) =~ /(.?)/g)[0];
-    is($return, 1,       "[perl #38619]");
-    is($result, $expect, "[perl #38619]");
-}
-
-for (map { $_ } "A\x{100}", "ABC\x{100}", "\x{100}") {
-    chop; # get ("A", "ABC", "") in utf8
-    my $return =  fc($_) =~ /\G(.?)/g;
-    my $result = $return ? $1 : "not";
-    my $expect = (fc($_) =~ /(.?)/g)[0];
-    is($return, 1,       "[perl #38619]");
-    is($result, $expect, "[perl #38619]");
-}
+ok(uc("\x{1C5}") eq "\x{1C4}",      "U+01C5 uc is U+01C4");
+ok(uc("\x{1C6}") eq "\x{1C4}",      "U+01C6 uc is U+01C4, too");
 
-for (1, 4, 9, 16, 25) {
-    is(uc "\x{03B0}" x $_, "\x{3a5}\x{308}\x{301}" x $_,
-       'uc U+03B0 grows threefold');
-
-    is(lc "\x{0130}" x $_, "i\x{307}" x $_, 'lc U+0130 grows');
-
-    is(fc "\x{03B0}" x $_, "\x{3C5}\x{308}\x{301}" x $_,
-       'fc U+03B0 grows threefold');
-}
-
-# bug #43207
-my $temp = "HellO";
-for ("$temp") {
-    lc $_;
-    is($_, "HellO", '[perl #43207] lc($_) modifying $_');
-}
-for ("$temp") {
-    fc $_;
-    is($_, "HellO", '[perl #43207] fc($_) modifying $_');
-}
-for ("$temp") {
-    uc $_;
-    is($_, "HellO", '[perl #43207] uc($_) modifying $_');
-}
-for ("$temp") {
-    ucfirst $_;
-    is($_, "HellO", '[perl #43207] ucfirst($_) modifying $_');
-}
-for ("$temp") {
-    lcfirst $_;
-    is($_, "HellO", '[perl #43207] lcfirst($_) modifying $_');
-}
-
-# new in Unicode 5.1.0
-is(lc("\x{1E9E}"), "\x{df}", "lc(LATIN CAPITAL LETTER SHARP S)");
-
-{
-    use feature 'unicode_strings';
-    use bytes;
-    is(lc("\xc0"), "\xc0", "lc of above-ASCII Latin1 is itself under use bytes");
-    is(lcfirst("\xc0"), "\xc0", "lcfirst of above-ASCII Latin1 is itself under use bytes");
-    is(uc("\xe0"), "\xe0", "uc of above-ASCII Latin1 is itself under use bytes");
-    is(ucfirst("\xe0"), "\xe0", "ucfirst of above-ASCII Latin1 is itself under use bytes");
-}
-
-# Brought up in ticket #117855: Constant folding applied to uc() should use
-# the right set of hints.
-fresh_perl_like(<<'constantfolding', qr/^(\d+),\1\z/, {},
-    my $function = "uc";
-    my $char = "\xff";
-    {
-        use feature 'unicode_strings';
-        print ord uc($char), ",",
-              ord eval "$function('$char')", "\n";
-    }
-constantfolding
-    'folded uc() in string eval uses the right hints');
-
-# In-place lc/uc should not corrupt string buffers when given a non-utf8-
-# flagged thingy that stringifies to utf8
-$h{k} = bless[], "\x{3b0}\x{3b0}\x{3b0}bcde"; # U+03B0 grows with uc()
-   # using delete marks it as TEMP, so uc-in-place is permitted
-like uc delete $h{k}, qr "^(?:\x{3a5}\x{308}\x{301}){3}BCDE=ARRAY\(.*\)",
-    'uc(TEMP ref) does not produce a corrupt string';
-$h{k} = bless[], "\x{130}bcde"; # U+0130 grows with lc()
-   # using delete marks it as TEMP, so uc-in-place is permitted
-like lc delete $h{k}, qr "^i\x{307}bcde=array\(.*\)",
-    'lc(TEMP ref) does not produce a corrupt string';
-
-
-my $utf8_locale = find_utf8_ctype_locale();
-
-SKIP: {
-    skip 'Can\'t find a UTF-8 locale', 4*256 unless defined $utf8_locale;
-
-    use feature qw( unicode_strings );
-
-    no locale;
-
-    my @unicode_lc;
-    my @unicode_uc;
-    my @unicode_lcfirst;
-    my @unicode_ucfirst;
-
-    # Get all the values outside of 'locale'
-    for my $i (0 .. 255) {
-        push @unicode_lc, lc(chr $i);
-        push @unicode_uc, uc(chr $i);
-        push @unicode_lcfirst, lcfirst(chr $i);
-        push @unicode_ucfirst, ucfirst(chr $i);
-    }
-
-    use if $Config{d_setlocale}, qw(POSIX locale_h);
-    use locale;
-    setlocale(LC_CTYPE, $utf8_locale);
-
-    for my $i (0 .. 255) {
-        is(lc(chr $i), $unicode_lc[$i], "In a UTF-8 locale, lc(chr $i) is the same as official Unicode");
-        is(uc(chr $i), $unicode_uc[$i], "In a UTF-8 locale, uc(chr $i) is the same as official Unicode");
-        is(lcfirst(chr $i), $unicode_lcfirst[$i], "In a UTF-8 locale, lcfirst(chr $i) is the same as official Unicode");
-        is(ucfirst(chr $i), $unicode_ucfirst[$i], "In a UTF-8 locale, ucfirst(chr $i) is the same as official Unicode");
-    }
-}
diff --git a/gnu/usr.bin/perl/t/op/loopctl.t b/gnu/usr.bin/perl/t/op/loopctl.t
index d520a7fa313..2ed9df1432b 100644
--- a/gnu/usr.bin/perl/t/op/loopctl.t
+++ b/gnu/usr.bin/perl/t/op/loopctl.t
@@ -30,17 +30,14 @@
 # Feel free to add more here.
 #
 #  -- .robin. <robin@kitsite.com>  2001-03-13
-BEGIN {
-    chdir 't' if -d 't';
-    @INC = qw(. ../lib);
-    require "test.pl";
-}
 
-plan( tests => 67 );
+print "1..41\n";
 
 my $ok;
 
-TEST1: {
+## while() loop without a label
+
+TEST1: { # redo
 
   $ok = 0;
 
@@ -62,9 +59,9 @@ TEST1: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on while()');
+print ($ok ? "ok 1\n" : "not ok 1\n");
 
-TEST2: {
+TEST2: { # next (succesful)
 
   $ok = 0;
 
@@ -86,9 +83,9 @@ TEST2: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on while() successful next');
+print ($ok ? "ok 2\n" : "not ok 2\n");
 
-TEST3: {
+TEST3: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -112,9 +109,9 @@ TEST3: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'no label on while() unsuccessful next');
+print ($ok ? "ok 3\n" : "not ok 3\n");
 
-TEST4: {
+TEST4: { # last
 
   $ok = 0;
 
@@ -136,9 +133,12 @@ TEST4: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'no label on while() last');
+print ($ok ? "ok 4\n" : "not ok 4\n");
+
 
-TEST5: {
+## until() loop without a label
+
+TEST5: { # redo
 
   $ok = 0;
 
@@ -160,9 +160,9 @@ TEST5: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on until()');
+print ($ok ? "ok 5\n" : "not ok 5\n");
 
-TEST6: {
+TEST6: { # next (succesful)
 
   $ok = 0;
 
@@ -184,9 +184,9 @@ TEST6: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on until() successful next');
+print ($ok ? "ok 6\n" : "not ok 6\n");
 
-TEST7: {
+TEST7: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -210,9 +210,9 @@ TEST7: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'no label on until() unsuccessful next');
+print ($ok ? "ok 7\n" : "not ok 7\n");
 
-TEST8: {
+TEST8: { # last
 
   $ok = 0;
 
@@ -234,9 +234,11 @@ TEST8: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'no label on until() last');
+print ($ok ? "ok 8\n" : "not ok 8\n");
+
+## for(@array) loop without a label
 
-TEST9: {
+TEST9: { # redo
 
   $ok = 0;
 
@@ -257,9 +259,9 @@ TEST9: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on for(@array)');
+print ($ok ? "ok 9\n" : "not ok 9\n");
 
-TEST10: {
+TEST10: { # next (succesful)
 
   $ok = 0;
 
@@ -280,9 +282,9 @@ TEST10: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on for(@array) successful next');
+print ($ok ? "ok 10\n" : "not ok 10\n");
 
-TEST11: {
+TEST11: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -305,9 +307,9 @@ TEST11: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'no label on for(@array) unsuccessful next');
+print ($ok ? "ok 11\n" : "not ok 11\n");
 
-TEST12: {
+TEST12: { # last
 
   $ok = 0;
 
@@ -328,9 +330,11 @@ TEST12: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'no label on for(@array) last');
+print ($ok ? "ok 12\n" : "not ok 12\n");
 
-TEST13: {
+## for(;;) loop without a label
+
+TEST13: { # redo
 
   $ok = 0;
 
@@ -347,9 +351,9 @@ TEST13: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on for(;;)');
+print ($ok ? "ok 13\n" : "not ok 13\n");
 
-TEST14: {
+TEST14: { # next (successful)
 
   $ok = 0;
 
@@ -364,9 +368,9 @@ TEST14: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on for(;;) successful next');
+print ($ok ? "ok 14\n" : "not ok 14\n");
 
-TEST15: {
+TEST15: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -385,9 +389,9 @@ TEST15: {
   }
   $ok = $been_in_loop;
 }
-cmp_ok($ok,'==',1,'no label on for(;;) unsuccessful next');
+print ($ok ? "ok 15\n" : "not ok 15\n");
 
-TEST16: {
+TEST16: { # last
 
   $ok = 0;
 
@@ -403,9 +407,11 @@ TEST16: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'no label on for(;;) last');
+print ($ok ? "ok 16\n" : "not ok 16\n");
+
+## bare block without a label
 
-TEST17: {
+TEST17: { # redo
 
   $ok = 0;
   my $first_time = 1;
@@ -427,9 +433,9 @@ TEST17: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on bare block');
+print ($ok ? "ok 17\n" : "not ok 17\n");
 
-TEST18: {
+TEST18: { # next
 
   $ok = 0;
   {
@@ -442,9 +448,9 @@ TEST18: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'no label on bare block next');
+print ($ok ? "ok 18\n" : "not ok 18\n");
 
-TEST19: {
+TEST19: { # last
 
   $ok = 0;
   {
@@ -457,11 +463,14 @@ TEST19: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'no label on bare block last');
+print ($ok ? "ok 19\n" : "not ok 19\n");
+
 
 ### Now do it all again with labels
 
-TEST20: {
+## while() loop with a label
+
+TEST20: { # redo
 
   $ok = 0;
 
@@ -483,9 +492,9 @@ TEST20: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on while()');
+print ($ok ? "ok 20\n" : "not ok 20\n");
 
-TEST21: {
+TEST21: { # next (succesful)
 
   $ok = 0;
 
@@ -507,9 +516,9 @@ TEST21: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on while() successful next');
+print ($ok ? "ok 21\n" : "not ok 21\n");
 
-TEST22: {
+TEST22: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -533,9 +542,9 @@ TEST22: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'label on while() unsuccessful next');
+print ($ok ? "ok 22\n" : "not ok 22\n");
 
-TEST23: {
+TEST23: { # last
 
   $ok = 0;
 
@@ -557,9 +566,12 @@ TEST23: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'label on while() last');
+print ($ok ? "ok 23\n" : "not ok 23\n");
 
-TEST24: {
+
+## until() loop with a label
+
+TEST24: { # redo
 
   $ok = 0;
 
@@ -581,9 +593,9 @@ TEST24: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on until()');
+print ($ok ? "ok 24\n" : "not ok 24\n");
 
-TEST25: {
+TEST25: { # next (succesful)
 
   $ok = 0;
 
@@ -605,9 +617,9 @@ TEST25: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on until() successful next');
+print ($ok ? "ok 25\n" : "not ok 25\n");
 
-TEST26: {
+TEST26: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -631,9 +643,9 @@ TEST26: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'label on until() unsuccessful next');
+print ($ok ? "ok 26\n" : "not ok 26\n");
 
-TEST27: {
+TEST27: { # last
 
   $ok = 0;
 
@@ -655,9 +667,11 @@ TEST27: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'label on until() last');
+print ($ok ? "ok 27\n" : "not ok 27\n");
 
-TEST28: {
+## for(@array) loop with a label
+
+TEST28: { # redo
 
   $ok = 0;
 
@@ -678,9 +692,9 @@ TEST28: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on for(@array)');
+print ($ok ? "ok 28\n" : "not ok 28\n");
 
-TEST29: {
+TEST29: { # next (succesful)
 
   $ok = 0;
 
@@ -701,9 +715,9 @@ TEST29: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on for(@array) successful next');
+print ($ok ? "ok 29\n" : "not ok 29\n");
 
-TEST30: {
+TEST30: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -726,9 +740,9 @@ TEST30: {
   }
   $ok = $been_in_loop && $been_in_continue;
 }
-cmp_ok($ok,'==',1,'label on for(@array) unsuccessful next');
+print ($ok ? "ok 30\n" : "not ok 30\n");
 
-TEST31: {
+TEST31: { # last
 
   $ok = 0;
 
@@ -749,9 +763,11 @@ TEST31: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'label on for(@array) last');
+print ($ok ? "ok 31\n" : "not ok 31\n");
+
+## for(;;) loop with a label
 
-TEST32: {
+TEST32: { # redo
 
   $ok = 0;
 
@@ -768,9 +784,9 @@ TEST32: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on for(;;)');
+print ($ok ? "ok 32\n" : "not ok 32\n");
 
-TEST33: {
+TEST33: { # next (successful)
 
   $ok = 0;
 
@@ -785,9 +801,9 @@ TEST33: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on for(;;) successful next');
+print ($ok ? "ok 33\n" : "not ok 33\n");
 
-TEST34: {
+TEST34: { # next (unsuccesful)
 
   $ok = 0;
 
@@ -806,9 +822,9 @@ TEST34: {
   }
   $ok = $been_in_loop;
 }
-cmp_ok($ok,'==',1,'label on for(;;) unsuccessful next');
+print ($ok ? "ok 34\n" : "not ok 34\n");
 
-TEST35: {
+TEST35: { # last
 
   $ok = 0;
 
@@ -824,9 +840,11 @@ TEST35: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'label on for(;;) last');
+print ($ok ? "ok 35\n" : "not ok 35\n");
 
-TEST36: {
+## bare block with a label
+
+TEST36: { # redo
 
   $ok = 0;
   my $first_time = 1;
@@ -848,9 +866,9 @@ TEST36: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on bare block');
+print ($ok ? "ok 36\n" : "not ok 36\n");
 
-TEST37: {
+TEST37: { # next
 
   $ok = 0;
   LABEL37: {
@@ -863,9 +881,9 @@ TEST37: {
   }
   $ok = 0;
 }
-cmp_ok($ok,'==',1,'label on bare block next');
+print ($ok ? "ok 37\n" : "not ok 37\n");
 
-TEST38: {
+TEST38: { # last
 
   $ok = 0;
   LABEL38: {
@@ -878,7 +896,9 @@ TEST38: {
   }
   $ok = 1;
 }
-cmp_ok($ok,'==',1,'label on bare block last');
+print ($ok ? "ok 38\n" : "not ok 38\n");
+
+### Now test nested constructs
 
 TEST39: {
     $ok = 0;
@@ -902,7 +922,10 @@ TEST39: {
       $ok = 0;
     }
 }
-cmp_ok($ok,'==',1,'nested constructs');
+print ($ok ? "ok 39\n" : "not ok 39\n");
+
+
+### Test that loop control is dynamicly scoped.
 
 sub test_last_label { last TEST40 }
 
@@ -911,7 +934,7 @@ TEST40: {
     test_last_label();
     $ok = 0;
 }
-cmp_ok($ok,'==',1,'dynamically scoped label');
+print ($ok ? "ok 40\n" : "not ok 40\n");
 
 sub test_last { last }
 
@@ -920,201 +943,4 @@ TEST41: {
     test_last();
     $ok = 0;
 }
-cmp_ok($ok,'==',1,'dynamically scoped');
-
-
-# [perl #27206] Memory leak in continue loop
-# Ensure that the temporary object is freed each time round the loop,
-# rather then all 10 of them all being freed right at the end
-
-{
-    my $n=10; my $late_free = 0;
-    sub X::DESTROY { $late_free++ if $n < 0 };
-    {
-	($n-- && bless {}, 'X') && redo;
-    }
-    cmp_ok($late_free,'==',0,"bug 27206: redo memory leak");
-
-    $n = 10; $late_free = 0;
-    {
-	($n-- && bless {}, 'X') && redo;
-    }
-    continue { }
-    cmp_ok($late_free,'==',0,"bug 27206: redo with continue memory leak");
-}
-
-# ensure that redo doesn't clear a lexical declared in the condition
-
-{
-    my $i = 1;
-    while (my $x = $i) {
-	$i++;
-	redo if $i == 2;
-	cmp_ok($x,'==',1,"while/redo lexical life");
-	last;
-    }
-    $i = 1;
-    until (! (my $x = $i)) {
-	$i++;
-	redo if $i == 2;
-	cmp_ok($x,'==',1,"until/redo lexical life");
-	last;
-    }
-    for ($i = 1; my $x = $i; ) {
-	$i++;
-	redo if $i == 2;
-	cmp_ok($x,'==',1,"for/redo lexical life");
-	last;
-    }
-
-}
-
-{
-    $a37725[3] = 1; # use package var
-    $i = 2;
-    for my $x (reverse @a37725) {
-	$x = $i++;
-    }
-    cmp_ok("@a37725",'eq',"5 4 3 2",'bug 27725: reverse with empty slots bug');
-}
-
-# [perl #21469] bad things happened with for $x (...) { *x = *y }
-
-{
-    my $i = 1;
-    $x_21469  = 'X';
-    $y1_21469 = 'Y1';
-    $y2_21469 = 'Y2';
-    $y3_21469 = 'Y3';
-    for $x_21469 (1,2,3) {
-	is($x_21469, $i, "bug 21469: correct at start of loop $i");
-	*x_21469 = (*y1_21469, *y2_21469, *y3_21469)[$i-1];
-	is($x_21469, "Y$i", "bug 21469: correct at tail of loop $i");
-	$i++;
-    }
-    is($x_21469, 'X', "bug 21469: X okay at end of loop");
-}
-
-# [perl #112316] Wrong behavior regarding labels with same prefix
-{
-    my $fail;
-    CATCH: {
-    CATCHLOOP: {
-            last CATCH;
-        }
-        $fail = 1;
-    }
-    ok(!$fail, "perl 112316: Labels with the same prefix don't get mixed up.");
-}
-
-# [perl #73618]
-{
-    sub foo_73618_0 {
-        while (0) { }
-    }
-    sub bar_73618_0 {
-        my $i = 0;
-        while ($i) { }
-    }
-    sub foo_73618_undef {
-        while (undef) { }
-    }
-    sub bar_73618_undef {
-        my $i = undef;
-        while ($i) { }
-    }
-    sub foo_73618_emptystring {
-        while ("") { }
-    }
-    sub bar_73618_emptystring {
-        my $i = "";
-        while ($i) { }
-    }
-    sub foo_73618_0float {
-        while (0.0) { }
-    }
-    sub bar_73618_0float {
-        my $i = 0.0;
-        while ($i) { }
-    }
-    sub foo_73618_0string {
-        while ("0") { }
-    }
-    sub bar_73618_0string {
-        my $i = "0";
-        while ($i) { }
-    }
-    sub foo_73618_until {
-        until (1) { }
-    }
-    sub bar_73618_until {
-        my $i = 1;
-        until ($i) { }
-    }
-
-    is(scalar(foo_73618_0()), scalar(bar_73618_0()),
-       "constant optimization doesn't change return value");
-    is(scalar(foo_73618_undef()), scalar(bar_73618_undef()),
-       "constant optimization doesn't change return value");
-    is(scalar(foo_73618_emptystring()), scalar(bar_73618_emptystring()),
-       "constant optimization doesn't change return value");
-    is(scalar(foo_73618_0float()), scalar(bar_73618_0float()),
-       "constant optimization doesn't change return value");
-    is(scalar(foo_73618_0string()), scalar(bar_73618_0string()),
-       "constant optimization doesn't change return value");
-    { local $TODO = "until is still wrongly optimized";
-    is(scalar(foo_73618_until()), scalar(bar_73618_until()),
-       "constant optimization doesn't change return value");
-    }
-}
-
-# [perl #113684]
-last_113684:
-{
-    label1:
-    {
-        my $label = "label1";
-        eval { last $label };
-        fail("last with non-constant label");
-        last last_113684;
-    }
-    pass("last with non-constant label");
-}
-next_113684:
-{
-    label2:
-    {
-        my $label = "label2";
-        eval { next $label };
-        fail("next with non-constant label");
-        next next_113684;
-    }
-    pass("next with non-constant label");
-}
-redo_113684:
-{
-    my $count;
-    label3:
-    {
-        if ($count++) {
-            pass("redo with non-constant label"); last redo_113684
-        }
-        my $label = "label3";
-        eval { redo $label };
-        fail("redo with non-constant label");
-    }
-}
-
-# [perl #3112]
-# The original report, which produced a Bizarre copy
-@a  = ();
-eval {
-    for (1) {
-        push @a, last;
-    }
-};
-is @a, 0, 'push @a, last;  does not push';
-is $@, "", 'no error, either';
-# And my japh, which relied on the misbehaviour
-is do{{&{sub{"Just another Perl hacker,\n"}},last}}, undef,
-  'last returns nothing';
+print ($ok ? "ok 41\n" : "not ok 41\n");
diff --git a/gnu/usr.bin/perl/t/op/override.t b/gnu/usr.bin/perl/t/op/override.t
index ce740eaf6cd..1a4e5e02f86 100644
--- a/gnu/usr.bin/perl/t/op/override.t
+++ b/gnu/usr.bin/perl/t/op/override.t
@@ -2,13 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
-    require Config; # load these before we mess with *CORE::GLOBAL::require
-    require 'Config_heavy.pl'; # since runperl will need them
+    @INC = '.';
+    push @INC, '../lib';
 }
 
-plan tests => 35;
+print "1..17\n";
 
 #
 # This file tries to test builtin override using CORE::GLOBAL
@@ -17,12 +15,14 @@ my $dirsep = "/";
 
 BEGIN { package Foo; *main::getlogin = sub { "kilroy"; } }
 
-is( getlogin, "kilroy" );
+print "not " unless getlogin eq "kilroy";
+print "ok 1\n";
 
 my $t = 42;
 BEGIN { *CORE::GLOBAL::time = sub () { $t; } }
 
-is( 45, time + 3 );
+print "not " unless 45 == time + 3;
+print "ok 2\n";
 
 #
 # require has special behaviour
@@ -31,56 +31,44 @@ my $r;
 BEGIN { *CORE::GLOBAL::require = sub { $r = shift; 1; } }
 
 require Foo;
-is( $r, "Foo.pm" );
+print "not " unless $r eq "Foo.pm";
+print "ok 3\n";
 
 require Foo::Bar;
-is( $r, join($dirsep, "Foo", "Bar.pm") );
+print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
+print "ok 4\n";
 
 require 'Foo';
-is( $r, "Foo" );
+print "not " unless $r eq "Foo";
+print "ok 5\n";
 
-require 5.006;
-is( $r, "5.006" );
+require 5.6;
+print "not " unless $r eq "5.6";
+print "ok 6\n";
 
 require v5.6;
-ok( abs($r - 5.006) < 0.001 && $r eq "\x05\x06" );
+print "not " unless abs($r - 5.006) < 0.001 && $r eq "\x05\x06";
+print "ok 7\n";
 
 eval "use Foo";
-is( $r, "Foo.pm" );
+print "not " unless $r eq "Foo.pm";
+print "ok 8\n";
 
 eval "use Foo::Bar";
-is( $r, join($dirsep, "Foo", "Bar.pm") );
+print "not " unless $r eq join($dirsep, "Foo", "Bar.pm");
+print "ok 9\n";
 
-{
-    my @r;
-    local *CORE::GLOBAL::require = sub { push @r, shift; 1; };
-    eval "use 5.006";
-    like( " @r ", qr " 5\.006 " );
-}
-
-{
-    local $_ = 'foo.pm';
-    require;
-    is( $r, 'foo.pm' );
-}
-
-{
-    BEGIN {
-        # Can’t do ‘no warnings’ with CORE::GLOBAL::require overridden. :-)
-        CORE::require warnings;
-        unimport warnings 'experimental::lexical_topic';
-    }
-    my $_ = 'bar.pm';
-    require;
-    is( $r, 'bar.pm' );
-}
+eval "use 5.6";
+print "not " unless $r eq "5.6";
+print "ok 10\n";
 
 # localizing *CORE::GLOBAL::foo should revert to finding CORE::foo
 {
     local(*CORE::GLOBAL::require);
     $r = '';
     eval "require NoNeXiSt;";
-    ok( ! ( $r or $@ !~ /^Can't locate NoNeXiSt/i ) );
+    print "not " if $r or $@ !~ /^Can't locate NoNeXiSt/i;
+    print "ok 11\n";
 }
 
 #
@@ -89,96 +77,14 @@ is( $r, join($dirsep, "Foo", "Bar.pm") );
 
 $r = 11;
 BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
-is( <FH>	, 12 );
-is( <$fh>	, 13 );
+print <FH>	== 12 ? "ok 12\n" : "not ok 12\n";
+print <$fh>	== 13 ? "ok 13\n" : "not ok 13\n";
 my $pad_fh;
-is( <$pad_fh>	, 14 );
+print <$pad_fh>	== 14 ? "ok 14\n" : "not ok 14\n";
 
 # Non-global readline() override
 BEGIN { *Rgs::readline = sub (;*) { --$r }; }
-{
-    package Rgs;
-    ::is( <FH>	, 13 );
-    ::is( <$fh>	, 12 );
-    ::is( <$pad_fh>	, 11 );
-}
-
-# Global readpipe() override
-BEGIN { *CORE::GLOBAL::readpipe = sub ($) { "$_[0] " . --$r }; }
-is( `rm`,	    "rm 10", '``' );
-is( qx/cp/,	    "cp 9", 'qx' );
-
-# Non-global readpipe() override
-BEGIN { *Rgs::readpipe = sub ($) { ++$r . " $_[0]" }; }
-{
-    package Rgs;
-    ::is( `rm`,		  "10 rm", '``' );
-    ::is( qx/cp/,	  "11 cp", 'qx' );
-}
-
-# Verify that the parsing of overridden keywords isn't messed up
-# by the indirect object notation
-{
-    local $SIG{__WARN__} = sub {
-	::like( $_[0], qr/^ok overriden at/ );
-    };
-    BEGIN { *OverridenWarn::warn = sub { CORE::warn "@_ overriden"; }; }
-    package OverridenWarn;
-    sub foo { "ok" }
-    warn( OverridenWarn->foo() );
-    warn OverridenWarn->foo();
-}
-BEGIN { *OverridenPop::pop = sub { ::is( $_[0][0], "ok" ) }; }
-{
-    package OverridenPop;
-    sub foo { [ "ok" ] }
-    pop( OverridenPop->foo() );
-    pop OverridenPop->foo();
-}
-
-{
-    eval {
-        local *CORE::GLOBAL::require = sub {
-            CORE::require($_[0]);
-        };
-        require 5;
-        require Text::ParseWords;
-    };
-    is $@, '';
-}
-
-# Constant inlining should not countermand "use subs" overrides
-BEGIN { package other; *::caller = \&::caller }
-sub caller() { 42 }
-caller; # inline the constant
-is caller, 42, 'constant inlining does not undo "use subs" on keywords';
-
-is runperl(prog => 'sub CORE::GLOBAL::do; do file; print qq-ok\n-'),
-  "ok\n",
-  'no crash with CORE::GLOBAL::do stub';
-is runperl(prog => 'sub CORE::GLOBAL::glob; glob; print qq-ok\n-'),
-  "ok\n",
-  'no crash with CORE::GLOBAL::glob stub';
-is runperl(prog => 'sub CORE::GLOBAL::require; require re; print qq-o\n-'),
-  "o\n",
-  'no crash with CORE::GLOBAL::require stub';
-
-like runperl(prog => 'use constant foo=>1; '
-                    .'BEGIN { *{q|CORE::GLOBAL::readpipe|} = \&{q|foo|};1}'
-                    .'warn ``',
-             stderr => 1),
-     qr/Too many arguments/,
-    '`` does not ignore &CORE::GLOBAL::readpipe aliased to a constant';
-like runperl(prog => 'use constant foo=>1; '
-                    .'BEGIN { *{q|CORE::GLOBAL::readline|} = \&{q|foo|};1}'
-                    .'warn <a>',
-             stderr => 1),
-     qr/Too many arguments/,
-    '<> does not ignore &CORE::GLOBAL::readline aliased to a constant';
-
-is runperl(prog => 'use constant t=>42; '
-                  .'BEGIN { *{q|CORE::GLOBAL::time|} = \&{q|t|};1}'
-                  .'print time, chr 10',
-          stderr => 1),
-   "42\n",
-   'keywords respect global constant overrides';
+package Rgs;
+print <FH>	== 13 ? "ok 15\n" : "not ok 15\n";
+print <$fh>	== 12 ? "ok 16\n" : "not ok 16\n";
+print <$pad_fh>	== 11 ? "ok 17\n" : "not ok 17\n";
diff --git a/gnu/usr.bin/perl/t/op/srand.t b/gnu/usr.bin/perl/t/op/srand.t
index 5321cde6568..5753a5d0eb8 100644
--- a/gnu/usr.bin/perl/t/op/srand.t
+++ b/gnu/usr.bin/perl/t/op/srand.t
@@ -10,7 +10,7 @@ BEGIN {
 use strict;
 
 require "test.pl";
-plan(tests => 10);
+plan(tests => 4);
 
 # Generate a load of random numbers.
 # int() avoids possible floating point error.
@@ -57,34 +57,3 @@ sleep(1); # in case our srand() is too time-dependent
 @second_run = `$^X -le "print int rand 100 for 1..100"`;
 
 ok( !eq_array(\@first_run, \@second_run), 'srand() called automatically');
-
-# check srand's return value
-my $seed = srand(1764);
-is( $seed, 1764, "return value" );
-
-$seed = srand(0);
-ok( $seed, "true return value for srand(0)");
-cmp_ok( $seed, '==', 0, "numeric 0 return value for srand(0)");
-
-{
-    my @warnings;
-    my $b;
-    {
-	local $SIG{__WARN__} = sub {
-	    push @warnings, "@_";
-	    warn @_;
-	};
-	$b = $seed + 0;
-    }
-    is( $b, 0, "Quacks like a zero");
-    is( "@warnings", "", "Does not warn");
-}
-
-# [perl #40605]
-{
-    use warnings;
-    my $w = '';
-    local $SIG{__WARN__} = sub { $w .= $_[0] };
-    srand(2**100);
-    like($w, qr/^Integer overflow in srand at /, "got a warning");
-}
diff --git a/gnu/usr.bin/perl/t/op/sub_lval.t b/gnu/usr.bin/perl/t/op/sub_lval.t
index 4bd96ee4778..308269eee93 100644
--- a/gnu/usr.bin/perl/t/op/sub_lval.t
+++ b/gnu/usr.bin/perl/t/op/sub_lval.t
@@ -1,18 +1,20 @@
+print "1..67\n";
+
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
 }
-plan tests=>205;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
 
 my $out = a(b());		# Check that temporaries are allowed.
-is(ref $out, 'main'); # Not reached if error.
+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.
-cmp_ok(scalar @out, '==', 1); # Not reached if error.
+print "# `@out'\nnot " unless @out==1; # Not reached if error.
+print "ok 2\n";
 
 my $in;
 
@@ -27,7 +29,8 @@ sub neg : lvalue {  #(num_str) return num_str
 in(neg("+2"));
 
 
-is($in, '-2');
+print "# `$in'\nnot " unless $in eq '-2';
+print "ok 3\n";
 
 sub get_lex : lvalue { $in }
 sub get_st : lvalue { $blah }
@@ -40,75 +43,93 @@ $blah = 3;
 
 get_st = 7;
 
-cmp_ok($blah, '==', 7);
+print "# `$blah' ne 7\nnot " unless $blah == 7;
+print "ok 4\n";
 
 get_lex = 7;
 
-cmp_ok($in, '==', 7);
+print "# `$in' ne 7\nnot " unless $in == 7;
+print "ok 5\n";
 
 ++get_st;
 
-cmp_ok($blah, '==', 8);
+print "# `$blah' ne 8\nnot " unless $blah == 8;
+print "ok 6\n";
 
 ++get_lex;
 
-cmp_ok($in, '==', 8);
+print "# `$in' ne 8\nnot " unless $in == 8;
+print "ok 7\n";
 
 id(get_st) = 10;
 
-cmp_ok($blah, '==', 10);
+print "# `$blah' ne 10\nnot " unless $blah == 10;
+print "ok 8\n";
 
 id(get_lex) = 10;
 
-cmp_ok($in, '==', 10);
+print "# `$in' ne 10\nnot " unless $in == 10;
+print "ok 9\n";
 
 ++id(get_st);
 
-cmp_ok($blah, '==', 11);
+print "# `$blah' ne 11\nnot " unless $blah == 11;
+print "ok 10\n";
 
 ++id(get_lex);
 
-cmp_ok($in, '==', 11);
+print "# `$in' ne 11\nnot " unless $in == 11;
+print "ok 11\n";
 
 id1(get_st) = 20;
 
-cmp_ok($blah, '==', 20);
+print "# `$blah' ne 20\nnot " unless $blah == 20;
+print "ok 12\n";
 
 id1(get_lex) = 20;
 
-cmp_ok($in, '==', 20);
+print "# `$in' ne 20\nnot " unless $in == 20;
+print "ok 13\n";
 
 ++id1(get_st);
 
-cmp_ok($blah, '==', 21);
+print "# `$blah' ne 21\nnot " unless $blah == 21;
+print "ok 14\n";
 
 ++id1(get_lex);
 
-cmp_ok($in, '==', 21);
+print "# `$in' ne 21\nnot " unless $in == 21;
+print "ok 15\n";
 
 inc(get_st);
 
-cmp_ok($blah, '==', 22);
+print "# `$blah' ne 22\nnot " unless $blah == 22;
+print "ok 16\n";
 
 inc(get_lex);
 
-cmp_ok($in, '==', 22);
+print "# `$in' ne 22\nnot " unless $in == 22;
+print "ok 17\n";
 
 inc(id(get_st));
 
-cmp_ok($blah, '==', 23);
+print "# `$blah' ne 23\nnot " unless $blah == 23;
+print "ok 18\n";
 
 inc(id(get_lex));
 
-cmp_ok($in, '==', 23);
+print "# `$in' ne 23\nnot " unless $in == 23;
+print "ok 19\n";
 
 ++inc(id1(id(get_st)));
 
-cmp_ok($blah, '==', 25);
+print "# `$blah' ne 25\nnot " unless $blah == 25;
+print "ok 20\n";
 
 ++inc(id1(id(get_lex)));
 
-cmp_ok($in, '==', 25);
+print "# `$in' ne 25\nnot " unless $in == 25;
+print "ok 21\n";
 
 @a = (1) x 3;
 @b = (undef) x 2;
@@ -131,13 +152,13 @@ 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";
-
-like($_, qr/Can\'t return an uninitialized value from lvalue subroutine/);
-print "ok 22\n";
+#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;
 
@@ -145,20 +166,23 @@ sub a::var : lvalue { $var }
 
 "a"->var = 45;
 
-cmp_ok($var, '==', 45);
+print "# `$var' ne 45\nnot " unless $var == 45;
+print "ok 23\n";
 
 my $oo;
 $o = bless \$oo, "a";
 
 $o->var = 47;
 
-cmp_ok($var, '==', 47);
+print "# `$var' ne 47\nnot " unless $var == 47;
+print "ok 24\n";
 
 sub o : lvalue { $o }
 
 o->var = 49;
 
-cmp_ok($var, '==', 49);
+print "# `$var' ne 49\nnot " unless $var == 49;
+print "ok 25\n";
 
 sub nolv () { $x0, $x1 } # Not lvalue
 
@@ -169,7 +193,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 26\n";
 
 $_ = '';
 
@@ -178,7 +204,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 27\n";
 
 $_ = '';
 
@@ -187,7 +215,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call in scalar assignment/);
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 28\n";
 
 $x0 = $x1 = $_ = undef;
 $nolv = \&nolv;
@@ -197,7 +227,8 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-ok(!defined $_) or diag "'$_', '$x0', '$x1'";
+print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
+print "ok 29\n";
 
 $x0 = $x1 = $_ = undef;
 $nolv = \&nolv;
@@ -207,11 +238,11 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call/)
-  or diag "'$_', '$x0', '$x1'";
+print "# '$_', '$x0', '$x1'.\nnot "
+  unless /Can\'t modify non-lvalue subroutine call/;
+print "ok 30\n";
 
-sub lv0 : lvalue { }
-sub rlv0 : lvalue { return }
+sub lv0 : lvalue { }		# Converted to lv10 in scalar context
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -219,16 +250,11 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can't return undef from lvalue subroutine/);
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  rlv0 = (2,3);
-  1;
-EOE
+print "# '$_'.\nnot "
+  unless /Empty array returned from lvalue subroutine in scalar context/;
+print "ok 31\n";
 
-like($_, qr/Can't return undef from lvalue subroutine/,
-    'explicit return of nothing in scalar context');
+sub lv10 : lvalue {}
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -236,24 +262,10 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-ok(!defined $_) or diag $_;
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (rlv0) = (2,3);
-  1;
-EOE
-
-ok(!defined $_, 'explicit return of nothing in list context') or diag $_;
-
-($a,$b)=();
-(lv0($a,$b)) = (3,4);
-is +($a//'undef') . ($b//'undef'), 'undefundef',
-   'list assignment to empty lvalue sub';
-
+print "# '$_'.\nnot " if defined $_;
+print "ok 32\n";
 
 sub lv1u :lvalue { undef }
-sub rlv1u :lvalue { undef }
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -261,16 +273,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can't return undef from lvalue subroutine/);
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  rlv1u = (2,3);
-  1;
-EOE
-
-like($_, qr/Can't return undef from lvalue subroutine/,
-     'explicitly returning undef in scalar context');
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 33\n";
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -278,15 +283,10 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-ok(!defined, 'implicitly returning undef in list context');
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (rlv1u) = (2,3);
-  1;
-EOE
-
-ok(!defined, 'explicitly returning undef in list context');
+# Fixed by change @10777
+#print "# '$_'.\nnot "
+#  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 34 # Skip: removed test\n";
 
 $x = '1234567';
 
@@ -297,56 +297,20 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t return a temporary from lvalue subroutine/);
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  sub rlv1t : lvalue { index $x, 2 }
-  rlv1t = (2,3);
-  1;
-EOE
-
-like($_, qr/Can\'t return a temporary from lvalue subroutine/,
-    'returning a PADTMP explicitly');
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  (rlv1t) = (2,3);
-  1;
-EOE
-
-like($_, qr/Can\'t return a temporary from lvalue subroutine/,
-    'returning a PADTMP explicitly (list context)');
-
-# These next two tests are not necessarily normative.  But this way we will
-# know if this discrepancy changes.
+print "# '$_'.\nnot "
+  unless /Can\'t modify index in lvalue subroutine return/;
+print "ok 35\n";
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
-  sub scalarray : lvalue { @a || $b }
-  @a = 1;
-  (scalarray) = (2,3);
+  sub lv2t : lvalue { shift }
+  (lv2t) = (2,3);
   1;
 EOE
 
-like($_, qr/Can\'t return a temporary from lvalue subroutine/,
-    'returning a scalar-context array via ||');
-
-$_ = undef;
-eval <<'EOE' or $_ = $@;
-  use warnings "FATAL" => "all";
-  sub myscalarray : lvalue { my @a = 1; @a || $b }
-  (myscalarray) = (2,3);
-  1;
-EOE
-
-like($_, qr/Useless assignment to a temporary/,
-    'returning a scalar-context lexical array via ||');
-
-$_ = undef;
-sub lv2t : lvalue { shift }
-(lv2t($_)) = (2,3);
-is($_, 2);
+print "# '$_'.\nnot "
+  unless /Can\'t modify shift in lvalue subroutine return/;
+print "ok 36\n";
 
 $xxx = 'xxx';
 sub xxx () { $xxx }  # Not lvalue
@@ -358,7 +322,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call at /);
+print "# '$_'.\nnot "
+  unless /Can\'t modify non-lvalue subroutine call in lvalue subroutine return/;
+print "ok 37\n";
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -366,7 +332,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t modify non-lvalue subroutine call at /);
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 38\n";
 
 sub yyy () { 'yyy' } # Const, not lvalue
 
@@ -377,7 +345,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t return a readonly value from lvalue subroutine at/);
+print "# '$_'.\nnot "
+  unless /Can\'t modify constant item in lvalue subroutine return/;
+print "ok 39\n";
 
 $_ = undef;
 eval <<'EOE' or $_ = $@;
@@ -385,7 +355,9 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-like($_, qr/Can\'t return a readonly value from lvalue subroutine/);
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 40\n";
 
 sub lva : lvalue {@a}
 
@@ -397,7 +369,8 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-is("'@a' $_", "'2 3' ");
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 41\n";
 
 $_ = undef;
 @a = ();
@@ -408,16 +381,20 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-is("'@a' $_", "'2 3' ");
-
-is lva->${\sub { return $_[0] }}, 2,
-  'lvalue->$thing when lvalue returns array';
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 42\n";
 
-my @my = qw/ a b c /;
-sub lvmya : lvalue { @my }
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
 
-is lvmya->${\sub { return $_[0] }}, 3,
-  'lvalue->$thing when lvalue returns lexical array';
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 43\n";
 
 sub lv1n : lvalue { $newvar }
 
@@ -427,7 +404,8 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-is("'$newvar' $_", "'4' ");
+print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
+print "ok 44\n";
 
 sub lv1nn : lvalue { $nnewvar }
 
@@ -437,22 +415,25 @@ eval <<'EOE' or $_ = $@;
   1;
 EOE
 
-is("'$nnewvar' $_", "'3' ");
+print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
+print "ok 45\n";
 
 $a = \&lv1nn;
 $a->() = 8;
-is($nnewvar, '8');
+print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
+print "ok 46\n";
 
-eval 'sub AUTOLOAD : lvalue { $newvar }';
+# This must happen at run time
+eval {
+    sub AUTOLOAD : lvalue { $newvar };
+};
 foobar() = 12;
-is($newvar, "12");
+print "# '$newvar'.\nnot " unless $newvar eq "12";
+print "ok 47\n";
 
-# But autoloading should only be triggered by a call to an undefined
-# subroutine.
-&{"lv1nn"} = 14;
-is $newvar, 12, 'AUTOLOAD does not take precedence over lvalue sub';
-eval { &{"xxx"} = 14 };
-is $newvar, 12, 'AUTOLOAD does not take precedence over non-lvalue sub';
+print "ok 48 # Skip: removed test\n";
+
+print "ok 49 # Skip: removed test\n";
 
 {
 my %hash; my @array;
@@ -462,18 +443,18 @@ sub hlv : lvalue { $hash{"foo"} }
 sub hlv2 : lvalue { $hash{$_[0]} }
 $array[1] = "not ok 51\n";
 alv() = "ok 50\n";
-is(alv(), "ok 50\n");
+print alv();
 
 alv2(20) = "ok 51\n";
-is($array[20], "ok 51\n");
+print $array[20];
 
 $hash{"foo"} = "not ok 52\n";
 hlv() = "ok 52\n";
-is($hash{foo}, "ok 52\n");
+print $hash{foo};
 
 $hash{bar} = "not ok 53\n";
 hlv("bar") = "ok 53\n";
-is(hlv("bar"), "ok 53\n");
+print hlv("bar");
 
 sub array : lvalue  { @array  }
 sub array2 : lvalue { @array2 } # This is a global.
@@ -483,37 +464,45 @@ sub hash2 : lvalue  { %hash2  } # So's this.
 %hash2 = qw(foo bar);
 
 (array()) = qw(ok 54);
-is("@array", "ok 54");
+print "not " unless "@array" eq "ok 54";
+print "ok 54\n";
 
 (array2()) = qw(ok 55);
-is("@array2", "ok 55");
+print "not " unless "@array2" eq "ok 55";
+print "ok 55\n";
 
 (hash()) = qw(ok 56);
-cmp_ok($hash{ok}, '==', 56);
+print "not " unless $hash{ok} == 56;
+print "ok 56\n";
 
 (hash2()) = qw(ok 57);
-cmp_ok($hash2{ok}, '==', 57);
+print "not " unless $hash2{ok} == 57;
+print "ok 57\n";
 
 @array = qw(a b c d);
 sub aslice1 : lvalue { @array[0,2] };
 (aslice1()) = ("ok", "already");
-is("@array", "ok b already d");
+print "# @array\nnot " unless "@array" eq "ok b already d";
+print "ok 58\n";
 
 @array2 = qw(a B c d);
 sub aslice2 : lvalue { @array2[0,2] };
 (aslice2()) = ("ok", "already");
-is("@array2", "ok B already d");
+print "not " unless "@array2" eq "ok B already d";
+print "ok 59\n";
 
 %hash = qw(a Alpha b Beta c Gamma);
 sub hslice : lvalue { @hash{"c", "b"} }
 (hslice()) = ("CISC", "BogoMIPS");
-is(join("/",@hash{"c","a","b"}), "CISC/Alpha/BogoMIPS");
+print "not " unless join("/",@hash{"c","a","b"}) eq "CISC/Alpha/BogoMIPS";
+print "ok 60\n";
 }
 
 $str = "Hello, world!";
 sub sstr : lvalue { substr($str, 1, 4) }
 sstr() = "i";
-is($str, "Hi, world!");
+print "not " unless $str eq "Hi, world!";
+print "ok 61\n";
 
 $str = "Made w/ JavaScript";
 sub veclv : lvalue { vec($str, 2, 32) }
@@ -523,7 +512,8 @@ if (ord('A') != 193) {
 else { # EBCDIC?
     veclv() = 0xD7859993;
 }
-is($str, "Made w/ PerlScript");
+print "# $str\nnot " unless $str eq "Made w/ PerlScript";
+print "ok 62\n";
 
 sub position : lvalue { pos }
 @p = ();
@@ -532,90 +522,24 @@ while (/f/g) {
     push @p, position;
     position() += 6;
 }
-is("@p", "1 8");
-
-sub keeze : lvalue { keys %__ }
-%__ = ("a","b");
-keeze = 64;
-is scalar %__, '1/64', 'keys assignment through lvalue sub';
+print "# @p\nnot " unless "@p" eq "1 8";
+print "ok 63\n";
 
 # Bug 20001223.002: split thought that the list had only one element
 @ary = qw(4 5 6);
 sub lval1 : lvalue { $ary[0]; }
 sub lval2 : lvalue { $ary[1]; }
 (lval1(), lval2()) = split ' ', "1 2 3 4";
+print "not " unless join(':', @ary) eq "1:2:6";
+print "ok 64\n";
 
-is(join(':', @ary), "1:2:6");
-
-# check that an element of a tied hash/array can be assigned to via lvalueness
-
-package Tie_Hash;
-
-our ($key, $val);
-sub TIEHASH { bless \my $v => __PACKAGE__ }
-sub STORE   { ($key, $val) = @_[1,2] }
-
-package main;
-sub lval_tie_hash : lvalue {
-    tie my %t => 'Tie_Hash';
-    $t{key};
-}
-
-eval { lval_tie_hash() = "value"; };
-
-is($@, "", "element of tied hash");
-
-is("$Tie_Hash::key-$Tie_Hash::val", "key-value");
+require './test.pl';
+curr_test(65);
 
+TODO: {
+    local $TODO = 'test explicit return of lval expr';
 
-package Tie_Array;
-
-our @val;
-sub TIEARRAY { bless \my $v => __PACKAGE__ }
-sub STORE   { $val[ $_[1] ] = $_[2] }
-
-package main;
-sub lval_tie_array : lvalue {
-    tie my @t => 'Tie_Array';
-    $t[0];
-}
-
-eval { lval_tie_array() = "value"; };
-
-
-is($@, "", "element of tied array");
-
-is ($Tie_Array::val[0], "value");
-
-
-# Check that tied pad vars that are returned can be assigned to
-sub TIESCALAR { bless [] }
-sub STORE {$wheel = $_[1]}
-sub FETCH {$wheel}
-sub tied_pad_var  :lvalue { tie my $tyre, ''; $tyre }
-sub tied_pad_varr :lvalue { tie my $tyre, ''; return $tyre }
-tied_pad_var = 1;
-is $wheel, 1, 'tied pad var returned in scalar lvalue context';
-tied_pad_var->${\sub{ $_[0] = 2 }};
-is $wheel, 2, 'tied pad var returned in scalar ref context';
-(tied_pad_var) = 3;
-is $wheel, 3, 'tied pad var returned in list lvalue context';
-$_ = 4 for tied_pad_var;
-is $wheel, 4, 'tied pad var returned in list ref context';
-tied_pad_varr = 5;
-is $wheel, 5, 'tied pad var explicitly returned in scalar lvalue context';
-tied_pad_varr->${\sub{ $_[0] = 6 }};
-is $wheel, 6, 'tied pad var explicitly returned in scalar ref context';
-(tied_pad_varr) = 7;
-is $wheel, 7, 'tied pad var explicitly returned in list lvalue context';
-$_ = 8 for tied_pad_varr;
-is $wheel, 8, 'tied pad var explicitly returned in list ref context';
-
-
-# Test explicit return of lvalue expression
-{
-    # subs are copies from tests 1-~18 with an explicit return added.
-    # They used not to work, which is why they are ‘badly’ named.
+    # subs are corrupted copies from tests 1-~4
     sub bad_get_lex : lvalue { return $in };
     sub bad_get_st  : lvalue { return $blah }
 
@@ -637,408 +561,5 @@ is $wheel, 8, 'tied pad var explicitly returned in list ref context';
     ++bad_get_st;
 
     is($blah, 8, "yada");
-
-    ++bad_get_lex;
-    cmp_ok($in, '==', 8);
-
-    bad_id(bad_get_st) = 10;
-    cmp_ok($blah, '==', 10);
-
-    bad_id(bad_get_lex) = 10;
-    cmp_ok($in, '==', 10);
-
-    ++bad_id(bad_get_st);
-    cmp_ok($blah, '==', 11);
-
-    ++bad_id(bad_get_lex);
-    cmp_ok($in, '==', 11);
-
-    bad_id1(bad_get_st) = 20;
-    cmp_ok($blah, '==', 20);
-
-    bad_id1(bad_get_lex) = 20;
-    cmp_ok($in, '==', 20);
-
-    ++bad_id1(bad_get_st);
-    cmp_ok($blah, '==', 21);
-
-    ++bad_id1(bad_get_lex);
-    cmp_ok($in, '==', 21);
-
-    bad_inc(bad_get_st);
-    cmp_ok($blah, '==', 22);
-
-    bad_inc(bad_get_lex);
-    cmp_ok($in, '==', 22);
-
-    bad_inc(bad_id(bad_get_st));
-    cmp_ok($blah, '==', 23);
-
-    bad_inc(bad_id(bad_get_lex));
-    cmp_ok($in, '==', 23);
-
-    ++bad_inc(bad_id1(bad_id(bad_get_st)));
-    cmp_ok($blah, '==', 25);
-
-    ++bad_inc(bad_id1(bad_id(bad_get_lex)));
-    cmp_ok($in, '==', 25);
-
-    # Recursive
-    my $r;
-    my $to_modify;
-    $r = sub :lvalue {
-      my $depth = shift//0;
-      if ($depth == 2) { return $to_modify }
-      return &$r($depth+1);
-    };
-    &$r(0) = 7;
-    is $to_modify, 7, 'recursive lvalue sub';
-
-    # Recursive with substr [perl #72706]
-    my $val = '';
-    my $pie;
-    $pie = sub :lvalue {
-	my $depth = shift;
-	return &$pie($depth) if $depth--;
-	substr $val, 0;
-    };
-    for my $depth (0, 1, 2) {
-	my $value = "Good $depth";
-	eval {
-	    &$pie($depth) = $value;
-	};
-	is($@, '', "recursive lvalue substr return depth $depth");
-	is($val, $value,
-	   "value assigned to recursive lvalue substr (depth $depth)");
-    }
 }
 
-{ # bug #23790
-    my @arr  = qw /one two three/;
-    my $line = "zero";
-    sub lval_array () : lvalue {@arr}
-
-    for (lval_array) {
-        $line .= $_;
-    }
-
-    is($line, "zeroonetwothree");
-
-    sub trythislval { scalar(@_)."x".join "", @_ }
-    is(trythislval(lval_array()), "3xonetwothree");
-
-    sub changeme { $_[2] = "free" }
-    changeme(lval_array);
-    is("@arr", "one two free");
-
-    # test again, with explicit return
-    sub rlval_array() : lvalue {return @arr}
-    @arr  = qw /one two three/;
-    $line = "zero";
-    for (rlval_array) {
-        $line .= $_;
-    }
-    is($line, "zeroonetwothree");
-    is(trythislval(rlval_array()), "3xonetwothree");
-    changeme(rlval_array);
-    is("@arr", "one two free");
-
-    # Variations on the same theme, with multiple vars returned
-    my $scalar = 'half';
-    sub lval_scalar_array () : lvalue { $scalar, @arr }
-    @arr  = qw /one two three/;
-    $line = "zero";
-    for (lval_scalar_array) {
-        $line .= $_;
-    }
-    is($line, "zerohalfonetwothree");
-    is(trythislval(lval_scalar_array()), "4xhalfonetwothree");
-    changeme(lval_scalar_array);
-    is("@arr", "one free three");
-
-    sub lval_array_scalar () : lvalue { @arr, $scalar }
-    @arr  = qw /one two three/;
-    $line = "zero";
-    $scalar = 'four';
-    for (lval_array_scalar) {
-        $line .= $_;
-    }
-    is($line, "zeroonetwothreefour");
-    is(trythislval(lval_array_scalar()), "4xonetwothreefour");
-    changeme(lval_array_scalar);
-    is("@arr", "one two free");
-
-    # Tests for specific ops not tested above
-    # rv2av
-    @array2 = qw 'one two free';
-    is join(',', map $_, sub:lvalue{@array2}->()), 'one,two,free',
-      'rv2av in reference context';
-    is join(',', map $_, sub:lvalue{@{\@array2}}->()), 'one,two,free',
-      'rv2av-with-ref in reference context';
-    # padhv
-    my %hash = qw[a b c d];
-    like join(',', map $_, sub:lvalue{%hash}->()),
-         qr/^(?:a,b,c,d|c,d,a,b)\z/, 'padhv in reference context';
-    # rv2hv
-    %hash2 = qw[a b c d];
-    like join(',', map $_, sub:lvalue{%hash2}->()),
-         qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv in reference context';
-    like join(',', map $_, sub:lvalue{%{\%hash2}}->()),
-         qr/^(?:a,b,c,d|c,d,a,b)\z/, 'rv2hv-with-ref in reference context';
-}
-
-{
-    package Foo;
-    sub AUTOLOAD :lvalue { *{$AUTOLOAD} };
-    package main;
-    my $foo = bless {},"Foo";
-    my $result;
-    $foo->bar = sub { $result = "bar" };
-    $foo->bar;
-    is ($result, 'bar', "RT #41550");
-}
-
-SKIP: { skip 'no attributes.pm', 1 unless eval 'require attributes';
-fresh_perl_is(<<'----', <<'====', {}, "lvalue can not be set after definition. [perl #68758]");
-use warnings;
-our $x;
-sub foo { $x }
-sub foo : lvalue;
-sub MODIFY_CODE_ATTRIBUTES {}
-sub foo : lvalue : fr0g;
-foo = 3;
-----
-lvalue attribute ignored after the subroutine has been defined at - line 4.
-lvalue attribute ignored after the subroutine has been defined at - line 6.
-Can't modify non-lvalue subroutine call in scalar assignment at - line 7, near "3;"
-Execution of - aborted due to compilation errors.
-====
-}
-
-{
-    my $x;
-    sub lval_decl : lvalue;
-    sub lval_decl { $x }
-    lval_decl = 5;
-    is($x, 5, "subroutine declared with lvalue before definition retains lvalue. [perl #68758]");
-}
-
-SKIP: { skip "no attributes.pm", 2 unless eval { require attributes };
-  sub utf8::valid :lvalue;
-  require attributes;
-  is "@{[ &attributes::get(\&utf8::valid) ]}", 'lvalue',
-   'sub declaration with :lvalue applies it to XSUBs';
-
-  BEGIN { *wonky = \&marjibberous }
-  sub wonky :lvalue;
-  is "@{[ &attributes::get(\&wonky) ]}", 'lvalue',
-   'sub declaration with :lvalue applies it to assigned stub';
-}
-
-sub fleen : lvalue { $pnare }
-$pnare = __PACKAGE__;
-ok eval { fleen = 1 }, "lvalues can return COWs (CATTLE?) [perl #75656]";\
-is $pnare, 1, 'and returning CATTLE actually works';
-$pnare = __PACKAGE__;
-ok eval { (fleen) = 1 }, "lvalues can return COWs in list context";
-is $pnare, 1, 'and returning COWs in list context actually works';
-$pnare = __PACKAGE__;
-ok eval { $_ = 1 for(fleen); 1 }, "lvalues can return COWs in ref cx";
-is $pnare, 1, 'and returning COWs in reference context actually works';
-
-
-# Returning an arbitrary expression, not necessarily lvalue
-+sub :lvalue { return $ambaga || $ambaga }->() = 73;
-is $ambaga, 73, 'explicit return of arbitrary expression (scalar context)';
-(sub :lvalue { return $ambaga || $ambaga }->()) = 74;
-is $ambaga, 74, 'explicit return of arbitrary expression (list context)';
-+sub :lvalue { $ambaga || $ambaga }->() = 73;
-is $ambaga, 73, 'implicit return of arbitrary expression (scalar context)';
-(sub :lvalue { $ambaga || $ambaga }->()) = 74;
-is $ambaga, 74, 'implicit return of arbitrary expression (list context)';
-eval { +sub :lvalue { return 3 }->() = 4 };
-like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
-      'assignment to numeric constant explicitly returned from lv sub';
-eval { (sub :lvalue { return 3 }->()) = 4 };
-like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
-      'assignment to num constant explicitly returned (list cx)';
-eval { +sub :lvalue { 3 }->() = 4 };
-like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
-      'assignment to numeric constant implicitly returned from lv sub';
-eval { (sub :lvalue { 3 }->()) = 4 };
-like $@, qr/Can\'t return a readonly value from lvalue subroutine at/,
-      'assignment to num constant implicitly returned (list cx)';
-
-# reference (potential lvalue) context
-$suffix = '';
-for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
-    &$sub()->${\sub { $_[0] = 37 }};
-    is $_, '37', 'lvalue->method'.$suffix;
-    ${\scalar &$sub()} = 38;
-    is $_, '38', 'scalar(lvalue)'.$suffix;
-    sub assign39_with_proto ($) { $_[0] = 39 }
-    assign39_with_proto(&$sub());
-    is $_, '39', 'func(lvalue) when func has $ proto'.$suffix;
-    $_ = 1;
-    ${\(&$sub()||undef)} = 40;
-    is $_, '40', 'lvalue||...'.$suffix;
-    ${\(${\undef}||&$sub())} = 41; # extra ${\...} to bypass const folding
-    is $_, '41', '...||lvalue'.$suffix;
-    $_ = 0;
-    ${\(&$sub()&&undef)} = 42;
-    is $_, '42', 'lvalue&&...'.$suffix;
-    ${\(${\1}&&&$sub())} = 43;
-    is $_, '43', '...&&lvalue'.$suffix;
-    ${\(&$sub())[0]} = 44;
-    is $_, '44', '(lvalue)[0]'.$suffix;
-}
-continue { $suffix = ' (explicit return)' }
-
-# autovivification
-$suffix = '';
-for my $sub (sub :lvalue {$_}, sub :lvalue {return $_}) {
-    undef $_;
-    &$sub()->[3] = 4;
-    is $_->[3], 4, 'func->[...] autovivification'.$suffix;
-    undef $_;
-    &$sub()->{3} = 4;
-    is $_->{3}, 4, 'func->{...} autovivification'.$suffix;
-    undef $_;
-    ${&$sub()} = 4;
-    is $$_, 4, '${func()} autovivification'      .$suffix;
-    undef $_;
-    @{&$sub()} = 4;
-    is "@$_", 4, '@{func()} autovivification'    .$suffix;
-    undef $_;
-    %{&$sub()} = (4,5);
-    is join('-',%$_), '4-5', '%{func()} autovivification'.$suffix;
-    undef $_;
-    ${ (), &$sub()} = 4;
-    is $$_, 4, '${ (), func()} autovivification'      .$suffix;
-}
-continue { $suffix = ' (explicit return)' }
-
-# [perl #92406] [perl #92290] Returning a pad var in rvalue context
-$suffix = '';
-for my $sub (
-         sub :lvalue { my $x = 72; $x },
-         sub :lvalue { my $x = 72; return $x }
-) {
-    is scalar(&$sub), 72, "sub returning pad var in scalar context$suffix";
-    is +(&$sub)[0], 72, "sub returning pad var in list context$suffix";
-}
-continue { $suffix = ' (explicit return)' }
-
-# Returning read-only values in reference context
-$suffix = '';
-for (
-         sub :lvalue { $] }->(),
-         sub :lvalue { return $] }->()
-) {
-    is \$_, \$], 'read-only values are returned in reference context'
-	         .$suffix             # (they used to be copied)
-}
-continue { $suffix = ' (explicit return)' }
-
-# Returning unwritables from nested lvalue sub call in in rvalue context
-# First, ensure we are testing what we think we are:
-if (!Internals::SvREADONLY($])) { Internals::SvREADONLY($],1); }
-sub squibble : lvalue { return $] }
-sub squebble : lvalue {        squibble }
-sub squabble : lvalue { return squibble }
-is $x = squebble, $], 'returning ro from nested lv sub call in rv cx';
-is $x = squabble, $], 'explct. returning ro from nested lv sub in rv cx';
-is \squebble, \$], 'returning ro from nested lv sub call in ref cx';
-is \squabble, \$], 'explct. returning ro from nested lv sub in ref cx';
-
-# [perl #102486] Sub calls as the last statement of an lvalue sub
-package _102486 {
-  my $called;
-  my $x = 'nonlv';
-  sub strictlv :lvalue { use strict 'refs'; &$x }
-  sub lv :lvalue { &$x }
-  sub nonlv { ++$called }
-  eval { strictlv };
-  ::like $@, qr/^Can't use string \("nonlv"\) as a subroutine ref while/,
-        'strict mode applies to sub:lvalue{ &$string }';
-  $called = 0;
-  ::ok eval { lv },
-      'sub:lvalue{&$x}->() does not die for non-lvalue inner sub call';
-  ::is $called, 1, 'The &$x actually called the sub';
-  eval { +sub :lvalue { &$x }->() = 3 };
-  ::like $@, qr/^Can't modify non-lvalue subroutine call at /,
-        'sub:lvalue{&$x}->() dies in true lvalue context';
-}
-
-# TARG should be copied in rvalue context
-sub ucf :lvalue { ucfirst $_[0] }
-is ucf("just another ") . ucf("perl hacker,\n"),
-   "Just another Perl hacker,\n", 'TARG is copied in rvalue scalar cx';
-is join('',ucf("just another "), ucf "perl hacker,\n"),
-   "Just another Perl hacker,\n", 'TARG is copied in rvalue list cx';
-sub ucfr : lvalue {
-    @_ ? ucfirst $_[0] : do {
-	is ucfr("just another ") . ucfr("perl hacker,\n"),
-	   "Just another Perl hacker,\n",
-	   'TARG is copied in recursive rvalue scalar cx';
-	is join('',ucfr("just another "), ucfr("perl hacker,\n")),
-	   "Just another Perl hacker,\n",
-	   'TARG is copied in recursive rvalue list cx';
-    }
-}
-ucfr();
-
-# Test TARG with potential lvalue context, too
-for (sub : lvalue { "$x" }->()) {
-    is \$_, \$_, '\$_ == \$_ in for(sub :lvalue{"$x"}->()){...}'
-}
-
-# [perl #117947] XSUBs should not be treated as lvalues at run time
-eval { &{\&utf8::is_utf8}("") = 3 };
-like $@, qr/^Can't modify non-lvalue subroutine call at /,
-        'XSUB not seen at compile time dies in lvalue context';
-
-# [perl #119797] else implicitly returning value
-# This used to cause Bizarre copy of ARRAY in pp_leave
-sub else119797 : lvalue {
-    if ($_[0]) {
-	1; # two statements force a leave op
-	@119797
-    }
-    else {
-	@119797
-    }
-}
-eval { (else119797(0)) = 1..3 };
-is $@, "", '$@ after writing to array returned by else';
-is "@119797", "1 2 3", 'writing to array returned by else';
-eval { (else119797(1)) = 4..6 };
-is $@, "", '$@ after writing to array returned by if (with else)';
-is "@119797", "4 5 6", 'writing to array returned by if (with else)';
-sub if119797 : lvalue {
-    if ($_[0]) {
-	@119797
-    }
-}
-@119797 = ();
-eval { (if119797(1)) = 4..6 };
-is $@, "", '$@ after writing to array returned by if';
-is "@119797", "4 5 6", 'writing to array returned by if';
-sub unless119797 : lvalue {
-    unless ($_[0]) {
-	@119797
-    }
-}
-@119797 = ();
-eval { (unless119797(0)) = 4..6 };
-is $@, "", '$@ after writing to array returned by unless';
-is "@119797", "4 5 6", 'writing to array returned by unless';
-sub bare119797 : lvalue {
-    {;
-	@119797
-    }
-}
-@119797 = ();
-eval { (bare119797(0)) = 4..6 };
-is $@, "", '$@ after writing to array returned by bare block';
-is "@119797", "4 5 6", 'writing to array returned by bare block';
diff --git a/gnu/usr.bin/perl/t/op/utfhash.t b/gnu/usr.bin/perl/t/op/utfhash.t
index ebb2934459b..af7e6c12960 100644
--- a/gnu/usr.bin/perl/t/op/utfhash.t
+++ b/gnu/usr.bin/perl/t/op/utfhash.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 
-    plan(tests => 99);
+    plan(tests => 91);
 }
 
 use strict;
@@ -21,7 +21,7 @@ my %hashu = ( "\xff" => 0xff,
               "\x{1ff}" => 0x1ff,
             );
 
-# Check that we can find the 8-bit things by various literals
+# Check that we can find the 8-bit things by various litterals
 is($hash8{"\x{00ff}"},0xFF);
 is($hash8{"\x{007f}"},0x7F);
 is($hash8{"\xff"},0xFF);
@@ -32,9 +32,8 @@ is($hashu{"\xff"},0xFF);
 is($hashu{"\x7f"},0x7F);
 
 # Now try same thing with variables forced into various forms.
-foreach ("\x7f","\xff")
+foreach my $a ("\x7f","\xff")
  {
-  my $a = $_; # Force a copy
   utf8::upgrade($a);
   is($hash8{$a},ord($a));
   is($hashu{$a},ord($a));
@@ -57,9 +56,8 @@ $hash8{chr(0x1ff)} = 0x1ff;
 # Check we have not got an spurious extra keys
 is(join('',sort { ord $a <=> ord $b } keys %hash8),"\x7f\xff\x{1ff}");
 
-foreach ("\x7f","\xff","\x{1ff}")
+foreach my $a ("\x7f","\xff","\x{1ff}")
  {
-  my $a = $_;
   utf8::upgrade($a);
   is($hash8{$a},ord($a));
   my $b = $a.chr(100);
@@ -71,9 +69,8 @@ foreach ("\x7f","\xff","\x{1ff}")
 is(delete $hashu{chr(0x1ff)},0x1ff);
 is(join('',sort keys %hashu),"\x7f\xff");
 
-foreach ("\x7f","\xff")
+foreach my $a ("\x7f","\xff")
  {
-  my $a = $_;
   utf8::upgrade($a);
   is($hashu{$a},ord($a));
   utf8::downgrade($a);
@@ -173,52 +170,3 @@ foreach ("\x7f","\xff")
   }
 
 }
-
-{
-    local $/; # Slurp.
-    my $utf8      = <DATA>;
-    my $utfebcdic = <DATA>;
-    if (ord('A') == 65) {
-	eval $utf8;
-    } elsif (ord('A') == 193) {
-	eval $utfebcdic;
-    }
-}
-__END__
-{
-  # See if utf8 barewords work [perl #22969]
-  use utf8;
-  my %hash = (те�т => 123);
-  is($hash{те�т}, $hash{'те�т'});
-  is($hash{те�т}, 123);
-  is($hash{'те�т'}, 123);
-  %hash = (те�т => 123);
-  is($hash{те�т}, $hash{'те�т'});
-  is($hash{те�т}, 123);
-  is($hash{'те�т'}, 123);
-
-  # See if plain ASCII strings quoted with '=>' erroneously get utf8 flag [perl #68812]
-  my %foo = (a => 'b', 'c' => 'd');
-  for my $key (keys %foo) {
-    ok !utf8::is_utf8($key), "'$key' shouldn't have utf8 flag";
-  }
-}
-__END__
-{
-  # See if utf8 barewords work [perl #22969]
-  use utf8; # UTF-EBCDIC, really.
-  my %hash = (½ää½âÀ½äâ½ää => 123);
-  is($hash{½ää½âÀ½äâ½ää}, $hash{'½ää½âÀ½äâ½ää'});
-  is($hash{½ää½âÀ½äâ½ää}, 123);
-  is($hash{'½ää½âÀ½äâ½ää'}, 123);
-  %hash = (½ää½âÀ½äâ½ää => 123);
-  is($hash{½ää½âÀ½äâ½ää}, $hash{'½ää½âÀ½äâ½ää'});
-  is($hash{½ää½âÀ½äâ½ää}, 123);
-  is($hash{'½ää½âÀ½äâ½ää'}, 123);
-
-  # See if plain ASCII strings quoted with '=>' erroneously get utf8 flag [perl #68812]
-  my %foo = (a => 'b', 'c' => 'd');
-  for my $key (keys %foo) {
-    ok !utf8::is_utf8($key), "'$key' shouldn't have utf8 flag";
-  }
-}
diff --git a/gnu/usr.bin/perl/t/run/exit.t b/gnu/usr.bin/perl/t/run/exit.t
index 02e57c65f8a..53ba4ea76bf 100644
--- a/gnu/usr.bin/perl/t/run/exit.t
+++ b/gnu/usr.bin/perl/t/run/exit.t
@@ -8,161 +8,64 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
+# VMS and Windows need -e "...", most everything else works better with '
+my $quote = $^O =~ /^(VMS|MSWin\d+)$/ ? q{"} : q{'};
+
 # Run some code, return its wait status.
 sub run {
     my($code) = shift;
-    $code = "\"" . $code . "\"" if $^O eq 'VMS'; #VMS needs quotes for this.
-    return system($^X, "-e", $code);
+    my $cmd = "$^X -e ";
+    return system($cmd.$quote.$code.$quote);
 }
 
 BEGIN {
-    $numtests = ($^O eq 'VMS') ? 16 : 17;
-}
-
-
-my $vms_exit_mode = 0;
-
-if ($^O eq 'VMS') {
-    if (eval 'require VMS::Feature') {
-        $vms_exit_mode = !(VMS::Feature::current("posix_exit"));
-    } else {
-        my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
-        my $env_posix_ex = $ENV{'PERL_VMS_POSIX_EXIT'} || '';
-        my $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; 
-        my $posix_ex = $env_posix_ex =~ /^[ET1]/i;
-        if (($unix_rpt || $posix_ex) ) {
-            $vms_exit_mode = 0;
-        } else {
-            $vms_exit_mode = 1;
-        }
-    }
-    $numtests = 29 unless $vms_exit_mode;
+    # MacOS system() doesn't have good return value
+    $numtests = ($^O eq 'VMS') ? 7 : ($^O eq 'MacOS') ? 0 : 3; 
 }
 
 require "test.pl";
 plan(tests => $numtests);
 
-my $native_success = 0;
-   $native_success = 1 if $^O eq 'VMS';
-
+if ($^O ne 'MacOS') {
 my $exit, $exit_arg;
 
 $exit = run('exit');
 is( $exit >> 8, 0,              'Normal exit' );
-is( $exit, $?,                  'Normal exit $?' );
-is( ${^CHILD_ERROR_NATIVE}, $native_success,  'Normal exit ${^CHILD_ERROR_NATIVE}' );
-
-if (!$vms_exit_mode) {
-  my $posix_ok = eval { require POSIX; };
-  my $wait_macros_ok = defined &POSIX::WIFEXITED;
-  eval { POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}) };
-  $wait_macros_ok = 0 if $@;
-  $exit = run('exit 42');
-  is( $exit >> 8, 42,             'Non-zero exit' );
-  is( $exit, $?,                  'Non-zero exit $?' );
-  isnt( !${^CHILD_ERROR_NATIVE}, 0, 'Non-zero exit ${^CHILD_ERROR_NATIVE}' );
-  SKIP: {
-    skip("No POSIX", 3) unless $posix_ok;
-    skip("No POSIX wait macros", 3) unless $wait_macros_ok;
-    ok(POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}), "WIFEXITED");
-    ok(!POSIX::WIFSIGNALED(${^CHILD_ERROR_NATIVE}), "WIFSIGNALED");
-    is(POSIX::WEXITSTATUS(${^CHILD_ERROR_NATIVE}), 42, "WEXITSTATUS");
-  }
-
-  SKIP: {
-    skip("Skip signals and core dump tests on Win32 and VMS", 7) 
-        if ($^O eq 'MSWin32' || $^O eq 'VMS');
-
-    #TODO VMS will backtrace on this test and exits with code of 0
-    #instead of 15.
-
-    $exit = run('kill 15, $$; sleep(1);');
-
-    is( $exit & 127, 15,            'Term by signal' );
-    ok( !($exit & 128),             'No core dump' );
-    is( $? & 127, 15,               'Term by signal $?' );
-    isnt( ${^CHILD_ERROR_NATIVE},  0, 'Term by signal ${^CHILD_ERROR_NATIVE}' );
-    SKIP: {
-      skip("No POSIX", 3) unless $posix_ok;
-      skip("No POSIX wait macros", 3) unless $wait_macros_ok;
-      ok(!POSIX::WIFEXITED(${^CHILD_ERROR_NATIVE}), "WIFEXITED");
-      ok(POSIX::WIFSIGNALED(${^CHILD_ERROR_NATIVE}), "WIFSIGNALED");
-      is(POSIX::WTERMSIG(${^CHILD_ERROR_NATIVE}), 15, "WTERMSIG");
-    }
-  }
 
-}
+if ($^O ne 'VMS') {
 
-if ($^O eq 'VMS') {
-
-# On VMS, successful returns from system() are reported 0,  VMS errors that
-# can not be translated to UNIX are reported as EVMSERR, which has a value
-# of 65535. Codes from 2 through 7 are assumed to be from non-compliant
-# VMS systems and passed through.  Programs written to use _POSIX_EXIT()
-# codes like GNV will pass the numbers 2 through 255 encoded in the
-# C facility by multiplying the number by 8 and adding %x35A000 to it.
-# Perl will decode that number from children back to it's internal status.
-#
-# For native VMS status codes, success codes are odd numbered, error codes
-# are even numbered.  The 3 LSBs of the code indicate if the success is
-# an informational message or the severity of the failure.
-#
-# Because the failure codes for the tests of the CLI facility status codes can
-# not be translated to UNIX error codes, they will be reported as EVMSERR,
-# even though Perl will exit with them having the VMS status codes.
-#
-# Note that this is testing the perl exit() routine, and not the VMS
-# DCL EXIT statement.
-#
-# The value %x1000000 has been added to the exit code to prevent the
-# status message from being sent to the STDOUT and STDERR stream.
-#
-# Double quotes are needed to pass these commands through DCL to PERL
+  $exit = run('exit 42');
+  is( $exit >> 8, 42,             'Non-zero exit' );
 
-  $exit = run("exit 268632065"); # %CLI-S-NORMAL
-  is( $exit >> 8, 0,             'PERL success exit' );
-  is( ${^CHILD_ERROR_NATIVE} & 7, 1, 'VMS success exit' );
+} else {
 
-  $exit = run("exit 268632067");  # %CLI-I-NORMAL
-  is( $exit >> 8, 0,             'PERL informational exit' );
-  is( ${^CHILD_ERROR_NATIVE} & 7, 3, 'VMS informational exit' );
+# On VMS, successful returns from system() are always 0, warnings are 1,
+# errors are 2, and fatal errors are 4.
 
-  $exit = run("exit 268632064");  # %CLI-W-NORMAL
-  is( $exit >> 8, 1,             'Perl warning exit' );
-  is( ${^CHILD_ERROR_NATIVE} & 7, 0, 'VMS warning exit' );
+  $exit = run("exit 196609"); # %CLI-S-NORMAL
+  is( $exit >> 8, 0,             'success exit' );
 
-  $exit = run("exit 268632066");  # %CLI-E-NORMAL
-  is( $exit >> 8, 2,             'Perl error exit' );
-  is( ${^CHILD_ERROR_NATIVE} & 7, 2, 'VMS error exit' );
+  $exit = run("exit 196611");  # %CLI-I-NORMAL
+  is( $exit >> 8, 0,             'informational exit' );
 
-  $exit = run("exit 268632068");  # %CLI-F-NORMAL
-  is( $exit >> 8, 4,             'Perl fatal error exit' );
-  is( ${^CHILD_ERROR_NATIVE} & 7, 4, 'VMS fatal exit' );
+  $exit = run("exit 196608");  # %CLI-W-NORMAL
+  is( $exit >> 8, 1,             'warning exit' );
 
-  $exit = run("exit 02015320012"); # POSIX exit code 1
-  is( $exit >> 8, 1,	                 'Posix exit code 1' );
+  $exit = run("exit 196610");  # %CLI-E-NORMAL
+  is( $exit >> 8, 2,             'error exit' );
 
-  $exit = run("exit 02015323771"); # POSIX exit code 255
-  is( $exit >> 8 , 255,	                 'Posix exit code 255' );
+  $exit = run("exit 196612");  # %CLI-F-NORMAL
+  is( $exit >> 8, 4,             'fatal error exit' );
 }
 
 $exit_arg = 42;
 $exit = run("END { \$? = $exit_arg }");
 
-# On VMS, in the child process the actual exit status will be SS$_ABORT,
-# or 44, which is what you get from any non-zero value of $? except for
-# 65535 that has been dePOSIXified by STATUS_UNIX_SET.  If $? is set to
-# 65535 internally when there is a VMS status code that is valid, and
-# when Perl exits, it will set that status code.
-#
-# In this test on VMS, the child process exit with a SS$_ABORT, which
-# the parent stores in ${^CHILD_ERROR_NATIVE}.  The SS$_ABORT code is
-# then translated to the UNIX code EINTR which has the value of 4 on VMS.
-#
-# This is complex because Perl translates internally generated UNIX
-# status codes to SS$_ABORT on exit, but passes through unmodified UNIX
-# status codes that exit() is called with by scripts.
-
-$exit_arg = (44 & 7) if $vms_exit_mode;
+# On VMS, in the child process the actual exit status will be SS$_ABORT, 
+# which is what you get from any non-zero value of $? that has been 
+# dePOSIXified by STATUS_POSIX_SET.  In the parent process, all we'll 
+# see are the severity bits (0-2) shifted left by 8.
+$exit_arg = (44 & 7) if $^O eq 'VMS';  
 
 is( $exit >> 8, $exit_arg,             'Changing $? in END block' );
+}
diff --git a/gnu/usr.bin/perl/t/run/fresh_perl.t b/gnu/usr.bin/perl/t/run/fresh_perl.t
index 885c8cc3d9a..9c2b42fc033 100644
--- a/gnu/usr.bin/perl/t/run/fresh_perl.t
+++ b/gnu/usr.bin/perl/t/run/fresh_perl.t
@@ -4,9 +4,20 @@
 # Instead, put the test in the appropriate test file and use the 
 # fresh_perl_is()/fresh_perl_like() functions in t/test.pl.
 
-# This is for tests that used to abnormally cause segfaults, and other nasty
+# This is for tests that will normally cause segfaults, and other nasty
 # errors that might kill the interpreter and for some reason you can't
 # use an eval().
+#
+# New tests are added to the bottom.  For example.
+#
+#       ######## perlbug ID 20020831.001
+#       ($a, b) = (1,2)
+#       EXPECT
+#       Can't modify constant item in list assignment - at line 1
+#
+# to test that the code "($a, b) = (1,2)" causes the appropriate syntax
+# error, rather than just segfaulting as reported in perlbug ID
+# 20020831.001
 
 BEGIN {
     chdir 't' if -d 't';
@@ -35,13 +46,11 @@ foreach my $prog (@prgs) {
     my($raw_prog, $name) = @$prog;
 
     my $switch;
-    if ($raw_prog =~ s/^\s*(-\w.*)\n//){
+    if ($raw_prog =~ s/^\s*(-\w.*)//){
 	$switch = $1;
     }
 
     my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
-    $prog .= "\n";
-    $expected = '' unless defined $expected;
 
     if ($prog =~ /^\# SKIP: (.+)/m) {
 	if (eval $1) {
@@ -52,12 +61,12 @@ foreach my $prog (@prgs) {
 
     $expected =~ s/\n+$//;
 
-    fresh_perl_is($prog, $expected, { switches => [$switch || ''] }, $name);
+    fresh_perl_is($prog, $expected, { switches => [$switch] }, $name);
 }
 
 __END__
 ########
-$a = ":="; @_ = split /($a)/o, "a:=b:=c"; print "@_"
+$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
 EXPECT
 a := b := c
 ########
@@ -81,7 +90,7 @@ $array[128]=1
 ########
 $x=0x0eabcd; print $x->ref;
 EXPECT
-Can't locate object method "ref" via package "961485" (perhaps you forgot to load "961485"?) at - line 1.
+Can't call method "ref" without a package or object reference at - line 1.
 ########
 chop ($str .= <DATA>);
 ########
@@ -91,9 +100,9 @@ $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
 EXPECT
 25
 ########
-eval 'sub bar {print "In bar"}';
+eval {sub bar {print "In bar";}}
 ########
-system './perl -ne "print if eof" /dev/null'
+system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS'
 ########
 chop($file = <DATA>);
 ########
@@ -105,6 +114,11 @@ print $aa;
 EXPECT
 12345
 ########
+%@x=0;
+EXPECT
+Can't modify hash dereference in repeat (x) at - line 1, near "0;"
+Execution of - aborted due to compilation errors.
+########
 $_="foo";
 printf(STDOUT "%s\n", $_);
 EXPECT
@@ -275,7 +289,7 @@ print "ok\n" if ("\0" lt "\xFF");
 EXPECT
 ok
 ########
-open(H,'run/fresh_perl.t'); # must be in the 't' directory
+open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the 't' directory
 stat(H);
 print "ok\n" if (-e _ and -f _ and -r _);
 EXPECT
@@ -345,16 +359,20 @@ map {#this newline here tickles the bug
 $s += $_} (1,2,4);
 print "eat flaming death\n" unless ($s == 7);
 ########
-sub foo { local $_ = shift; @_ = split; @_ }
+sub foo { local $_ = shift; split; @_ }
 @x = foo(' x  y  z ');
 print "you die joe!\n" unless "@x" eq 'x y z';
 ########
-"A" =~ /(?{"{"})/	# Check it outside of eval too
+/(?{"{"})/	# Check it outside of eval too
 EXPECT
+Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
+Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1.
 ########
 /(?{"{"}})/	# Check it outside of eval too
 EXPECT
-Sequence (?{...}) not terminated with ')' at - line 1.
+Unmatched right curly bracket at (re_eval 1) line 1, at end of line
+syntax error at (re_eval 1) line 1, near ""{"}"
+Compilation failed in regexp at - line 1.
 ########
 BEGIN { @ARGV = qw(a b c d e) }
 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
@@ -382,7 +400,7 @@ EXPECT
 -w
 sub testme { my $a = "test"; { local $a = "new test"; print $a }}
 EXPECT
-Can't localize lexical variable $a at - line 1.
+Can't localize lexical variable $a at - line 2.
 ########
 package X;
 sub ascalar { my $r; bless \$r }
@@ -509,7 +527,7 @@ else {
   if ($x == 0) { print "" } else { print $x }
 }
 EXPECT
-Use of uninitialized value $x in numeric eq (==) at - line 3.
+Use of uninitialized value in numeric eq (==) at - line 4.
 ########
 $x = sub {};
 foo();
@@ -527,13 +545,12 @@ my $x = "foo";
 EXPECT
 foo
 ########
-# [perl #3066]
 sub C () { 1 }
-sub M { print "$_[0]\n" }
+sub M { $_[0] = 2; }
 eval "C";
 M(C);
 EXPECT
-1
+Modification of a read-only value attempted at - line 2.
 ########
 print qw(ab a\b a\\b);
 EXPECT
@@ -563,11 +580,45 @@ EOT
 EXPECT
 ok
 ########
-# [ID 20001202.002] and change #8066 added 'at -e line 1';
-# reversed again as a result of [perl #17763]
+# This test is here instead of lib/locale.t because
+# the bug depends on in the internal state of the locale
+# settings and pragma/locale messes up that state pretty badly.
+# We need a "fresh run".
+BEGIN {
+    eval { require POSIX };
+    if ($@) {
+	exit(0); # running minitest?
+    }
+}
+use Config;
+my $have_setlocale = $Config{d_setlocale} eq 'define';
+$have_setlocale = 0 if $@;
+# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
+# and mingw32 uses said silly CRT
+$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
+exit(0) unless $have_setlocale;
+my @locales;
+if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
+    while(<LOCALES>) {
+        chomp;
+        push(@locales, $_);
+    }
+    close(LOCALES);
+}
+exit(0) unless @locales;
+for (@locales) {
+    use POSIX qw(locale_h);
+    use locale;
+    setlocale(LC_NUMERIC, $_) or next;
+    my $s = sprintf "%g %g", 3.1, 3.1;
+    next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
+    print "$_ $s\n";
+}
+EXPECT
+########
 die qr(x)
 EXPECT
-(?^:x)
+(?-xism:x) at - line 1.
 ########
 # 20001210.003 mjd@plover.com
 format REMITOUT_TOP =
@@ -615,9 +666,8 @@ new_pmop "abcdef"; reset;
 close STDERR; die;
 EXPECT
 ########
-# core dump in 20000716.007
 -w
-"x" =~ /(\G?x)?/;
+"x" =~ /(\G?x)?/;	# core dump in 20000716.007
 ########
 # Bug 20010515.004
 my @h = 1 .. 10;
@@ -636,6 +686,18 @@ OK
 EXPECT
 ok
 ########
+# Bug 20010422.005
+{s//${}/; //}
+EXPECT
+syntax error at - line 2, near "${}"
+Execution of - aborted due to compilation errors.
+########
+# Bug 20010528.007
+"\x{"
+EXPECT
+Missing right brace on \x{} at - line 2, within string
+Execution of - aborted due to compilation errors.
+########
 my $foo = Bar->new();
 my @dst;
 END {
@@ -653,6 +715,26 @@ sub DESTROY {
 }
 EXPECT
 Bar=ARRAY(0x...)
+########
+######## found by Markov chain stress testing
+eval "a.b.c.d.e.f;sub"
+EXPECT
+
+######## perlbug ID 20010831.001
+($a, b) = (1, 2);
+EXPECT
+Can't modify constant item in list assignment at - line 1, near ");"
+Execution of - aborted due to compilation errors.
+######## tying a bareword causes a segfault in 5.6.1
+tie FOO, "Foo";
+EXPECT
+Can't modify constant item in tie at - line 1, near ""Foo";"
+Execution of - aborted due to compilation errors.
+######## undefing constant causes a segfault in 5.6.1 [ID 20010906.019]
+undef foo;
+EXPECT
+Can't modify constant item in undef operator at - line 1, near "foo;"
+Execution of - aborted due to compilation errors.
 ######## (?{...}) compilation bounces on PL_rs
 -0
 {
@@ -662,6 +744,11 @@ Bar=ARRAY(0x...)
 BEGIN { print "ok\n" }
 EXPECT
 ok
+######## read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054]
+read($bla, FILE, 1);
+EXPECT
+Can't modify constant item in read at - line 1, near "1)"
+Execution of - aborted due to compilation errors.
 ######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155]
 # This only happens if the filename is 11 characters or less.
 $foo = \-f "blah";
@@ -678,6 +765,36 @@ ok
 print join '', @a, "\n";
 EXPECT
 123456789
+######## [ID 20020104.007] "coredump on dbmclose"
+package Foo;
+eval { require AnyDBM_File }; # not all places have dbm* functions
+if ($@) {
+    print "ok\n";
+    exit 0;
+}
+package Foo;
+sub new {
+        my $proto = shift;
+        my $class = ref($proto) || $proto;
+        my $self  = {};
+        bless($self,$class);
+        my %LT;
+        dbmopen(%LT, "dbmtest", 0666) ||
+	    die "Can't open dbmtest because of $!\n";
+        $self->{'LT'} = \%LT;
+        return $self;
+}
+sub DESTROY {
+        my $self = shift;
+	dbmclose(%{$self->{'LT'}});
+	1 while unlink 'dbmtest';
+	1 while unlink <dbmtest.*>;
+	print "ok\n";
+}
+package main;
+$test = Foo->new(); # must be package var
+EXPECT
+ok
 ######## example from Camel 5, ch. 15, pp.406 (with my)
 # SKIP: ord "A" == 193 # EBCDIC
 use strict;
@@ -727,125 +844,3 @@ ok 1
 ######## [ID 20020623.009] nested eval/sub segfaults
 $eval = eval 'sub { eval "sub { %S }" }';
 $eval->({});
-######## [perl #17951] Strange UTF error
--W
-# From: "John Kodis" <kodis@mail630.gsfc.nasa.gov>
-# Newsgroups: comp.lang.perl.moderated
-# Subject: Strange UTF error
-# Date: Fri, 11 Oct 2002 16:19:58 -0400
-# Message-ID: <pan.2002.10.11.20.19.48.407190@mail630.gsfc.nasa.gov>
-$_ = "foobar\n";
-utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN)
-# matching is actually irrelevant: avoiding several dozen of these
-# Illegal hexadecimal digit '	' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152
-# is what matters.
-/^([[:digit:]]+)/;
-EXPECT
-######## [perl #20667] unicode regex vs non-unicode regex
-$toto = 'Hello';
-$toto =~ /\w/; # this line provokes the problem!
-$name = 'A B';
-# utf8::upgrade($name) if @ARGV;
-if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){
-    print "It's good! >$1< >$2<\n";
-} else {
-    print "It's not good...\n";
-}
-EXPECT
-It's good! >A< >B<
-######## [perl #8760] strangeness with utf8 and warn
-$_="foo";utf8::upgrade($_);/bar/i,warn$_;
-EXPECT
-foo at - line 1.
-######## "#75146: 27e904532594b7fb (fix for #23810) introduces a #regression"
-use strict;
-
-unshift @INC, sub {
-    my ($self, $fn) = @_;
-
-    (my $pkg = $fn) =~ s{/}{::}g;
-    $pkg =~ s{.pm$}{};
-
-    if ($pkg eq 'Credit') {
-        my $code = <<'EOC';
-package Credit;
-
-use NonsenseAndBalderdash;
-
-1;
-EOC
-        eval $code;
-        die "\$@ is $@";
-    }
-
-    #print STDERR "Generator: not one of mine, ignoring\n";
-    return undef;
-};
-
-# create load-on-demand new() constructors
-{
-    package Credit;
-    sub new {
-        eval "use Credit";
-    }
-};
-
-eval {
-    my $credit = new Credit;
-};
-
-print "If you get here, you didn't crash\n";
-EXPECT
-If you get here, you didn't crash
-######## [perl #112312] crash on syntax error
-# SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
-#!/usr/bin/perl
-use strict;
-use warnings;
-sub meow (&);
-my %h;
-my $k;
-meow {
-	my $t : need_this;
-	$t = {
-		size =>  $h{$k}{size};
-		used =>  $h{$k}(used}
-	};
-};
-EXPECT
-syntax error at - line 12, near "used"
-syntax error at - line 12, near "used}"
-Unmatched right curly bracket at - line 14, at end of line
-Execution of - aborted due to compilation errors.
-######## [perl #112312] crash on syntax error - another test
-# SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
-#!/usr/bin/perl
-use strict;
-use warnings;
-
-sub meow (&);
-
-my %h;
-my $k;
-
-meow {
-        my $t : need_this;
-        $t = {
-                size => $h{$k}{size};
-                used => $h{$k}(used}
-        };
-};
-
-sub testo {
-        my $value = shift;
-        print;
-        print;
-        print;
-        1;
-}
-
-EXPECT
-syntax error at - line 15, near "used"
-syntax error at - line 15, near "used}"
-Unmatched right curly bracket at - line 17, at end of line
-Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/run/switches.t b/gnu/usr.bin/perl/t/run/switches.t
index a2e4bad47c6..996ad5d4c64 100644
--- a/gnu/usr.bin/perl/t/run/switches.t
+++ b/gnu/usr.bin/perl/t/run/switches.t
@@ -1,22 +1,15 @@
 #!./perl -w
 
-# Tests for the command-line switches:
-# -0, -c, -l, -s, -m, -M, -V, -v, -h, -i, -E and all unknown
-# Some switches have their own tests, see MANIFEST.
+# Tests for the command-line switches
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require Config; import Config;
 }
 
-BEGIN { require "./test.pl"; }
+require "./test.pl";
 
-plan(tests => 115);
-
-use Config;
-use Errno qw(EACCES EISDIR);
-BEGIN { eval 'use POSIX qw(setlocale LC_ALL)' }
+plan(tests => 19);
 
 # due to a bug in VMS's piping which makes it impossible for runperl()
 # to emulate echo -n (ie. stdin always winds up with a newline), these 
@@ -25,7 +18,7 @@ $TODO = "runperl() unable to emulate echo -n due to pipe bug" if $^O eq 'VMS';
 
 my $r;
 my @tmpfiles = ();
-END { unlink_all @tmpfiles }
+END { unlink @tmpfiles }
 
 # Tests for -0
 
@@ -71,15 +64,9 @@ $r = runperl(
 );
 is( $r, 'abc-def--ghi-jkl-mno--pq-/', '-0777 (slurp mode)' );
 
-$r = runperl(
-    switches	=> [ '-066' ],
-    prog	=> 'BEGIN { print qq{($/)} } print qq{[$/]}',
-);
-is( $r, "(\066)[\066]", '$/ set at compile-time' );
-
 # Tests for -c
 
-my $filename = tempfile();
+my $filename = 'swctest.tmp';
 SKIP: {
     local $TODO = '';   # this one works on VMS
 
@@ -108,28 +95,7 @@ SWTEST
 	&& $r !~ /\bblock 5\b/,
 	'-c'
     );
-}
-
-SKIP: {
-    skip "no POSIX on miniperl", 1, unless $INC{"POSIX.pm"};
-    skip 'No locale testing without d_setlocale', 1 if(!$Config{d_setlocale});
-
-    my $tempdir = tempfile;
-    mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
-
-    local $ENV{'LC_ALL'} = 'C'; # Keep the test simple: expect English
-    local $ENV{LANGUAGE} = 'C';
-    setlocale(LC_ALL, "C");
-
-    # Win32 won't let us open the directory, so we never get to die with
-    # EISDIR, which happens after open.
-    my $error  = do { local $! = $^O eq 'MSWin32' ? EACCES : EISDIR; "$!" };
-    like(
-        runperl( switches => [ '-c' ], args  => [ $tempdir ], stderr => 1),
-        qr/Can't open perl script.*$tempdir.*\Q$error/s,
-        "RT \#61362: Cannot syntax-check a directory"
-    );
-    rmdir $tempdir or die "Can't rmdir '$tempdir': $!";
+    push @tmpfiles, $filename;
 }
 
 # Tests for -l
@@ -149,61 +115,47 @@ $r = runperl(
 );
 is( $r, '21-', '-s switch parsing' );
 
-$filename = tempfile();
-SKIP: {
-    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
-    print $f <<'SWTEST';
-#!perl -s
-BEGIN { print $x,$y; exit }
-SWTEST
-    close $f or die "Could not close: $!";
-    $r = runperl(
-	progfile    => $filename,
-	args	    => [ '-x=foo -y' ],
-    );
-    is( $r, 'foo1', '-s on the shebang line' );
-}
-
 # Bug ID 20011106.084
-$filename = tempfile();
+$filename = 'swstest.tmp';
 SKIP: {
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
     print $f <<'SWTEST';
-#!perl -sn
-BEGIN { print $x; exit }
+#!perl -s
+print $x
 SWTEST
     close $f or die "Could not close: $!";
     $r = runperl(
+	switches    => [ '-s' ],
 	progfile    => $filename,
 	args	    => [ '-x=foo' ],
     );
-    is( $r, 'foo', '-sn on the shebang line' );
+    is( $r, 'foo', '-s on the shebang line' );
+    push @tmpfiles, $filename;
 }
 
 # Tests for -m and -M
 
-my $package = tempfile();
-$filename = "$package.pm";
+$filename = 'swtest.pm';
 SKIP: {
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!",4 );
-    print $f <<"SWTESTPM";
-package $package;
-sub import { print map "<\$_>", \@_ }
+    print $f <<'SWTESTPM';
+package swtest;
+sub import { print map "<$_>", @_ }
 1;
 SWTESTPM
     close $f or die "Could not close: $!";
     $r = runperl(
-	switches    => [ "-M$package" ],
+	switches    => [ '-Mswtest' ],
 	prog	    => '1',
     );
-    is( $r, "<$package>", '-M' );
+    is( $r, '<swtest>', '-M' );
     $r = runperl(
-	switches    => [ "-M$package=foo" ],
+	switches    => [ '-Mswtest=foo' ],
 	prog	    => '1',
     );
-    is( $r, "<$package><foo>", '-M with import parameter' );
+    is( $r, '<swtest><foo>', '-M with import parameter' );
     $r = runperl(
-	switches    => [ "-m$package" ],
+	switches    => [ '-mswtest' ],
 	prog	    => '1',
     );
 
@@ -212,48 +164,12 @@ SWTESTPM
         is( $r, '', '-m' );
     }
     $r = runperl(
-	switches    => [ "-m$package=foo,bar" ],
+	switches    => [ '-mswtest=foo,bar' ],
 	prog	    => '1',
     );
-    is( $r, "<$package><foo><bar>", '-m with import parameters' );
+    is( $r, '<swtest><foo><bar>', '-m with import parameters' );
     push @tmpfiles, $filename;
-
-  {
-    local $TODO = '';  # these work on VMS
-
-    is( runperl( switches => [ '-MTie::Hash' ], stderr => 1, prog => 1 ),
-	  '', "-MFoo::Bar allowed" );
-
-    like( runperl( switches => [ "-M:$package" ], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/Invalid module name [\w:]+ with -M option\b/,
-          "-M:Foo not allowed" );
-
-    like( runperl( switches => [ '-mA:B:C' ], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/Invalid module name [\w:]+ with -m option\b/,
-          "-mFoo:Bar not allowed" );
-
-    like( runperl( switches => [ '-m-A:B:C' ], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/Invalid module name [\w:]+ with -m option\b/,
-          "-m-Foo:Bar not allowed" );
-
-    like( runperl( switches => [ '-m-' ], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/Module name required with -m option\b/,
-  	  "-m- not allowed" );
-
-    like( runperl( switches => [ '-M-=' ], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/Module name required with -M option\b/,
-  	  "-M- not allowed" );
-  }  # disable TODO on VMS
 }
-is runperl(stderr => 1, prog => '#!perl -m'),
-   qq 'Too late for "-m" option at -e line 1.\n', '#!perl -m';
-is runperl(stderr => 1, prog => '#!perl -M'),
-   qq 'Too late for "-M" option at -e line 1.\n', '#!perl -M';
 
 # Tests for -V
 
@@ -261,14 +177,10 @@ is runperl(stderr => 1, prog => '#!perl -M'),
     local $TODO = '';   # these ones should work on VMS
 
     # basic perl -V should generate significant output.
-    # we don't test actual format too much since it could change
+    # we don't test actual format since it could change
     like( runperl( switches => ['-V'] ), qr/(\n.*){20}/,
           '-V generates 20+ lines' );
 
-    like( runperl( switches => ['-V'] ),
-	  qr/\ASummary of my perl5 .*configuration:/,
-          '-V looks okay' );
-
     # lookup a known config var
     chomp( $r=runperl( switches => ['-V:osname'] ) );
     is( $r, "osname='$^O';", 'perl -V:osname');
@@ -288,158 +200,3 @@ is runperl(stderr => 1, prog => '#!perl -M'),
     # make sure each line we got matches the re
     ok( !( grep !/^i\D+size=/, split /^/, $r ), '-V:re correct' );
 }
-
-# Tests for -v
-
-{
-    local $TODO = '';   # these ones should work on VMS
-    # there are definitely known build configs where this test will fail
-    # DG/UX comes to mind. Maybe we should remove these special cases?
-    my $v = sprintf "%vd", $^V;
-    my $ver = $Config{PERL_VERSION};
-    my $rel = $Config{PERL_SUBVERSION};
-    like( runperl( switches => ['-v'] ),
-	  qr/This is perl 5, version \Q$ver\E, subversion \Q$rel\E \(v\Q$v\E(?:[-*\w]+| \([^)]+\))?\) built for \Q$Config{archname}\E.+Copyright.+Larry Wall.+Artistic License.+GNU General Public License/s,
-          '-v looks okay' );
-
-}
-
-# Tests for -h
-
-{
-    local $TODO = '';   # these ones should work on VMS
-
-    like( runperl( switches => ['-h'] ),
-	  qr/Usage: .+(?i:perl(?:$Config{_exe})?).+switches.+programfile.+arguments/,
-          '-h looks okay' );
-
-}
-
-# Tests for switches which do not exist
-
-foreach my $switch (split //, "ABbGgHJjKkLNOoPQqRrYyZz123456789_")
-{
-    local $TODO = '';   # these ones should work on VMS
-
-    like( runperl( switches => ["-$switch"], stderr => 1,
-		   prog => 'die q{oops}' ),
-	  qr/\QUnrecognized switch: -$switch  (-h will show valid options)./,
-          "-$switch correctly unknown" );
-
-    # [perl #104288]
-    like( runperl( stderr => 1, prog => "#!perl -$switch" ),
-	  qr/^Unrecognized switch: -$switch  \(-h will show valid (?x:
-	     )options\) at -e line 1\./,
-          "-$switch unrecognised on #! line" );
-}
-
-# Tests for unshebangable switches
-for (qw( e f x E S V )) {
-    $r = runperl(
-	stderr   => 1,
-	prog     => "#!perl -$_",
-    );
-    is $r, "Can't emulate -$_ on #! line at -e line 1.\n","-$_ on #! line";
-}
-
-# Tests for -i
-
-{
-    local $TODO = '';   # these ones should work on VMS
-
-    sub do_i_unlink { unlink_all("file", "file.bak") }
-
-    open(FILE, ">file") or die "$0: Failed to create 'file': $!";
-    print FILE <<__EOF__;
-foo yada dada
-bada foo bing
-king kong foo
-__EOF__
-    close FILE;
-
-    END { do_i_unlink() }
-
-    runperl( switches => ['-pi.bak'], prog => 's/foo/bar/', args => ['file'] );
-
-    open(FILE, "file") or die "$0: Failed to open 'file': $!";
-    chomp(my @file = <FILE>);
-    close FILE;
-
-    open(BAK, "file.bak") or die "$0: Failed to open 'file': $!";
-    chomp(my @bak = <BAK>);
-    close BAK;
-
-    is(join(":", @file),
-       "bar yada dada:bada bar bing:king kong bar",
-       "-i new file");
-    is(join(":", @bak),
-       "foo yada dada:bada foo bing:king kong foo",
-       "-i backup file");
-
-    my $out1 = runperl(
-        switches => ['-i.bak -p'],
-        prog     => 'exit',
-        stderr   => 1,
-        stdin    => "1\n",
-    );
-    is(
-        $out1,
-        "-i used with no filenames on the command line, reading from STDIN.\n",
-        "warning when no files given"
-    );
-    my $out2 = runperl(
-        switches => ['-i.bak -p'],
-        prog     => 'exit',
-        stderr   => 1,
-        stdin    => "1\n",
-        args     => ['file'],
-    );
-    is($out2, "", "no warning when files given");
-}
-
-# Tests for -E
-
-$TODO = '';  # the -E tests work on VMS
-
-$r = runperl(
-    switches	=> [ '-E', '"say q(Hello, world!)"']
-);
-is( $r, "Hello, world!\n", "-E say" );
-
-
-$r = runperl(
-    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"']
-);
-is( $r, "Hello, world!\n", "-E ~~" );
-
-$r = runperl(
-    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
-);
-is( $r, "Hello, world!\n", "-E given" );
-
-$r = runperl(
-    switches    => [ '-nE', q("} END { say q/affe/") ],
-    stdin       => 'zomtek',
-);
-is( $r, "affe\n", '-E works outside of the block created by -n' );
-
-$r = runperl(
-    switches	=> [ '-E', q("*{'bar'} = sub{}; print 'Hello, world!',qq|\n|;")]
-);
-is( $r, "Hello, world!\n", "-E does not enable strictures" );
-
-# RT #30660
-
-$filename = tempfile();
-SKIP: {
-    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
-    print $f <<'SWTEST';
-#!perl -w    -iok
-print "$^I\n";
-SWTEST
-    close $f or die "Could not close: $!";
-    $r = runperl(
-	progfile    => $filename,
-    );
-    like( $r, qr/ok/, 'Spaces on the #! line (#30660)' );
-}
diff --git a/gnu/usr.bin/perl/t/run/switcht.t b/gnu/usr.bin/perl/t/run/switcht.t
index fd8188518f3..869605ff953 100644
--- a/gnu/usr.bin/perl/t/run/switcht.t
+++ b/gnu/usr.bin/perl/t/run/switcht.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 13;
+plan tests => 11;
 
 my $Perl = which_perl();
 
@@ -14,7 +14,7 @@ my $warning;
 local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
 my $Tmsg = 'while running with -t switch';
 
-is( ${^TAINT}, -1, '${^TAINT} == -1' );
+ok( ${^TAINT},      '${^TAINT} defined' );
 
 my $out = `$Perl -le "print q(Hello)"`;
 is( $out, "Hello\n",                      '`` worked' );
@@ -29,9 +29,8 @@ like( $warning, qr/^Insecure .* $Tmsg/, '    taint warn' );
 }
 
 # Get ourselves a tainted variable.
-my $filename = tempfile();
 $file = $0;
-$file =~ s/.*/$filename/;
+$file =~ s/.*/some.tmp/;
 ok( open(FILE, ">$file"),   'open >' ) or DIE $!;
 print FILE "Stuff\n";
 close FILE;
@@ -44,23 +43,3 @@ like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
 ok( !-e $file,  'unlink worked' );
 
 ok( !$^W,   "-t doesn't enable regular warnings" );
-
-
-mkdir('ttdir');
-open(FH,'>','ttdir/ttest.pl')or DIE $!;
-print FH 'return 42';
-close FH or DIE $!;
-
-SKIP: {
-    ($^O eq 'MSWin32') || skip('skip tainted do test with \ separator');
-    my $test = 0;
-    $test =  do '.\ttdir/ttest.pl';
-    is($test, 42, 'Could "do" .\ttdir/ttest.pl');
-}
-{
-    my $test = 0;
-    $test =  do './ttdir/ttest.pl';
-    is($test, 42, 'Could "do" ./ttdir/ttest.pl');
-}
-unlink ('./ttdir/ttest.pl');
-rmdir ('ttdir');
diff --git a/gnu/usr.bin/perl/t/test.pl b/gnu/usr.bin/perl/t/test.pl
index 30db88ced0f..427a64f5786 100644
--- a/gnu/usr.bin/perl/t/test.pl
+++ b/gnu/usr.bin/perl/t/test.pl
@@ -1,212 +1,52 @@
 #
-# t/test.pl - most of Test::More functionality without the fuss, plus
-# has mappings native_to_latin1 and latin1_to_native so that fewer tests
-# on non ASCII-ish platforms need to be skipped
-
-
-# NOTE:
-#
-# Increment ($x++) has a certain amount of cleverness for things like
-#
-#   $x = 'zz';
-#   $x++; # $x eq 'aaa';
-#
-# stands more chance of breaking than just a simple
-#
-#   $x = $x + 1
+# t/test.pl - most of Test::More functionality without the fuss
 #
-# In this file, we use the latter "Baby Perl" approach, and increment
-# will be worked over by t/op/inc.t
 
-$Level = 1;
 my $test = 1;
 my $planned;
-my $noplan;
-my $Perl;       # Safer version of $^X set by which_perl()
-
-# This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
-$::IS_ASCII  = ord 'A' ==  65;
-$::IS_EBCDIC = ord 'A' == 193;
 
 $TODO = 0;
 $NO_ENDING = 0;
-$Tests_Are_Passing = 1;
-
-# Use this instead of print to avoid interference while testing globals.
-sub _print {
-    local($\, $", $,) = (undef, ' ', '');
-    print STDOUT @_;
-}
-
-sub _print_stderr {
-    local($\, $", $,) = (undef, ' ', '');
-    print STDERR @_;
-}
 
 sub plan {
     my $n;
     if (@_ == 1) {
 	$n = shift;
-	if ($n eq 'no_plan') {
-	  undef $n;
-	  $noplan = 1;
-	}
     } else {
 	my %plan = @_;
-	$n = $plan{tests};
+	$n = $plan{tests}; 
     }
-    _print "1..$n\n" unless $noplan;
-    $planned = $n;
-}
-
-
-# Set the plan at the end.  See Test::More::done_testing.
-sub done_testing {
-    my $n = $test - 1;
-    $n = shift if @_;
-
-    _print "1..$n\n";
+    print STDOUT "1..$n\n";
     $planned = $n;
 }
 
-
 END {
     my $ran = $test - 1;
-    if (!$NO_ENDING) {
-	if (defined $planned && $planned != $ran) {
-	    _print_stderr
-		"# Looks like you planned $planned tests but ran $ran.\n";
-	} elsif ($noplan) {
-	    _print "1..$ran\n";
-	}
+    if (!$NO_ENDING && defined $planned && $planned != $ran) {
+        print STDERR "# Looks like you planned $planned tests but ran $ran.\n";
     }
 }
 
-sub _diag {
-    return unless @_;
-    my @mess = _comment(@_);
-    $TODO ? _print(@mess) : _print_stderr(@mess);
-}
-
-# Use this instead of "print STDERR" when outputting failure diagnostic
+# Use this instead of "print STDERR" when outputing failure diagnostic 
 # messages
-sub diag {
-    _diag(@_);
-}
-
-# Use this instead of "print" when outputting informational messages
-sub note {
+sub _diag {
     return unless @_;
-    _print( _comment(@_) );
-}
+    my @mess = map { /^#/ ? "$_\n" : "# $_\n" } 
+               map { split /\n/ } @_;
+    my $fh = $TODO ? *STDOUT : *STDERR;
+    print $fh @mess;
 
-sub is_miniperl {
-    return !defined &DynaLoader::boot_DynaLoader;
-}
-
-sub _comment {
-    return map { /^#/ ? "$_\n" : "# $_\n" }
-           map { split /\n/ } @_;
-}
-
-sub _have_dynamic_extension {
-    my $extension = shift;
-    unless (eval {require Config; 1}) {
-	warn "test.pl had problems loading Config: $@";
-	return 1;
-    }
-    $extension =~ s!::!/!g;
-    return 1 if ($Config::Config{extensions} =~ /\b$extension\b/);
 }
 
 sub skip_all {
     if (@_) {
-        _print "1..0 # Skip @_\n";
+	print STDOUT "1..0 # Skipped: @_\n";
     } else {
-	_print "1..0\n";
+	print STDOUT "1..0\n";
     }
     exit(0);
 }
 
-sub skip_all_if_miniperl {
-    skip_all(@_) if is_miniperl();
-}
-
-sub skip_all_without_dynamic_extension {
-    my ($extension) = @_;
-    skip_all("no dynamic loading on miniperl, no $extension") if is_miniperl();
-    return if &_have_dynamic_extension;
-    skip_all("$extension was not built");
-}
-
-sub skip_all_without_perlio {
-    skip_all('no PerlIO') unless PerlIO::Layer->find('perlio');
-}
-
-sub skip_all_without_config {
-    unless (eval {require Config; 1}) {
-	warn "test.pl had problems loading Config: $@";
-	return;
-    }
-    foreach (@_) {
-	next if $Config::Config{$_};
-	my $key = $_; # Need to copy, before trying to modify.
-	$key =~ s/^use//;
-	$key =~ s/^d_//;
-	skip_all("no $key");
-    }
-}
-
-sub find_git_or_skip {
-    my ($source_dir, $reason);
-    if (-d '.git') {
-	$source_dir = '.';
-    } elsif (-l 'MANIFEST' && -l 'AUTHORS') {
-	my $where = readlink 'MANIFEST';
-	die "Can't readling MANIFEST: $!" unless defined $where;
-	die "Confusing symlink target for MANIFEST, '$where'"
-	    unless $where =~ s!/MANIFEST\z!!;
-	if (-d "$where/.git") {
-	    # Looks like we are in a symlink tree
-	    if (exists $ENV{GIT_DIR}) {
-		diag("Found source tree at $where, but \$ENV{GIT_DIR} is $ENV{GIT_DIR}. Not changing it");
-	    } else {
-		note("Found source tree at $where, setting \$ENV{GIT_DIR}");
-		$ENV{GIT_DIR} = "$where/.git";
-	    }
-	    $source_dir = $where;
-	}
-    } elsif (exists $ENV{GIT_DIR}) {
-	my $commit = '8d063cd8450e59ea1c611a2f4f5a21059a2804f1';
-	my $out = `git rev-parse --verify --quiet '$commit^{commit}'`;
-	chomp $out;
-	if($out eq $commit) {
-	    $source_dir = '.'
-	}
-    }
-    if ($source_dir) {
-	my $version_string = `git --version`;
-	if (defined $version_string
-	      && $version_string =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
-	    return $source_dir if eval "v$1 ge v1.5.0";
-	    # If you have earlier than 1.5.0 and it works, change this test
-	    $reason = "in git checkout, but git version '$1$2' too old";
-	} else {
-	    $reason = "in git checkout, but cannot run git";
-	}
-    } else {
-	$reason = 'not being run from a git checkout';
-    }
-    skip_all($reason) if $_[0] && $_[0] eq 'all';
-    skip($reason, @_);
-}
-
-sub BAIL_OUT {
-    my ($reason) = @_;
-    _print("Bail out!  $reason\n");
-    exit 255;
-}
-
 sub _ok {
     my ($pass, $where, $name, @mess) = @_;
     # Do not try to microoptimize by factoring out the "not ".
@@ -220,37 +60,28 @@ sub _ok {
 	$out = $pass ? "ok $test" : "not ok $test";
     }
 
-    if ($TODO) {
-	$out = $out . " # TODO $TODO";
-    } else {
-	$Tests_Are_Passing = 0 unless $pass;
-    }
+    $out .= " # TODO $TODO" if $TODO;
+    print STDOUT "$out\n";
 
-    _print "$out\n";
-
-    if ($pass) {
-	note @mess; # Ensure that the message is properly escaped.
-    }
-    else {
-	my $msg = "# Failed test $test - ";
-	$msg.= "$name " if $name;
-	$msg .= "$where\n";
-	_diag $msg;
-	_diag @mess;
+    unless ($pass) {
+	_diag "# Failed $where\n";
     }
 
-    $test = $test + 1; # don't use ++
+    # Ensure that the message is properly escaped.
+    _diag @mess;
+
+    $test++;
 
     return $pass;
 }
 
 sub _where {
-    my @caller = caller($Level);
+    my @caller = caller(1);
     return "at $caller[1] line $caller[2]";
 }
 
 # DON'T use this for matches. Use like() instead.
-sub ok ($@) {
+sub ok {
     my ($pass, $name, @mess) = @_;
     _ok($pass, _where(), $name, @mess);
 }
@@ -259,8 +90,8 @@ sub _q {
     my $x = shift;
     return 'undef' unless defined $x;
     my $q = $x;
-    $q =~ s/\\/\\\\/g;
-    $q =~ s/'/\\'/g;
+    $q =~ s/\\/\\\\/;
+    $q =~ s/'/\\'/;
     return "'$q'";
 }
 
@@ -283,24 +114,13 @@ sub display {
             my $y = '';
             foreach my $c (unpack("U*", $x)) {
                 if ($c > 255) {
-                    $y = $y . sprintf "\\x{%x}", $c;
+                    $y .= sprintf "\\x{%x}", $c;
                 } elsif ($backslash_escape{$c}) {
-                    $y = $y . $backslash_escape{$c};
+                    $y .= $backslash_escape{$c};
                 } else {
                     my $z = chr $c; # Maybe we can get away with a literal...
-                    if ($z =~ /[[:^print:]]/) {
-
-                        # Use octal for characters traditionally expressed as
-                        # such: the low controls, which on EBCDIC aren't
-                        # necessarily the same ones as on ASCII platforms, but
-                        # are small ordinals, nonetheless
-                        if ($c <= 037) {
-                            $z = sprintf "\\%03o", $c;
-                        } else {
-                            $z = sprintf "\\x{%x}", $c;
-                        }
-                    }
-                    $y = $y . $z;
+                    $z = sprintf "\\%03o", $c if $z =~ /[[:^print:]]/;
+                    $y .= $z;
                 }
             }
             $x = $y;
@@ -311,45 +131,27 @@ sub display {
     return @result;
 }
 
-sub is ($$@) {
+sub is {
     my ($got, $expected, $name, @mess) = @_;
-
-    my $pass;
-    if( !defined $got || !defined $expected ) {
-        # undef only matches undef
-        $pass = !defined $got && !defined $expected;
-    }
-    else {
-        $pass = $got eq $expected;
-    }
-
+    my $pass = $got eq $expected;
     unless ($pass) {
-	unshift(@mess, "#      got "._qq($got)."\n",
-		       "# expected "._qq($expected)."\n");
+	unshift(@mess, "#      got "._q($got)."\n",
+		       "# expected "._q($expected)."\n");
     }
     _ok($pass, _where(), $name, @mess);
 }
 
-sub isnt ($$@) {
+sub isnt {
     my ($got, $isnt, $name, @mess) = @_;
-
-    my $pass;
-    if( !defined $got || !defined $isnt ) {
-        # undef only matches undef
-        $pass = defined $got || defined $isnt;
-    }
-    else {
-        $pass = $got ne $isnt;
-    }
-
+    my $pass = $got ne $isnt;
     unless( $pass ) {
-        unshift(@mess, "# it should not be "._qq($got)."\n",
+        unshift(@mess, "# it should not be "._q($got)."\n",
                        "# but it is.\n");
     }
     _ok($pass, _where(), $name, @mess);
 }
 
-sub cmp_ok ($$$@) {
+sub cmp_ok {
     my($got, $type, $expected, $name, @mess) = @_;
 
     my $pass;
@@ -361,17 +163,17 @@ sub cmp_ok ($$$@) {
     }
     unless ($pass) {
         # It seems Irix long doubles can have 2147483648 and 2147483648
-        # that stringify to the same thing but are actually numerically
+        # that stringify to the same thing but are acutally numerically
         # different. Display the numbers if $type isn't a string operator,
         # and the numbers are stringwise the same.
         # (all string operators have alphabetic names, so tr/a-z// is true)
-        # This will also show numbers for some unneeded cases, but will
-        # definitely be helpful for things such as == and <= that fail
+        # This will also show numbers for some uneeded cases, but will
+        # definately be helpful for things such as == and <= that fail
         if ($got eq $expected and $type !~ tr/a-z//) {
             unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
         }
-        unshift(@mess, "#      got "._qq($got)."\n",
-                       "# expected $type "._qq($expected)."\n");
+        unshift(@mess, "#      got "._q($got)."\n",
+                       "# expected $type "._q($expected)."\n");
     }
     _ok($pass, _where(), $name, @mess);
 }
@@ -382,7 +184,7 @@ sub cmp_ok ($$$@) {
 # otherwise $range is a fractional error.
 # Here $range must be numeric, >= 0
 # Non numeric ranges might be a useful future extension. (eg %)
-sub within ($$$@) {
+sub within {
     my ($got, $expected, $range, $name, @mess) = @_;
     my $pass;
     if (!defined $got or !defined $expected or !defined $range) {
@@ -407,28 +209,29 @@ sub within ($$$@) {
         if ($got eq $expected) {
             unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
         }
-	unshift@mess, "#      got "._qq($got)."\n",
-		      "# expected "._qq($expected)." (within "._qq($range).")\n";
+	unshift@mess, "#      got "._q($got)."\n",
+		      "# expected "._q($expected)." (within "._q($range).")\n";
     }
     _ok($pass, _where(), $name, @mess);
 }
 
 # Note: this isn't quite as fancy as Test::More::like().
-
-sub like   ($$@) { like_yn (0,@_) }; # 0 for -
-sub unlike ($$@) { like_yn (1,@_) }; # 1 for un-
-
-sub like_yn ($$$@) {
-    my ($flip, undef, $expected, $name, @mess) = @_;
+sub like {
+    my ($got, $expected, $name, @mess) = @_;
     my $pass;
-    $pass = $_[1] =~ /$expected/ if !$flip;
-    $pass = $_[1] !~ /$expected/ if $flip;
-    unless ($pass) {
-	unshift(@mess, "#      got '$_[1]'\n",
-		$flip
-		? "# expected !~ /$expected/\n" : "# expected /$expected/\n");
+    if (ref $expected eq 'Regexp') {
+	$pass = $got =~ $expected;
+	unless ($pass) {
+	    unshift(@mess, "#      got '$got'\n",
+		           "# expected /$expected/\n");
+	}
+    } else {
+	$pass = $got =~ /$expected/;
+	unless ($pass) {
+	    unshift(@mess, "#      got '$got'\n",
+		           "# expected /$expected/\n");
+	}
     }
-    local $Level = $Level + 1;
     _ok($pass, _where(), $name, @mess);
 }
 
@@ -446,9 +249,7 @@ sub curr_test {
 }
 
 sub next_test {
-  my $retval = $test;
-  $test = $test + 1; # don't use ++
-  $retval;
+  $test++;
 }
 
 # Note: can't pass multipart messages since we try to
@@ -457,43 +258,17 @@ sub skip {
     my $why = shift;
     my $n    = @_ ? shift : 1;
     for (1..$n) {
-        _print "ok $test # skip $why\n";
-        $test = $test + 1;
+        print STDOUT "ok $test # skip: $why\n";
+        $test++;
     }
     local $^W = 0;
     last SKIP;
 }
 
-sub skip_if_miniperl {
-    skip(@_) if is_miniperl();
-}
-
-sub skip_without_dynamic_extension {
-    my ($extension) = @_;
-    skip("no dynamic loading on miniperl, no $extension") if is_miniperl();
-    return if &_have_dynamic_extension;
-    skip("$extension was not built");
-}
-
-sub todo_skip {
-    my $why = shift;
-    my $n   = @_ ? shift : 1;
-
-    for (1..$n) {
-        _print "not ok $test # TODO & SKIP $why\n";
-        $test = $test + 1;
-    }
-    local $^W = 0;
-    last TODO;
-}
-
 sub eq_array {
     my ($ra, $rb) = @_;
     return 0 unless $#$ra == $#$rb;
     for my $i (0..$#$ra) {
-	next     if !defined $ra->[$i] && !defined $rb->[$i];
-	return 0 if !defined $ra->[$i];
-	return 0 if !defined $rb->[$i];
 	return 0 unless $ra->[$i] eq $rb->[$i];
     }
     return 1;
@@ -506,16 +281,13 @@ sub eq_hash {
     # Force a hash recompute if this perl's internals can cache the hash key.
     $key = "" . $key;
     if (exists $orig->{$key}) {
-      if (
-        defined $orig->{$key} != defined $value
-        || (defined $value && $orig->{$key} ne $value)
-      ) {
-        _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
+      if ($orig->{$key} ne $value) {
+        print STDOUT "# key ", _qq($key), " was ", _qq($orig->{$key}),
                      " now ", _qq($value), "\n";
         $fail = 1;
       }
     } else {
-      _print "# key ", _qq($key), " is ", _qq($value),
+      print STDOUT "# key ", _qq($key), " is ", _qq($value), 
                    ", not in original.\n";
       $fail = 1;
     }
@@ -524,55 +296,44 @@ sub eq_hash {
     # Force a hash recompute if this perl's internals can cache the hash key.
     $_ = "" . $_;
     next if (exists $suspect->{$_});
-    _print "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
+    print STDOUT "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
     $fail = 1;
   }
   !$fail;
 }
 
-# We only provide a subset of the Test::More functionality.
-sub require_ok ($) {
+sub require_ok {
     my ($require) = @_;
-    if ($require =~ tr/[A-Za-z0-9:.]//c) {
-	fail("Invalid character in \"$require\", passed to require_ok");
-    } else {
-	eval <<REQUIRE_OK;
+    eval <<REQUIRE_OK;
 require $require;
 REQUIRE_OK
-	is($@, '', _where(), "require $require");
-    }
+    _ok(!$@, _where(), "require $require");
 }
 
-sub use_ok ($) {
+sub use_ok {
     my ($use) = @_;
-    if ($use =~ tr/[A-Za-z0-9:.]//c) {
-	fail("Invalid character in \"$use\", passed to use");
-    } else {
-	eval <<USE_OK;
+    eval <<USE_OK;
 use $use;
 USE_OK
-	is($@, '', _where(), "use $use");
-    }
+    _ok(!$@, _where(), "use $use");
 }
 
-# runperl - Runs a separate perl interpreter and returns its output.
+# runperl - Runs a separate perl interpreter.
 # Arguments :
 #   switches => [ command-line switches ]
 #   nolib    => 1 # don't use -I../lib (included by default)
-#   non_portable => Don't warn if a one liner contains quotes
 #   prog     => one-liner (avoid quotes)
 #   progs    => [ multi-liner (avoid quotes) ]
 #   progfile => perl script
-#   stdin    => string to feed the stdin (or undef to redirect from /dev/null)
-#   stderr   => If 'devnull' suppresses stderr, if other TRUE value redirect
-#               stderr to stdout
+#   stdin    => string to feed the stdin
+#   stderr   => redirect stderr to stdout
 #   args     => [ command-line arguments to the perl program ]
 #   verbose  => print the command line
 
 my $is_mswin    = $^O eq 'MSWin32';
 my $is_netware  = $^O eq 'NetWare';
+my $is_macos    = $^O eq 'MacOS';
 my $is_vms      = $^O eq 'VMS';
-my $is_cygwin   = $^O eq 'cygwin';
 
 sub _quote_args {
     my ($runperl, $args) = @_;
@@ -581,65 +342,40 @@ sub _quote_args {
 	# In VMS protect with doublequotes because otherwise
 	# DCL will lowercase -- unless already doublequoted.
        $_ = q(").$_.q(") if $is_vms && !/^\"/ && length($_) > 0;
-       $runperl = $runperl . ' ' . $_;
+	$$runperl .= ' ' . $_;
     }
-    return $runperl;
 }
 
-sub _create_runperl { # Create the string to qx in runperl().
+sub runperl {
     my %args = @_;
-    my $runperl = which_perl();
-    if ($runperl =~ m/\s/) {
-        $runperl = qq{"$runperl"};
-    }
-    #- this allows, for example, to set PERL_RUNPERL_DEBUG=/usr/bin/valgrind
-    if ($ENV{PERL_RUNPERL_DEBUG}) {
-	$runperl = "$ENV{PERL_RUNPERL_DEBUG} $runperl";
-    }
+    my $runperl = $^X;
     unless ($args{nolib}) {
-	$runperl = $runperl . ' "-I../lib"'; # doublequotes because of VMS
+	if ($is_macos) {
+	    $runperl .= ' -I::lib';
+	    # Use UNIX style error messages instead of MPW style.
+	    $runperl .= ' -MMac::err=unix' if $args{stderr};
+	}
+	else {
+	    $runperl .= ' "-I../lib"'; # doublequotes because of VMS
+	}
     }
     if ($args{switches}) {
-	local $Level = 2;
-	die "test.pl:runperl(): 'switches' must be an ARRAYREF " . _where()
-	    unless ref $args{switches} eq "ARRAY";
-	$runperl = _quote_args($runperl, $args{switches});
+	_quote_args(\$runperl, $args{switches});
     }
     if (defined $args{prog}) {
-	die "test.pl:runperl(): both 'prog' and 'progs' cannot be used " . _where()
-	    if defined $args{progs};
         $args{progs} = [$args{prog}]
     }
     if (defined $args{progs}) {
-	die "test.pl:runperl(): 'progs' must be an ARRAYREF " . _where()
-	    unless ref $args{progs} eq "ARRAY";
         foreach my $prog (@{$args{progs}}) {
-	    if (!$args{non_portable}) {
-		if ($prog =~ tr/'"//) {
-		    warn "quotes in prog >>$prog<< are not portable";
-		}
-		if ($prog =~ /^([<>|]|2>)/) {
-		    warn "Initial $1 in prog >>$prog<< is not portable";
-		}
-		if ($prog =~ /&\z/) {
-		    warn "Trailing & in prog >>$prog<< is not portable";
-		}
-	    }
             if ($is_mswin || $is_netware || $is_vms) {
-                $runperl = $runperl . qq ( -e "$prog" );
+                $runperl .= qq ( -e "$prog" );
             }
             else {
-                $runperl = $runperl . qq ( -e '$prog' );
+                $runperl .= qq ( -e '$prog' );
             }
         }
     } elsif (defined $args{progfile}) {
-	$runperl = $runperl . qq( "$args{progfile}");
-    } else {
-	# You probably didn't want to be sucking in from the upstream stdin
-	die "test.pl:runperl(): none of prog, progs, progfile, args, "
-	    . " switches or stdin specified"
-	    unless defined $args{args} or defined $args{switches}
-		or defined $args{stdin};
+	$runperl .= qq( "$args{progfile}");
     }
     if (defined $args{stdin}) {
 	# so we don't try to put literal newlines and crs onto the
@@ -648,133 +384,76 @@ sub _create_runperl { # Create the string to qx in runperl().
 	$args{stdin} =~ s/\r/\\r/g;
 
 	if ($is_mswin || $is_netware || $is_vms) {
-	    $runperl = qq{$Perl -e "print qq(} .
+	    $runperl = qq{$^X -e "print qq(} .
 		$args{stdin} . q{)" | } . $runperl;
 	}
+	elsif ($is_macos) {
+	    # MacOS can only do two processes under MPW at once;
+	    # the test itself is one; we can't do two more, so
+	    # write to temp file
+	    my $stdin = qq{$^X -e 'print qq(} . $args{stdin} . qq{)' > teststdin; };
+	    if ($args{verbose}) {
+		my $stdindisplay = $stdin;
+		$stdindisplay =~ s/\n/\n\#/g;
+		print STDERR "# $stdindisplay\n";
+	    }
+	    `$stdin`;
+	    $runperl .= q{ < teststdin };
+	}
 	else {
-	    $runperl = qq{$Perl -e 'print qq(} .
+	    $runperl = qq{$^X -e 'print qq(} .
 		$args{stdin} . q{)' | } . $runperl;
 	}
-    } elsif (exists $args{stdin}) {
-        # Using the pipe construction above can cause fun on systems which use
-        # ksh as /bin/sh, as ksh does pipes differently (with one less process)
-        # With sh, for the command line 'perl -e 'print qq()' | perl -e ...'
-        # the sh process forks two children, which use exec to start the two
-        # perl processes. The parent shell process persists for the duration of
-        # the pipeline, and the second perl process starts with no children.
-        # With ksh (and zsh), the shell saves a process by forking a child for
-        # just the first perl process, and execing itself to start the second.
-        # This means that the second perl process starts with one child which
-        # it didn't create. This causes "fun" when if the tests assume that
-        # wait (or waitpid) will only return information about processes
-        # started within the test.
-        # They also cause fun on VMS, where the pipe implementation returns
-        # the exit code of the process at the front of the pipeline, not the
-        # end. This messes up any test using OPTION FATAL.
-        # Hence it's useful to have a way to make STDIN be at eof without
-        # needing a pipeline, so that the fork tests have a sane environment
-        # without these surprises.
-
-        # /dev/null appears to be surprisingly portable.
-        $runperl = $runperl . ($is_mswin ? ' <nul' : ' </dev/null');
     }
     if (defined $args{args}) {
-	$runperl = _quote_args($runperl, $args{args});
-    }
-    if (exists $args{stderr} && $args{stderr} eq 'devnull') {
-        $runperl = $runperl . ($is_mswin ? ' 2>nul' : ' 2>/dev/null');
-    }
-    elsif ($args{stderr}) {
-        $runperl = $runperl . ' 2>&1';
+	_quote_args(\$runperl, $args{args});
     }
+    $runperl .= ' 2>&1'          if  $args{stderr} && !$is_macos;
+    $runperl .= " \xB3 Dev:Null" if !$args{stderr} &&  $is_macos;
     if ($args{verbose}) {
 	my $runperldisplay = $runperl;
 	$runperldisplay =~ s/\n/\n\#/g;
-	_print_stderr "# $runperldisplay\n";
+	print STDERR "# $runperldisplay\n";
     }
-    return $runperl;
-}
-
-sub runperl {
-    die "test.pl:runperl() does not take a hashref"
-	if ref $_[0] and ref $_[0] eq 'HASH';
-    my $runperl = &_create_runperl;
-    my $result;
-
-    my $tainted = ${^TAINT};
-    my %args = @_;
-    exists $args{switches} && grep m/^-T$/, @{$args{switches}} and $tainted = $tainted + 1;
-
-    if ($tainted) {
-	# We will assume that if you're running under -T, you really mean to
-	# run a fresh perl, so we'll brute force launder everything for you
-	my $sep;
-
-	if (! eval {require Config; 1}) {
-	    warn "test.pl had problems loading Config: $@";
-	    $sep = ':';
-	} else {
-	    $sep = $Config::Config{path_sep};
-	}
-
-	my @keys = grep {exists $ENV{$_}} qw(CDPATH IFS ENV BASH_ENV);
-	local @ENV{@keys} = ();
-	# Untaint, plus take out . and empty string:
-	local $ENV{'DCL$PATH'} = $1 if $is_vms && exists($ENV{'DCL$PATH'}) && ($ENV{'DCL$PATH'} =~ /(.*)/s);
-	$ENV{PATH} =~ /(.*)/s;
-	local $ENV{PATH} =
-	    join $sep, grep { $_ ne "" and $_ ne "." and -d $_ and
-		($is_mswin or $is_vms or !(stat && (stat _)[2]&0022)) }
-		    split quotemeta ($sep), $1;
-	if ($is_cygwin) {   # Must have /bin under Cygwin
-	    if (length $ENV{PATH}) {
-		$ENV{PATH} = $ENV{PATH} . $sep;
-	    }
-	    $ENV{PATH} = $ENV{PATH} . '/bin';
-	}
-	$runperl =~ /(.*)/s;
-	$runperl = $1;
-
-	$result = `$runperl`;
-    } else {
-	$result = `$runperl`;
-    }
-    $result =~ s/\n\n/\n/g if $is_vms; # XXX pipes sometimes double these
+    my $result = `$runperl`;
+    $result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
     return $result;
 }
 
-# Nice alias
-*run_perl = *run_perl = \&runperl; # shut up "used only once" warning
+*run_perl = \&runperl; # Nice alias.
 
 sub DIE {
-    _print_stderr "# @_\n";
+    print STDERR "# @_\n";
     exit 1;
 }
 
 # A somewhat safer version of the sometimes wrong $^X.
+my $Perl;
 sub which_perl {
     unless (defined $Perl) {
 	$Perl = $^X;
-
+	
 	# VMS should have 'perl' aliased properly
-	return $Perl if $is_vms;
+	return $Perl if $^O eq 'VMS';
 
 	my $exe;
-	if (! eval {require Config; 1}) {
+	eval "require Config; Config->import";
+	if ($@) {
 	    warn "test.pl had problems loading Config: $@";
 	    $exe = '';
 	} else {
-	    $exe = $Config::Config{_exe};
+	    $exe = $Config{_exe};
 	}
        $exe = '' unless defined $exe;
-
+	
 	# This doesn't absolutize the path: beware of future chdirs().
 	# We could do File::Spec->abs2rel() but that does getcwd()s,
 	# which is a bit heavyweight to do here.
-
+	
 	if ($Perl =~ /^perl\Q$exe\E$/i) {
 	    my $perl = "perl$exe";
-	    if (! eval {require File::Spec; 1}) {
+	    eval "require File::Spec";
+	    if ($@) {
 		warn "test.pl had problems loading File::Spec: $@";
 		$Perl = "./$perl";
 	    } else {
@@ -786,11 +465,11 @@ sub which_perl {
 	# the command.
 
 	if ($Perl !~ /\Q$exe\E$/i) {
-	    $Perl = $Perl . $exe;
+	    $Perl .= $exe;
 	}
 
 	warn "which_perl: cannot find $Perl from $^X" unless -f $Perl;
-
+	
 	# For subcommands to use.
 	$ENV{PERLEXE} = $Perl;
     }
@@ -798,139 +477,59 @@ sub which_perl {
 }
 
 sub unlink_all {
-    my $count = 0;
     foreach my $file (@_) {
         1 while unlink $file;
-	if( -f $file ){
-	    _print_stderr "# Couldn't unlink '$file': $!\n";
-	}else{
-	    ++$count;
-	}
+        print STDERR "# Couldn't unlink '$file': $!\n" if -f $file;
     }
-    $count;
 }
 
-# _num_to_alpha - Returns a string of letters representing a positive integer.
-# Arguments :
-#   number to convert
-#   maximum number of letters
-
-# returns undef if the number is negative
-# returns undef if the number of letters is greater than the maximum wanted
-
-# _num_to_alpha( 0) eq 'A';
-# _num_to_alpha( 1) eq 'B';
-# _num_to_alpha(25) eq 'Z';
-# _num_to_alpha(26) eq 'AA';
-# _num_to_alpha(27) eq 'AB';
-
-my @letters = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z);
-
-# Avoid ++ -- ranges split negative numbers
-sub _num_to_alpha{
-    my($num,$max_char) = @_;
-    return unless $num >= 0;
-    my $alpha = '';
-    my $char_count = 0;
-    $max_char = 0 if $max_char < 0;
-
-    while( 1 ){
-        $alpha = $letters[ $num % 26 ] . $alpha;
-        $num = int( $num / 26 );
-        last if $num == 0;
-        $num = $num - 1;
-
-        # char limit
-        next unless $max_char;
-        $char_count = $char_count + 1;
-        return if $char_count == $max_char;
-    }
-    return $alpha;
-}
 
-my %tmpfiles;
-END { unlink_all keys %tmpfiles }
-
-# A regexp that matches the tempfile names
-$::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
-
-# Avoid ++, avoid ranges, avoid split //
-my $tempfile_count = 0;
-sub tempfile {
-    while(1){
-	my $try = "tmp$$";
-        my $alpha = _num_to_alpha($tempfile_count,2);
-        last unless defined $alpha;
-        $try = $try . $alpha;
-        $tempfile_count = $tempfile_count + 1;
-
-	# Need to note all the file names we allocated, as a second request may
-	# come before the first is created.
-	if (!$tmpfiles{$try} && !-e $try) {
-	    # We have a winner
-	    $tmpfiles{$try} = 1;
-	    return $try;
-	}
-    }
-    die "Can't find temporary file name starting \"tmp$$\"";
-}
+my $tmpfile = "misctmp000";
+1 while -f ++$tmpfile;
+END { unlink_all $tmpfile }
 
-# register_tempfile - Adds a list of files to be removed at the end of the current test file
-# Arguments :
-#   a list of files to be removed later
+#
+# _fresh_perl
+#
+# The $resolve must be a subref that tests the first argument
+# for success, or returns the definition of success (e.g. the
+# expected scalar) if given no arguments.
+#
 
-# returns a count of how many file names were actually added
+sub _fresh_perl {
+    my($prog, $resolve, $runperl_args, $name) = @_;
 
-# Reuses %tmpfiles so that tempfile() will also skip any files added here
-# even if the file doesn't exist yet.
+    $runperl_args ||= {};
+    $runperl_args->{progfile} = $tmpfile;
+    $runperl_args->{stderr} = 1;
 
-sub register_tempfile {
-    my $count = 0;
-    for( @_ ){
-	if( $tmpfiles{$_} ){
-	    _print_stderr "# Temporary file '$_' already added\n";
-	}else{
-	    $tmpfiles{$_} = 1;
-	    $count = $count + 1;
-	}
-    }
-    return $count;
-}
+    open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
 
-# This is the temporary file for _fresh_perl
-my $tmpfile = tempfile();
+    # VMS adjustments
+    if( $^O eq 'VMS' ) {
+        $prog =~ s#/dev/null#NL:#;
 
-sub _fresh_perl {
-    my($prog, $action, $expect, $runperl_args, $name) = @_;
-
-    # Given the choice of the mis-parsable {}
-    # (we want an anon hash, but a borked lexer might think that it's a block)
-    # or relying on taking a reference to a lexical
-    # (\ might be mis-parsed, and the reference counting on the pad may go
-    #  awry)
-    # it feels like the least-worse thing is to assume that auto-vivification
-    # works. At least, this is only going to be a run-time failure, so won't
-    # affect tests using this file but not this function.
-    $runperl_args->{progfile} ||= $tmpfile;
-    $runperl_args->{stderr}     = 1 unless exists $runperl_args->{stderr};
+        # VMS file locking 
+        $prog =~ s{if \(-e _ and -f _ and -r _\)}
+                  {if (-e _ and -f _)}
+    }
 
-    open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
-    print TEST $prog;
+    print TEST $prog, "\n";
     close TEST or die "Cannot close $tmpfile: $!";
 
     my $results = runperl(%$runperl_args);
     my $status = $?;
 
     # Clean up the results into something a bit more predictable.
-    $results  =~ s/\n+$//;
-    $results =~ s/at\s+$::tempfile_regexp\s+line/at - line/g;
-    $results =~ s/of\s+$::tempfile_regexp\s+aborted/of - aborted/g;
+    $results =~ s/\n+$//;
+    $results =~ s/at\s+misctmp\d+\s+line/at - line/g;
+    $results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g;
 
     # bison says 'parse error' instead of 'syntax error',
     # various yaccs may or may not capitalize 'syntax'.
     $results =~ s/^(syntax|parse) error/syntax error/mig;
 
-    if ($is_vms) {
+    if ($^O eq 'VMS') {
         # some tests will trigger VMS messages that won't be expected
         $results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
 
@@ -938,771 +537,49 @@ sub _fresh_perl {
         $results =~ s/\n\n/\n/g;
     }
 
-    # Use the first line of the program as a name if none was given
-    unless( $name ) {
-        ($first_line, $name) = $prog =~ /^((.{1,50}).*)/;
-        $name = $name . '...' if length $first_line > length $name;
-    }
-
-    # Historically this was implemented using a closure, but then that means
-    # that the tests for closures avoid using this code. Given that there
-    # are exactly two callers, doing exactly two things, the simpler approach
-    # feels like a better trade off.
-    my $pass;
-    if ($action eq 'eq') {
-	$pass = is($results, $expect, $name);
-    } elsif ($action eq '=~') {
-	$pass = like($results, $expect, $name);
-    } else {
-	die "_fresh_perl can't process action '$action'";
-    }
-	
+    my $pass = $resolve->($results);
     unless ($pass) {
         _diag "# PROG: \n$prog\n";
+        _diag "# EXPECTED:\n", $resolve->(), "\n";
+        _diag "# GOT:\n$results\n";
         _diag "# STATUS: $status\n";
     }
 
-    return $pass;
+    # Use the first line of the program as a name if none was given
+    unless( $name ) {
+        ($first_line, $name) = $prog =~ /^((.{1,50}).*)/;
+        $name .= '...' if length $first_line > length $name;
+    }
+
+    _ok($pass, _where(), "fresh_perl - $name");
 }
 
 #
-# fresh_perl_is
+# run_perl_is
 #
 # Combination of run_perl() and is().
 #
 
 sub fresh_perl_is {
     my($prog, $expected, $runperl_args, $name) = @_;
-
-    # _fresh_perl() is going to clip the trailing newlines off the result.
-    # This will make it so the test author doesn't have to know that.
-    $expected =~ s/\n+$//;
-
-    local $Level = 2;
-    _fresh_perl($prog, 'eq', $expected, $runperl_args, $name);
+    _fresh_perl($prog,
+		sub { @_ ? $_[0] eq $expected : $expected },
+		$runperl_args, $name);
 }
 
 #
-# fresh_perl_like
+# run_perl_like
 #
 # Combination of run_perl() and like().
 #
 
 sub fresh_perl_like {
     my($prog, $expected, $runperl_args, $name) = @_;
-    local $Level = 2;
-    _fresh_perl($prog, '=~', $expected, $runperl_args, $name);
-}
-
-# Many tests use the same format in __DATA__ or external files to specify a
-# sequence of (fresh) tests to run, extra files they may temporarily need, and
-# what the expected output is.  Putting it here allows common code to serve
-# these multiple tests.
-#
-# Each program is source code to run followed by an "EXPECT" line, followed
-# by the expected output.
-#
-# The code to run may begin with a command line switch such as -w or -0777
-# (alphanumerics only), and may contain (note the '# ' on each):
-#   # TODO reason for todo
-#   # SKIP reason for skip
-#   # SKIP ?code to test if this should be skipped
-#   # NAME name of the test (as with ok($ok, $name))
-#
-# The expected output may contain:
-#   OPTION list of options
-#   OPTIONS list of options
-#
-# The possible options for OPTION may be:
-#   regex - the expected output is a regular expression
-#   random - all lines match but in any order
-#   fatal - the code will fail fatally (croak, die)
-#
-# If the actual output contains a line "SKIPPED" the test will be
-# skipped.
-#
-# If the actual output contains a line "PREFIX", any output starting with that
-# line will be ignored when comparing with the expected output
-#
-# If the global variable $FATAL is true then OPTION fatal is the
-# default.
-
-sub _setup_one_file {
-    my $fh = shift;
-    # Store the filename as a program that started at line 0.
-    # Real files count lines starting at line 1.
-    my @these = (0, shift);
-    my ($lineno, $current);
-    while (<$fh>) {
-        if ($_ eq "########\n") {
-            if (defined $current) {
-                push @these, $lineno, $current;
-            }
-            undef $current;
-        } else {
-            if (!defined $current) {
-                $lineno = $.;
-            }
-            $current .= $_;
-        }
-    }
-    if (defined $current) {
-        push @these, $lineno, $current;
-    }
-    ((scalar @these) / 2 - 1, @these);
-}
-
-sub setup_multiple_progs {
-    my ($tests, @prgs);
-    foreach my $file (@_) {
-        next if $file =~ /(?:~|\.orig|,v)$/;
-        next if $file =~ /perlio$/ && !PerlIO::Layer->find('perlio');
-        next if -d $file;
-
-        open my $fh, '<', $file or die "Cannot open $file: $!\n" ;
-        my $found;
-        while (<$fh>) {
-            if (/^__END__/) {
-                ++$found;
-                last;
-            }
-        }
-        # This is an internal error, and should never happen. All bar one of
-        # the files had an __END__ marker to signal the end of their preamble,
-        # although for some it wasn't technically necessary as they have no
-        # tests. It might be possible to process files without an __END__ by
-        # seeking back to the start and treating the whole file as tests, but
-        # it's simpler and more reliable just to make the rule that all files
-        # must have __END__ in. This should never fail - a file without an
-        # __END__ should not have been checked in, because the regression tests
-        # would not have passed.
-        die "Could not find '__END__' in $file"
-            unless $found;
-
-        my ($t, @p) = _setup_one_file($fh, $file);
-        $tests += $t;
-        push @prgs, @p;
-
-        close $fh
-            or die "Cannot close $file: $!\n";
-    }
-    return ($tests, @prgs);
-}
-
-sub run_multiple_progs {
-    my $up = shift;
-    my @prgs;
-    if ($up) {
-	# The tests in lib run in a temporary subdirectory of t, and always
-	# pass in a list of "programs" to run
-	@prgs = @_;
-    } else {
-        # The tests below t run in t and pass in a file handle. In theory we
-        # can pass (caller)[1] as the second argument to report errors with
-        # the filename of our caller, as the handle is always DATA. However,
-        # line numbers in DATA count from the __END__ token, so will be wrong.
-        # Which is more confusing than not providing line numbers. So, for now,
-        # don't provide line numbers. No obvious clean solution - one hack
-        # would be to seek DATA back to the start and read to the __END__ token,
-        # but that feels almost like we should just open $0 instead.
-
-        # Not going to rely on undef in list assignment.
-        my $dummy;
-        ($dummy, @prgs) = _setup_one_file(shift);
-    }
-
-    my $tmpfile = tempfile();
-
-    my ($file, $line);
-  PROGRAM:
-    while (defined ($line = shift @prgs)) {
-        $_ = shift @prgs;
-        unless ($line) {
-            $file = $_;
-            if (defined $file) {
-                print "# From $file\n";
-            }
-	    next;
-	}
-	my $switch = "";
-	my @temps ;
-	my @temp_path;
-	if (s/^(\s*-\w+)//) {
-	    $switch = $1;
-	}
-	my ($prog, $expected) = split(/\nEXPECT(?:\n|$)/, $_, 2);
-
-	my %reason;
-	foreach my $what (qw(skip todo)) {
-	    $prog =~ s/^#\s*\U$what\E\s*(.*)\n//m and $reason{$what} = $1;
-	    # If the SKIP reason starts ? then it's taken as a code snippet to
-	    # evaluate. This provides the flexibility to have conditional SKIPs
-	    if ($reason{$what} && $reason{$what} =~ s/^\?//) {
-		my $temp = eval $reason{$what};
-		if ($@) {
-		    die "# In \U$what\E code reason:\n# $reason{$what}\n$@";
-		}
-		$reason{$what} = $temp;
-	    }
-	}
-
-	my $name = '';
-	if ($prog =~ s/^#\s*NAME\s+(.+)\n//m) {
-	    $name = $1;
-	}
-
-	if ($reason{skip}) {
-	SKIP:
-	  {
-	    skip($name ? "$name - $reason{skip}" : $reason{skip}, 1);
-	  }
-	  next PROGRAM;
-	}
-
-	if ($prog =~ /--FILE--/) {
-	    my @files = split(/\n?--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
-	    shift @files ;
-	    die "Internal error: test $_ 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;
-		if ($filename =~ m#(.*)/# && $filename !~ m#^\.\./#) {
-		    require File::Path;
-		    File::Path::mkpath($1);
-		    push(@temp_path, $1);
-		}
-		open my $fh, '>', $filename or die "Cannot open $filename: $!\n";
-		print $fh $code;
-		close $fh or die "Cannot close $filename: $!\n";
-	    }
-	    shift @files;
-	    $prog = shift @files;
-	}
-
-	open my $fh, '>', $tmpfile or die "Cannot open >$tmpfile: $!";
-	print $fh q{
-        BEGIN {
-            open STDERR, '>&', STDOUT
-              or die "Can't dup STDOUT->STDERR: $!;";
-        }
-	};
-	print $fh "\n#line 1\n";  # So the line numbers don't get messed up.
-	print $fh $prog,"\n";
-	close $fh or die "Cannot close $tmpfile: $!";
-	my $results = runperl( stderr => 1, progfile => $tmpfile,
-			       stdin => undef, $up
-			       ? (switches => ["-I$up/lib", $switch], nolib => 1)
-			       : (switches => [$switch])
-			        );
-	my $status = $?;
-	$results =~ s/\n+$//;
-	# allow expected output to be written as if $prog is on STDIN
-	$results =~ s/$::tempfile_regexp/-/g;
-	if ($^O eq 'VMS') {
-	    # some tests will trigger VMS messages that won't be expected
-	    $results =~ s/\n?%[A-Z]+-[SIWEF]-[A-Z]+,.*//;
-
-	    # pipes double these sometimes
-	    $results =~ s/\n\n/\n/g;
-	}
-	# 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;
-	my $option_random = 0;
-	my $fatal = $FATAL;
-	if ($expected =~ s/^OPTIONS? (.+)\n//) {
-	    foreach my $option (split(' ', $1)) {
-		if ($option eq 'regex') { # allow regular expressions
-		    $option_regex = 1;
-		}
-		elsif ($option eq 'random') { # all lines match, but in any order
-		    $option_random = 1;
-		}
-		elsif ($option eq 'fatal') { # perl should fail
-		    $fatal = 1;
-		}
-		else {
-		    die "$0: Unknown OPTION '$option'\n";
-		}
-	    }
-	}
-	die "$0: can't have OPTION regex and random\n"
-	    if $option_regex + $option_random > 1;
-	my $ok = 0;
-	if ($results =~ s/^SKIPPED\n//) {
-	    print "$results\n" ;
-	    $ok = 1;
-	}
-	else {
-	    if ($option_random) {
-	        my @got = sort split "\n", $results;
-	        my @expected = sort split "\n", $expected;
-
-	        $ok = "@got" eq "@expected";
-	    }
-	    elsif ($option_regex) {
-	        $ok = $results =~ /^$expected/;
-	    }
-	    elsif ($prefix) {
-	        $ok = $results =~ /^\Q$expected/;
-	    }
-	    else {
-	        $ok = $results eq $expected;
-	    }
-
-	    if ($ok && $fatal && !($status >> 8)) {
-		$ok = 0;
-	    }
-	}
-
-	local $::TODO = $reason{todo};
-
-	unless ($ok) {
-	    my $err_line = "PROG: $switch\n$prog\n" .
-			   "EXPECTED:\n$expected\n";
-	    $err_line   .= "EXIT STATUS: != 0\n" if $fatal;
-	    $err_line   .= "GOT:\n$results\n";
-	    $err_line   .= "EXIT STATUS: " . ($status >> 8) . "\n" if $fatal;
-	    if ($::TODO) {
-		$err_line =~ s/^/# /mg;
-		print $err_line;  # Harness can't filter it out from STDERR.
-	    }
-	    else {
-		print STDERR $err_line;
-	    }
-	}
-
-        if (defined $file) {
-            _ok($ok, "at $file line $line", $name);
-        } else {
-            # We don't have file and line number data for the test, so report
-            # errors as coming from our caller.
-            local $Level = $Level + 1;
-            ok($ok, $name);
-        }
-
-	foreach (@temps) {
-	    unlink $_ if $_;
-	}
-	foreach (@temp_path) {
-	    File::Path::rmtree $_ if -d $_;
-	}
-    }
-}
-
-sub can_ok ($@) {
-    my($proto, @methods) = @_;
-    my $class = ref $proto || $proto;
-
-    unless( @methods ) {
-        return _ok( 0, _where(), "$class->can(...)" );
-    }
-
-    my @nok = ();
-    foreach my $method (@methods) {
-        local($!, $@);  # don't interfere with caller's $@
-                        # eval sometimes resets $!
-        eval { $proto->can($method) } || push @nok, $method;
-    }
-
-    my $name;
-    $name = @methods == 1 ? "$class->can('$methods[0]')"
-                          : "$class->can(...)";
-
-    _ok( !@nok, _where(), $name );
-}
-
-
-# Call $class->new( @$args ); and run the result through object_ok.
-# See Test::More::new_ok
-sub new_ok {
-    my($class, $args, $obj_name) = @_;
-    $args ||= [];
-    $object_name = "The object" unless defined $obj_name;
-
-    local $Level = $Level + 1;
-
-    my $obj;
-    my $ok = eval { $obj = $class->new(@$args); 1 };
-    my $error = $@;
-
-    if($ok) {
-        object_ok($obj, $class, $object_name);
-    }
-    else {
-        ok( 0, "new() died" );
-        diag("Error was:  $@");
-    }
-
-    return $obj;
-
-}
-
-
-sub isa_ok ($$;$) {
-    my($object, $class, $obj_name) = @_;
-
-    my $diag;
-    $obj_name = 'The object' unless defined $obj_name;
-    my $name = "$obj_name isa $class";
-    if( !defined $object ) {
-        $diag = "$obj_name isn't defined";
-    }
-    else {
-        my $whatami = ref $object ? 'object' : 'class';
-
-        # We can't use UNIVERSAL::isa because we want to honor isa() overrides
-        local($@, $!);  # eval sometimes resets $!
-        my $rslt = eval { $object->isa($class) };
-        my $error = $@;  # in case something else blows away $@
-
-        if( $error ) {
-            if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
-                # It's an unblessed reference
-                $obj_name = 'The reference' unless defined $obj_name;
-                if( !UNIVERSAL::isa($object, $class) ) {
-                    my $ref = ref $object;
-                    $diag = "$obj_name isn't a '$class' it's a '$ref'";
-                }
-            }
-            elsif( $error =~ /Can't call method "isa" without a package/ ) {
-                # It's something that can't even be a class
-                $obj_name = 'The thing' unless defined $obj_name;
-                $diag = "$obj_name isn't a class or reference";
-            }
-            else {
-                die <<WHOA;
-WHOA! I tried to call ->isa on your object and got some weird error.
-This should never happen.  Please contact the author immediately.
-Here's the error.
-$@
-WHOA
-            }
-        }
-        elsif( !$rslt ) {
-            $obj_name = "The $whatami" unless defined $obj_name;
-            my $ref = ref $object;
-            $diag = "$obj_name isn't a '$class' it's a '$ref'";
-        }
-    }
-
-    _ok( !$diag, _where(), $name );
-}
-
-
-sub class_ok {
-    my($class, $isa, $class_name) = @_;
-
-    # Written so as to count as one test
-    local $Level = $Level + 1;
-    if( ref $class ) {
-        ok( 0, "$class is a refrence, not a class name" );
-    }
-    else {
-        isa_ok($class, $isa, $class_name);
-    }
-}
-
-
-sub object_ok {
-    my($obj, $isa, $obj_name) = @_;
-
-    local $Level = $Level + 1;
-    if( !ref $obj ) {
-        ok( 0, "$obj is not a reference" );
-    }
-    else {
-        isa_ok($obj, $isa, $obj_name);
-    }
-}
-
-
-# Purposefully avoiding a closure.
-sub __capture {
-    push @::__capture, join "", @_;
-}
-    
-sub capture_warnings {
-    my $code = shift;
-
-    local @::__capture;
-    local $SIG {__WARN__} = \&__capture;
-    &$code;
-    return @::__capture;
-}
-
-# This will generate a variable number of tests.
-# Use done_testing() instead of a fixed plan.
-sub warnings_like {
-    my ($code, $expect, $name) = @_;
-    local $Level = $Level + 1;
-
-    my @w = capture_warnings($code);
-
-    cmp_ok(scalar @w, '==', scalar @$expect, $name);
-    foreach my $e (@$expect) {
-	if (ref $e) {
-	    like(shift @w, $e, $name);
-	} else {
-	    is(shift @w, $e, $name);
-	}
-    }
-    if (@w) {
-	diag("Saw these additional warnings:");
-	diag($_) foreach @w;
-    }
-}
-
-sub _fail_excess_warnings {
-    my($expect, $got, $name) = @_;
-    local $Level = $Level + 1;
-    # This will fail, and produce diagnostics
-    is($expect, scalar @$got, $name);
-    diag("Saw these warnings:");
-    diag($_) foreach @$got;
-}
-
-sub warning_is {
-    my ($code, $expect, $name) = @_;
-    die sprintf "Expect must be a string or undef, not a %s reference", ref $expect
-	if ref $expect;
-    local $Level = $Level + 1;
-    my @w = capture_warnings($code);
-    if (@w > 1) {
-	_fail_excess_warnings(0 + defined $expect, \@w, $name);
-    } else {
-	is($w[0], $expect, $name);
-    }
-}
-
-sub warning_like {
-    my ($code, $expect, $name) = @_;
-    die sprintf "Expect must be a regexp object"
-	unless ref $expect eq 'Regexp';
-    local $Level = $Level + 1;
-    my @w = capture_warnings($code);
-    if (@w > 1) {
-	_fail_excess_warnings(0 + defined $expect, \@w, $name);
-    } else {
-	like($w[0], $expect, $name);
-    }
-}
-
-# Set a watchdog to timeout the entire test file
-# NOTE:  If the test file uses 'threads', then call the watchdog() function
-#        _AFTER_ the 'threads' module is loaded.
-sub watchdog ($;$)
-{
-    my $timeout = shift;
-    my $method  = shift || "";
-    my $timeout_msg = 'Test process timed out - terminating';
-
-    # Valgrind slows perl way down so give it more time before dying.
-    $timeout *= 10 if $ENV{PERL_VALGRIND};
-
-    my $pid_to_kill = $$;   # PID for this process
-
-    if ($method eq "alarm") {
-        goto WATCHDOG_VIA_ALARM;
-    }
-
-    # shut up use only once warning
-    my $threads_on = $threads::threads && $threads::threads;
-
-    # Don't use a watchdog process if 'threads' is loaded -
-    #   use a watchdog thread instead
-    if (!$threads_on || $method eq "process") {
-
-        # On Windows and VMS, try launching a watchdog process
-        #   using system(1, ...) (see perlport.pod)
-        if ($is_mswin || $is_vms) {
-            # On Windows, try to get the 'real' PID
-            if ($is_mswin) {
-                eval { require Win32; };
-                if (defined(&Win32::GetCurrentProcessId)) {
-                    $pid_to_kill = Win32::GetCurrentProcessId();
-                }
-            }
-
-            # If we still have a fake PID, we can't use this method at all
-            return if ($pid_to_kill <= 0);
-
-            # Launch watchdog process
-            my $watchdog;
-            eval {
-                local $SIG{'__WARN__'} = sub {
-                    _diag("Watchdog warning: $_[0]");
-                };
-                my $sig = $is_vms ? 'TERM' : 'KILL';
-                my $cmd = _create_runperl( prog =>  "sleep($timeout);" .
-                                                    "warn qq/# $timeout_msg" . '\n/;' .
-                                                    "kill($sig, $pid_to_kill);");
-                $watchdog = system(1, $cmd);
-            };
-            if ($@ || ($watchdog <= 0)) {
-                _diag('Failed to start watchdog');
-                _diag($@) if $@;
-                undef($watchdog);
-                return;
-            }
-
-            # Add END block to parent to terminate and
-            #   clean up watchdog process
-            # Win32 watchdog is launched by cmd.exe shell, so use process group
-            # kill, otherwise the watchdog is never killed and harness waits
-            # every time for the timeout, #121395
-            eval( $is_mswin ?
-            "END { local \$! = 0; local \$? = 0;
-                        wait() if kill('-KILL', $watchdog); };"
-            : "END { local \$! = 0; local \$? = 0;
-                        wait() if kill('KILL', $watchdog); };");
-            return;
-        }
-
-        # Try using fork() to generate a watchdog process
-        my $watchdog;
-        eval { $watchdog = fork() };
-        if (defined($watchdog)) {
-            if ($watchdog) {   # Parent process
-                # Add END block to parent to terminate and
-                #   clean up watchdog process
-                eval "END { local \$! = 0; local \$? = 0;
-                            wait() if kill('KILL', $watchdog); };";
-                return;
-            }
-
-            ### Watchdog process code
-
-            # Load POSIX if available
-            eval { require POSIX; };
-
-            # Execute the timeout
-            sleep($timeout - 2) if ($timeout > 2);   # Workaround for perlbug #49073
-            sleep(2);
-
-            # Kill test process if still running
-            if (kill(0, $pid_to_kill)) {
-                _diag($timeout_msg);
-                kill('KILL', $pid_to_kill);
-		if ($is_cygwin) {
-		    # sometimes the above isn't enough on cygwin
-		    sleep 1; # wait a little, it might have worked after all
-		    system("/bin/kill -f $pid_to_kill");
-		}
-            }
-
-            # Don't execute END block (added at beginning of this file)
-            $NO_ENDING = 1;
-
-            # Terminate ourself (i.e., the watchdog)
-            POSIX::_exit(1) if (defined(&POSIX::_exit));
-            exit(1);
-        }
-
-        # fork() failed - fall through and try using a thread
-    }
-
-    # Use a watchdog thread because either 'threads' is loaded,
-    #   or fork() failed
-    if (eval {require threads; 1}) {
-        'threads'->create(sub {
-                # Load POSIX if available
-                eval { require POSIX; };
-
-                # Execute the timeout
-                my $time_left = $timeout;
-                do {
-                    $time_left = $time_left - sleep($time_left);
-                } while ($time_left > 0);
-
-                # Kill the parent (and ourself)
-                select(STDERR); $| = 1;
-                _diag($timeout_msg);
-                POSIX::_exit(1) if (defined(&POSIX::_exit));
-                my $sig = $is_vms ? 'TERM' : 'KILL';
-                kill($sig, $pid_to_kill);
-            })->detach();
-        return;
-    }
-
-    # If everything above fails, then just use an alarm timeout
-WATCHDOG_VIA_ALARM:
-    if (eval { alarm($timeout); 1; }) {
-        # Load POSIX if available
-        eval { require POSIX; };
-
-        # Alarm handler will do the actual 'killing'
-        $SIG{'ALRM'} = sub {
-            select(STDERR); $| = 1;
-            _diag($timeout_msg);
-            POSIX::_exit(1) if (defined(&POSIX::_exit));
-            my $sig = $is_vms ? 'TERM' : 'KILL';
-            kill($sig, $pid_to_kill);
-        };
-    }
-}
-
-# The following 2 functions allow tests to work on both EBCDIC and
-# ASCII-ish platforms.  They convert string scalars between the native
-# character set and the set of 256 characters which is usually called
-# Latin1.
-
-sub native_to_latin1($) {
-    my $string = shift;
-
-    return $string if ord('^') == 94;   # ASCII, Latin1
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(ord_native_to_latin1(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
-sub latin1_to_native($) {
-    my $string = shift;
-
-    return $string if ord('^') == 94;   # ASCII, Latin1
-    my $output = "";
-    for my $i (0 .. length($string) - 1) {
-        $output .= chr(ord_latin1_to_native(ord(substr($string, $i, 1))));
-    }
-    # Preserve utf8ness of input onto the output, even if it didn't need to be
-    # utf8
-    utf8::upgrade($output) if utf8::is_utf8($string);
-
-    return $output;
-}
-
-sub ord_latin1_to_native {
-    # given an input code point, return the platform's native
-    # equivalent value.  Anything above latin1 is itself.
-
-    my $ord = shift;
-    return $ord if ord('^') == 94;   # ASCII, Latin1
-    return utf8::unicode_to_native($ord);
-}
-
-sub ord_native_to_latin1 {
-    # given an input platform code point, return the latin1 equivalent value.
-    # Anything above latin1 is itself.
-
-    my $ord = shift;
-    return $ord if ord('^') == 94;   # ASCII, Latin1
-    return utf8::native_to_unicode($ord);
+    _fresh_perl($prog,
+		sub { @_ ?
+			  $_[0] =~ (ref $expected ? $expected : /$expected/) :
+		          $expected },
+		$runperl_args, $name);
 }
 
 1;
diff --git a/gnu/usr.bin/perl/t/uni/case.pl b/gnu/usr.bin/perl/t/uni/case.pl
index 08df6706db9..b6df5a8089b 100644
--- a/gnu/usr.bin/perl/t/uni/case.pl
+++ b/gnu/usr.bin/perl/t/uni/case.pl
@@ -1,70 +1,40 @@
+use File::Spec;
+
 require "test.pl";
-use strict;
-use warnings;
 
 sub unidump {
     join " ", map { sprintf "%04X", $_ } unpack "U*", $_[0];
 }
 
 sub casetest {
-    my ($already_run, $base, @funcs) = @_;
-
-    my %spec;
-
-    # For each provided function run it, and run a version with some extra
-    # characters afterwards. Use a recycling symbol, as it doesn't change case.
-    # $already_run is the number of extra tests the caller has run before this
-    # call.
-    my $ballast = chr (0x2672) x 3;
-    @funcs = map {my $f = $_;
-		  ($f,
-		   sub {my $r = $f->($_[0] . $ballast); # Add it before
-			$r =~ s/$ballast\z//so # Remove it afterwards
-			    or die "'$_[0]' to '$r' mangled";
-			$r; # Result with $ballast removed.
-		    },
-		   )} @funcs;
-
-    use Unicode::UCD 'prop_invmap';
-
-    # Get the case mappings
-    my ($invlist_ref, $invmap_ref, undef, $default) = prop_invmap($base);
+    my ($base, $spec, $func) = @_;
+    my $file = File::Spec->catfile(File::Spec->catdir(File::Spec->updir,
+						      "lib", "unicore", "To"),
+				   "$base.pl");
+    my $simple = do $file;
     my %simple;
-
-    for my $i (0 .. @$invlist_ref - 1 - 1) {
-        next if $invmap_ref->[$i] == $default;
-
-        # Add simple mappings to the simples test list
-        if (! ref $invmap_ref->[$i]) {
-
-            # The returned map needs to have adjustments made.  Each
-            # subsequent element of the range requires adjustment of +1 from
-            # the previous element
-            my $adjust = 0;
-            for my $k ($invlist_ref->[$i] .. $invlist_ref->[$i+1] - 1) {
-                $simple{$k} = $invmap_ref->[$i] + $adjust++;
-            }
-        }
-        else {  # The return is a list of the characters mapped-to.
-                # prop_invmap() guarantees a single element in the range in
-                # this case, so no adjustments are needed.
-            $spec{$invlist_ref->[$i]} = pack "U0U*" , @{$invmap_ref->[$i]};
-        }
+    for my $i (split(/\n/, $simple)) {
+	my ($k, $v) = split(' ', $i);
+	$simple{$k} = $v;
     }
-
     my %seen;
 
     for my $i (sort keys %simple) {
-	$seen{$i}++;
+	$seen{hex $i}++;
     }
     print "# ", scalar keys %simple, " simple mappings\n";
 
-    for my $i (sort keys %spec) {
-	if (++$seen{$i} == 2) {
-	    warn sprintf "$base: $i seen twice\n";
+    my $both;
+
+    for my $i (sort keys %$spec) {
+	if (++$seen{hex $i} == 2) {
+	    warn "$base: $i seen twice\n";
+	    $both++;
 	}
     }
-    print "# ", scalar keys %spec, " special mappings\n";
+    print "# ", scalar keys %$spec, " special mappings\n";
+
+    exit(1) if $both;
 
     my %none;
     for my $i (map { ord } split //,
@@ -75,45 +45,90 @@ sub casetest {
     print "# ", scalar keys %none, " noncase mappings\n";
 
     my $tests = 
-        $already_run +
-	((scalar keys %simple) +
-	 (scalar keys %spec) +
-	 (scalar keys %none)) * @funcs;
+	(scalar keys %simple) +
+	(scalar keys %$spec) +
+	(scalar keys %none);
+    print "1..$tests\n";
 
-    my $test = $already_run + 1;
+    my $test = 1;
 
-    for my $i (sort keys %simple) {
+    for my $i (sort { hex $a <=> hex $b } keys %simple) {
 	my $w = $simple{$i};
-	my $c = pack "U0U", $i;
-	foreach my $func (@funcs) {
-	    my $d = $func->($c);
-	    my $e = unidump($d);
-	    is( $d, pack("U0U", $simple{$i}), "$i -> $e ($w)" );
-	}
+	my $c = pack "U0U", hex $i;
+	my $d = $func->($c);
+	my $e = unidump($d);
+	print $d eq pack("U0U", hex $simple{$i}) ?
+	    "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n";
+	$test++;
     }
 
-    for my $i (sort keys %spec) {
-	my $w = unidump($spec{$i});
-	my $h = sprintf "%04X", $i;
-	my $c = chr($i); $c .= chr(0x100); chop $c;
-	foreach my $func (@funcs) {
-	    my $d = $func->($c);
-	    my $e = unidump($d);
-            is( $w, $e, "$h -> $e ($w)" );
+    for my $i (sort { hex $a <=> hex $b } keys %$spec) {
+	my $w = unidump($spec->{$i});
+	my $c = pack "U0U", hex $i;
+	my $d = $func->($c);
+	my $e = unidump($d);
+	if (ord "A" == 193) { # EBCDIC
+	    # We need to a little bit of remapping.
+	    #
+	    # For example, in titlecase (ucfirst) mapping
+	    # of U+0149 the Unicode mapping is U+02BC U+004E.
+	    # The 4E is N, which in EBCDIC is 2B--
+	    # and the ucfirst() does that right.
+	    # The problem is that our reference
+	    # data is in Unicode code points.
+	    #
+	    # The Right Way here would be to use, say,
+	    # Encode, to remap the less-than 0x100 code points,
+	    # but let's try to be Encode-independent here. 
+	    #
+	    # These are the titlecase exceptions:
+	    #
+	    #         Unicode   Unicode+EBCDIC  
+	    #
+	    # 0149 -> 02BC 004E (02BC 002B)
+	    # 01F0 -> 004A 030C (00A2 030C)
+	    # 1E96 -> 0048 0331 (00E7 0331)
+	    # 1E97 -> 0054 0308 (00E8 0308)
+	    # 1E98 -> 0057 030A (00EF 030A)
+	    # 1E99 -> 0059 030A (00DF 030A)
+	    # 1E9A -> 0041 02BE (00A0 02BE)
+	    #
+	    # The uppercase exceptions are identical.
+	    #
+	    # The lowercase has one more:
+	    #
+	    #         Unicode   Unicode+EBCDIC  
+	    #
+	    # 0130 -> 0069 0307 (00D1 0307)
+	    #
+	    if ($i =~ /^(0130|0149|01F0|1E96|1E97|1E98|1E99|1E9A)$/) {
+		$e =~ s/004E/002B/; # N
+		$e =~ s/004A/00A2/; # J
+		$e =~ s/0048/00E7/; # H
+		$e =~ s/0054/00E8/; # T
+		$e =~ s/0057/00EF/; # W
+		$e =~ s/0059/00DF/; # Y
+		$e =~ s/0041/00A0/; # A
+		$e =~ s/0069/00D1/; # i
+	    }
+	    # We have to map the output, not the input, because
+	    # pack/unpack U has been EBCDICified, too, it would
+	    # just undo our remapping.
 	}
+	print $w eq $e ?
+	    "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n";
+	$test++;
     }
 
     for my $i (sort { $a <=> $b } keys %none) {
-	my $c = pack "U0U", $i;
 	my $w = $i = sprintf "%04X", $i;
-	foreach my $func (@funcs) {
-	    my $d = $func->($c);
-	    my $e = unidump($d);
-            is( $d, $c, "$i -> $e ($w)" );
-	}
+	my $c = pack "U0U", hex $i;
+	my $d = $func->($c);
+	my $e = unidump($d);
+	print $d eq $c ?
+	    "ok $test # $i -> $w\n" : "not ok $test # $i -> $e ($w)\n";
+	$test++;
     }
-
-    done_testing();
 }
 
 1;
diff --git a/gnu/usr.bin/perl/t/uni/lower.t b/gnu/usr.bin/perl/t/uni/lower.t
index 5b706af0d84..4420d0b165d 100644
--- a/gnu/usr.bin/perl/t/uni/lower.t
+++ b/gnu/usr.bin/perl/t/uni/lower.t
@@ -4,7 +4,5 @@ BEGIN {
     require "case.pl";
 }
 
-casetest(0, # No extra tests run here,
-	"Lowercase_Mapping",
-	 sub { lc $_[0] }, sub { my $a = ""; lc ($_[0] . $a) },
-	 sub { lcfirst $_[0] }, sub { my $a = ""; lcfirst ($_[0] . $a) });
+casetest("Lower", \%utf8::ToSpecLower, sub { lc $_[0] });
+
diff --git a/gnu/usr.bin/perl/t/uni/sprintf.t b/gnu/usr.bin/perl/t/uni/sprintf.t
index 08626498e2c..3c5f574b62c 100644
--- a/gnu/usr.bin/perl/t/uni/sprintf.t
+++ b/gnu/usr.bin/perl/t/uni/sprintf.t
@@ -6,7 +6,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan tests => 52;
+plan tests => 25;
 
 $a = "B\x{fc}f";
 $b = "G\x{100}r";
@@ -137,19 +137,3 @@ $c = 0x200;
     $sprintf = sprintf "%s%s", $w, "$w\x{100}";    
     is(substr($sprintf,0,2), $w, "utf8 echo echo");
 }
-
-my @values =(chr 110, chr 255, chr 256);
-
-foreach my $prefix (@values) {
-    foreach my $vector (map {$_ . $_} @values) {
-
-	my $format = "$prefix%*vd";
-
-	foreach my $dot (@values) {
-	    my $result = sprintf $format, $dot, $vector;
-	    is (length $result, 8)
-		or print "# ", join (',', map {ord $_} $prefix, $dot, $vector),
-		  "\n";
-	}
-    }
-}
diff --git a/gnu/usr.bin/perl/t/uni/title.t b/gnu/usr.bin/perl/t/uni/title.t
index 2d6dcb77ef3..c0b7e3a0163 100644
--- a/gnu/usr.bin/perl/t/uni/title.t
+++ b/gnu/usr.bin/perl/t/uni/title.t
@@ -4,6 +4,5 @@ BEGIN {
     require "case.pl";
 }
 
-casetest(0, # No extra tests run here,
-	"Titlecase_Mapping", sub { ucfirst $_[0] },
-	 sub { my $a = ""; ucfirst ($_[0] . $a) });
+casetest("Title", \%utf8::ToSpecTitle, sub { ucfirst $_[0] });
+
diff --git a/gnu/usr.bin/perl/t/uni/upper.t b/gnu/usr.bin/perl/t/uni/upper.t
index 315680c11b6..5694c26f222 100644
--- a/gnu/usr.bin/perl/t/uni/upper.t
+++ b/gnu/usr.bin/perl/t/uni/upper.t
@@ -4,9 +4,5 @@ BEGIN {
     require "case.pl";
 }
 
-is(uc("\x{3B1}\x{345}\x{301}"), "\x{391}\x{301}\x{399}", 'Verify moves YPOGEGRAMMENI');
+casetest("Upper", \%utf8::ToSpecUpper, sub { uc $_[0] });
 
-casetest( 1,	# extra tests already run
-	"Uppercase_Mapping",
-	 sub { uc $_[0] },
-	 sub { my $a = ""; uc ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/win32/system.t b/gnu/usr.bin/perl/t/win32/system.t
index a6a94cb51ae..b1906ce73ab 100644
--- a/gnu/usr.bin/perl/t/win32/system.t
+++ b/gnu/usr.bin/perl/t/win32/system.t
@@ -2,17 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    # We need '../../lib' as well as '../lib' because parts of Config are
-    # delay-loaded, after we've chdir()'ed into $testdir.
-    @INC = ('../lib', '../../lib');
+    @INC = '../lib';
     # XXX this could be further munged to enable some parts on other
     # platforms
-    require './test.pl';
-}
-
-BEGIN {
     unless ($^O =~ /^MSWin/) {
-        skip_all 'windows specific test';
+	print "1..0 # skipped: windows specific test\n";
+	exit 0;
     }
 }
 
@@ -37,10 +32,28 @@ open(my $F, ">$testdir/$exename.c")
     or die "Can't create $testdir/$exename.c: $!";
 print $F <<'EOT';
 #include <stdio.h>
+#ifdef __BORLANDC__
+#include <windows.h>
+#endif
 int
 main(int ac, char **av)
 {
     int i;
+#ifdef __BORLANDC__
+    char *s = GetCommandLine();
+    int j=0;
+    av[0] = s;
+    if (s[0]=='"') {
+	for(;s[++j]!='"';)
+	  ;
+	av[0]++;
+    }
+    else {
+	for(;s[++j]!=' ';)
+	  ;
+    }
+    s[j]=0;
+#endif
     for (i = 0; i < ac; i++)
 	printf("[%s]", av[i]);
     printf("\n");
@@ -84,7 +97,7 @@ END {
     chdir($cwd) && rmtree("$cwd/$testdir") if -d "$cwd/$testdir";
 }
 if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) {
-    note "Unpacking $exename.exe";
+    print "# Unpacking $exename.exe\n";
     my $e;
     {
 	local $/;
@@ -98,22 +111,22 @@ if (open(my $EIN, "$cwd/win32/${exename}_exe.uu")) {
 }
 else {
     my $minus_o = '';
-    if ($Config{cc} =~ /\bgcc/i)
+    if ($Config{cc} eq 'gcc')
      {
       $minus_o = "-o $exename.exe";
      }
-    note "Compiling $exename.c";
-    note "$Config{cc} $Config{ccflags} $exename.c";
+    print "# Compiling $exename.c\n# $Config{cc} $Config{ccflags} $exename.c\n";
     if (system("$Config{cc} $Config{ccflags} $minus_o $exename.c >log 2>&1") != 0) {
-	note "Could not compile $exename.c, status $?";
-    note "Where is your C compiler?";
-    skip_all "can't build test executable";
+	print "# Could not compile $exename.c, status $?\n"
+	     ."# Where is your C compiler?\n"
+	     ."1..0 # skipped: can't build test executable\n";
+	exit(0);
     }
     unless (-f "$exename.exe") {
 	if (open(LOG,'<log'))
          {
           while(<LOG>) {
-              note $_;
+	     print "# ",$_;
           } 
          }
         else {
@@ -124,18 +137,20 @@ else {
 copy("$plxname.bat","$plxname.cmd");
 chdir($cwd);
 unless (-x "$testdir/$exename.exe") {
-    note "Could not build $exename.exe";
-    skip_all "can't build test executable";
+    print "# Could not build $exename.exe\n"
+	 ."1..0 # skipped: can't build test executable\n";
+    exit(0);
 }
 
 open my $T, "$^X -I../lib -w win32/system_tests |"
     or die "Can't spawn win32/system_tests: $!";
 my $expect;
 my $comment = "";
+my $test = 0;
 while (<$T>) {
     chomp;
-    if (s/^1\.\.//) {
-	plan $_;
+    if (/^1\.\./) {
+	print "$_\n";
     }
     elsif (/^#+\s(.*)$/) {
 	$comment = $1;
@@ -147,11 +162,13 @@ while (<$T>) {
     }
     else {
 	if ($expect ne $_) {
-	    note $comment if $comment;
-	    note "want: $expect";
-	    note "got : $_";
+	    print "# $comment\n" if $comment;
+	    print "# want: $expect\n";
+	    print "# got : $_\n";
+	    print "not ";
 	}
-	ok($expect eq $_);
+	++$test;
+	print "ok $test\n";
     }
 }
 close $T;
diff --git a/gnu/usr.bin/perl/t/win32/system_tests b/gnu/usr.bin/perl/t/win32/system_tests
index e2445ed3a7a..f73745ae8fc 100644
--- a/gnu/usr.bin/perl/t/win32/system_tests
+++ b/gnu/usr.bin/perl/t/win32/system_tests
@@ -3,9 +3,6 @@
 use Config;
 use Cwd;
 use strict;
-BEGIN {
-    require './test.pl';
-}
 
 $| = 1;
 
@@ -93,7 +90,7 @@ for my $cmds (@commands) {
 	my @all_args;
 	my @cmds = defined($cmds) ? (ref($cmds) ? @$cmds : $cmds) : ();
 	my @args = defined($args) ? (ref($args) ? @$args : $args) : ();
-	note "####### [@cmds]";
+	print "######## [@cmds]\n";
 	print "<", join('><',
 			$cmds[$#cmds],
 			map { my $x = $_; $x =~ s/"//g; $x } @args),
@@ -109,7 +106,7 @@ for my $cmds (@commands) {
 	$^D = 0;
 	my $cmdstr = join " ", map { /\s|^$/ && !/\"/
 				    ? qq["$_"] : $_ } @cmds, @args;
-	note "####### '$cmdstr'";
+	print "######## '$cmdstr'\n";
 	if (system($cmdstr) != 0) {
 	    print "Failed, status($?)\n";
 	    if ($Config{ccflags} =~ /\bDDEBUGGING\b/) {
diff --git a/gnu/usr.bin/perl/t/x2p/s2p.t b/gnu/usr.bin/perl/t/x2p/s2p.t
index 0a0716da0c2..39c6cd80557 100644
--- a/gnu/usr.bin/perl/t/x2p/s2p.t
+++ b/gnu/usr.bin/perl/t/x2p/s2p.t
@@ -36,6 +36,7 @@ BEGIN {
     @INC = ( '../lib' );
 }
 
+### use Test::More;
 use File::Copy;
 use File::Spec;
 require './test.pl';
@@ -582,7 +583,7 @@ line 8
 ### s ###
 's' => {
   script => <<'[TheEnd]',
-# enclose any '(a)'.. '(c)' in '-'
+# enclose any `(a)'.. `(c)' in `-'
 s/([a-z])/-\1-/g
 
 s/\([abc]\)/-\1-/g
@@ -627,19 +628,6 @@ s/a\{3\}/a rep 3/
 [TheEnd]
 },
 
-### s2 ### RT #115156
-'s2' => {
-  todo   => 'RT #115156',
-  script => 's/1*$/x/g',
-  input  => 'bins',
-  expect => <<'[TheEnd]',
-0x
-x
-1000x
-1000x
-[TheEnd]
-},
-
 ### t ###
 't' => {
   script => join( "\n",
@@ -802,15 +790,7 @@ my $plsed  = "s2pt$$.pl";
 my $s2p  = File::Spec->catfile( File::Spec->updir(), 'x2p', 's2p' );
 my $psed = File::Spec->catfile( File::Spec->curdir(), 'psed' );
 if ($^O eq 'VMS') {
-  # default in the .com extension if it's not already there
-  $s2p = VMS::Filespec::vmsify($s2p);
-  $psed = VMS::Filespec::vmsify($psed);
-  # Converting file specs from Unix format to VMS with the extended
-  # character set active can result in a trailing '.' added for null
-  # extensions.  This must be removed if the intent is to default the
-  # extension.
-  $s2p =~ s/\.$//;
-  $psed =~ s/\.$//;
+  # default in the .com extenson if it's not already there
   $s2p = VMS::Filespec::rmsexpand($s2p, '.com');
   $psed = VMS::Filespec::rmsexpand($psed, '.com');
 }
@@ -818,6 +798,9 @@ my $sedcmd = [ $psed, '-f', $script, $stdin ];
 my $s2pcmd = [ $s2p,  '-f', $script ];
 my $plcmd  = [ $plsed, $stdin ];
 
+my $switches = '';
+$switches = ['-x'] if $^O eq 'MacOS';
+
 # psed: we create a local copy as linking may not work on some systems.
 copy( $s2p, $psed );
 push( @aux, $psed );
@@ -828,8 +811,6 @@ my $indat = '';
 for my $tc ( sort keys %testcase ){
     my( $psedres, $s2pres );
 
-    local $TODO = $testcase{$tc}{todo};
-
     # 1st test: run psed
     # prepare the script 
     open( SED, ">$script" ) || goto FAIL_BOTH;
@@ -863,19 +844,19 @@ for my $tc ( sort keys %testcase ){
 
     # run and compare
     #
-    $psedres = runperl( args => $sedcmd );
+    $psedres = runperl( args => $sedcmd, switches => $switches );
     is( $psedres, $testcase{$tc}{expect}, "psed $tc" );
 
     # 2nd test: run s2p
     # translate the sed script to a Perl program
 
-    my $perlprog = runperl( args => $s2pcmd );
+    my $perlprog = runperl( args => $s2pcmd, switches => $switches );
     open( PP, ">$plsed" ) || goto FAIL_S2P;
     print PP $perlprog;
     close( PP ) || goto FAIL_S2P;
 
     # execute generated Perl program, compare
-    $s2pres = runperl( args => $plcmd );
+    $s2pres = runperl( args => $plcmd, switches => $switches );
     is( $s2pres, $testcase{$tc}{expect}, "s2p $tc" );
     next;