Import perl-5.18.2

OK espie@ sthen@ deraadt@
author: afresh1 <afresh1@openbsd.org> 2014-03-24 14:58:42 +0000
committer: afresh1 <afresh1@openbsd.org> 2014-03-24 14:58:42 +0000
commit: 91f110e064cd7c194e59e019b83bb7496c1c84d4 (patch)
tree: 3e8e577405dba7e94b43cbf21c22f21aaa5ab949 /gnu/usr.bin/perl/t
parent: do not call purge_task every 10 secs, it is only needed once at startup and (diff)
download: wireguard-openbsd-91f110e064cd7c194e59e019b83bb7496c1c84d4.tar.xz
wireguard-openbsd-91f110e064cd7c194e59e019b83bb7496c1c84d4.zip
206 files changed, 11602 insertions, 2121 deletions
diff --git a/gnu/usr.bin/perl/t/bigmem/read.t b/gnu/usr.bin/perl/t/bigmem/read.t
new file mode 100644
index 00000000000..b29c097a6aa
--- /dev/null
+++ b/gnu/usr.bin/perl/t/bigmem/read.t
@@ -0,0 +1,24 @@
+#!perl
+BEGIN {
+    chdir 't';
+    unshift @INC, "../lib";
+}
+
+use strict;
+require './test.pl';
+use Config qw(%Config);
+
+$ENV{PERL_TEST_MEMORY} >= 3
+    or skip_all("Need ~3Gb for this test");
+$Config{ptrsize} >= 8
+    or skip_all("Need 64-bit pointers for this test");
+
+plan(1);
+
+# RT #100514
+my $x = "";
+read(DATA, $x, 4, 0x80000000);
+is(length $x, 0x80000004, "check we read to the correct offset");
+__DATA__
+Food
+
diff --git a/gnu/usr.bin/perl/t/bigmem/vec.t b/gnu/usr.bin/perl/t/bigmem/vec.t
new file mode 100644
index 00000000000..bf3c513f636
--- /dev/null
+++ b/gnu/usr.bin/perl/t/bigmem/vec.t
@@ -0,0 +1,34 @@
+#!perl
+BEGIN {
+    chdir 't';
+    unshift @INC, "../lib";
+}
+
+use strict;
+require './test.pl';
+use Config qw(%Config);
+
+$ENV{PERL_TEST_MEMORY} >= 1
+    or skip_all("Need ~1Gb for this test");
+$Config{ptrsize} >= 8
+    or skip_all("Need 64-bit pointers for this test");
+
+plan(7);
+
+# RT #111730: Negative offset to vec in lvalue context
+
+my $v = "";
+ok(scalar eval { vec($v, 0x80000000, 1) = 1 }, "set a bit at a large offset");
+ok(vec($v, 0x80000000, 1), "check a bit at a large offset");
+
+ok(scalar eval { vec($v, 0x100000000, 1) = 1 },
+   "set a bit at a larger offset");
+ok(vec($v, 0x100000000, 1), "check a bit at a larger offset");
+
+# real out of range values
+ok(!eval { vec($v, -0x80000000, 1) = 1 },
+   "shouldn't be able to set at a large negative offset");
+ok(!eval { vec($v, -0x100000000, 1) = 1 },
+   "shouldn't be able to set at a larger negative offset");
+
+ok(!vec($v, 0, 1), "make sure we didn't wrap");
diff --git a/gnu/usr.bin/perl/t/comp/bproto.t b/gnu/usr.bin/perl/t/comp/bproto.t
index bc0f1a291bd..8d11b915c1a 100644
--- a/gnu/usr.bin/perl/t/comp/bproto.t
+++ b/gnu/usr.bin/perl/t/comp/bproto.t
@@ -8,7 +8,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..14\n";
+print "1..16\n";
 
 my $i = 1;
 
@@ -35,12 +35,14 @@ sub test_no_error {
 
 test_too_many($_) for split /\n/,
 q[	defined(&foo, $bar);
+	pos(1,$b);
 	undef(&foo, $bar);
 	uc($bar,$bar);
 ];
 
 test_too_few($_) for split /\n/,
 q[	unpack;
+	pack;
 ];
 
 test_no_error($_) for split /\n/,
diff --git a/gnu/usr.bin/perl/t/comp/fold.t b/gnu/usr.bin/perl/t/comp/fold.t
index ec95f1aed80..5d6d9bf0892 100644
--- a/gnu/usr.bin/perl/t/comp/fold.t
+++ b/gnu/usr.bin/perl/t/comp/fold.t
@@ -4,7 +4,7 @@
 # we've not yet verified that use works.
 # use strict;
 
-print "1..19\n";
+print "1..26\n";
 my $test = 0;
 
 # Historically constant folding was performed by evaluating the ops, and if
@@ -118,3 +118,34 @@ is ($@, '', 'no error');
  ok scalar $jing =~ (0 || y/fo//),
    'lone y/// is not bound via =~ after || folding';
 }
+
+# [perl #78064] or print
+package other { # hide the "ok" sub
+ BEGIN { $^W = 0 }
+ print 0 ? not_ok : ok;
+ print " ", ++$test, " - print followed by const ? BEAR : BEAR\n";
+ print 1 ? ok : not_ok;
+ print " ", ++$test, " - print followed by const ? BEAR : BEAR (again)\n";
+ print 1 && ok;
+ print " ", ++$test, " - print followed by const && BEAR\n";
+ print 0 || ok;
+ print " ", ++$test, " - print followed by const || URSINE\n";
+ BEGIN { $^W = 1 }
+}
+
+# or stat
+print "not " unless stat(1 ? INSTALL : 0) eq stat("INSTALL");
+print "ok ", ++$test, " - stat(const ? word : ....)\n";
+# in case we are in t/
+print "not " unless stat(1 ? TEST : 0) eq stat("TEST");
+print "ok ", ++$test, " - stat(const ? word : ....)\n";
+
+# or truncate
+my $n = "for_fold_dot_t$$";
+open F, ">$n" or die "open: $!";
+print F "bralh blah blah \n";
+close F or die "close $!";
+eval "truncate 1 ? $n : 0, 0;";
+print "not " unless -z $n;
+print "ok ", ++$test, " - truncate(const ? word : ...)\n";
+unlink $n;
diff --git a/gnu/usr.bin/perl/t/comp/form_scope.t b/gnu/usr.bin/perl/t/comp/form_scope.t
index d4b5eddeb6c..2370a4bb307 100755
--- a/gnu/usr.bin/perl/t/comp/form_scope.t
+++ b/gnu/usr.bin/perl/t/comp/form_scope.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..7\n";
+print "1..14\n";
 
 # Tests bug #22977.  Test case from Dave Mitchell.
 sub f ($);
@@ -75,13 +75,36 @@ defined $x ? "not ok 4 - $x" : "ok 4"
   print "ok 5 - closure var not available when outer sub is inactive\n";
 }
 
+# Formats inside closures should close over the topmost clone of the outer
+# sub on the call stack.
+# Tests will be out of sequence if the wrong sub is used.
+sub make_closure {
+  my $arg = shift;
+  sub {
+    shift == 0 and &$next(1), return;
+    my $x = "ok $arg";
+    format STDOUT4 =
+@<<<<<<<
+$x
+.
+    sub { write }->(); # separate sub, so as not to rely on it being the
+  }                    # currently-running sub
+}
+*STDOUT = *STDOUT4{FORMAT};
+$clo1 = make_closure 6;
+$clo2 = make_closure 7;
+$next = $clo1;
+&$clo2(0);
+$next = $clo2;
+&$clo1(0);
+
 # Cloning a format whose outside has been undefined
 sub x {
     {my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u)}
     my $z;
     format STDOUT6 =
 @<<<<<<<<<<<<<<<<<<<<<<<<<
-defined $z ? "not ok 6 - $z" : "ok 6"
+defined $z ? "not ok 8 - $z" : "ok 8"
 .
 }
 undef &x;
@@ -92,5 +115,46 @@ undef &x;
   local $SIG{__WARN__} = sub { $w = shift };
   write;
   print "not " unless $w =~ /^Variable "\$z" is not available at/;
-  print "ok 7 - closure var not available when outer sub is undefined\n";
+  print "ok 9 - closure var not available when outer sub is undefined\n";
+}
+
+format STDOUT7 =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<
+do { my $x = "ok 10 - closure inside format"; sub { $x }->() }
+.
+*STDOUT = *STDOUT7{FORMAT};
+write;
+
+$testn = 12;
+format STDOUT8 =
+@<<<< - recursive formats
+do { my $t = "ok " . $testn--; write if $t =~ 12; $t}
+.
+*STDOUT = *STDOUT8{FORMAT};
+write;
+
+sub _13 {
+    my $x;
+format STDOUT13 =
+@* - formats closing over redefined subs
+ref \$x eq 'SCALAR' ? "ok 13" : "not ok 13";
+.
+}
+undef &_13;
+eval 'sub _13 { my @x; write }';
+*STDOUT = *STDOUT13{FORMAT};
+_13();
+
+# This is a variation of bug #22977, which crashes or fails an assertion
+# up to 5.16.
+# Keep this test last if you want test numbers to be sane.
+BEGIN { \&END }
+END {
+  my $test = "ok 14";
+  *STDOUT = *STDOUT5{FORMAT};
+  write;
+  format STDOUT5 =
+@<<<<<<<
+$test
+.
 }
diff --git a/gnu/usr.bin/perl/t/comp/hints.t b/gnu/usr.bin/perl/t/comp/hints.t
index a857755a4a4..9a08854d86c 100644
--- a/gnu/usr.bin/perl/t/comp/hints.t
+++ b/gnu/usr.bin/perl/t/comp/hints.t
@@ -4,6 +4,7 @@
 
 BEGIN {
     @INC = qw(. ../lib);
+    chdir 't';
 }
 
 BEGIN { print "1..31\n"; }
diff --git a/gnu/usr.bin/perl/t/comp/parser.t b/gnu/usr.bin/perl/t/comp/parser.t
index 16b4a826d1a..4f2da90f50e 100644
--- a/gnu/usr.bin/perl/t/comp/parser.t
+++ b/gnu/usr.bin/perl/t/comp/parser.t
@@ -3,7 +3,7 @@
 # Checks if the parser behaves correctly in edge cases
 # (including weird syntax errors)
 
-print "1..123\n";
+print "1..155\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -69,6 +69,13 @@ eval q/"\Nfoo"/;
 like( $@, qr/^Missing braces on \\N/,
     'syntax error in string with incomplete \N' );
 
+eval q/"\o{"/;
+like( $@, qr/^Missing right brace on \\o/,
+    'syntax error in string with incomplete \o' );
+eval q/"\ofoo"/;
+like( $@, qr/^Missing braces on \\o/,
+    'syntax error in string with incomplete \o' );
+
 eval "a.b.c.d.e.f;sub";
 like( $@, qr/^Illegal declaration of anonymous subroutine/,
     'found by Markov chain stress testing' );
@@ -125,11 +132,11 @@ is( $@, '', 'PL_lex_brackstack' );
     is("${a}[", "A[", "interpolation, qq//");
     my @b=("B");
     is("@{b}{", "B{", "interpolation, qq//");
-    is(qr/${a}{/, '(?^:A{)', "interpolation, qr//");
+    is(qr/${a}\{/, '(?^:A\{)', "interpolation, qr//");
     my $c = "A{";
-    $c =~ /${a}{/;
+    $c =~ /${a}\{/;
     is($&, 'A{', "interpolation, m//");
-    $c =~ s/${a}{/foo/;
+    $c =~ s/${a}\{/foo/;
     is($c, 'foo', "interpolation, s/...//");
     $c =~ s/foo/${a}{/;
     is($c, 'A{', "interpolation, s//.../");
@@ -311,9 +318,9 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
   eval qq[ %$xFC ];
   like($@, qr/Identifier too long/, "too long id in % sigil ctx");
 
-  eval qq[ \\&$xFC ]; # take a ref since I don't want to call it
-  is($@, "", "252 character & sigil ident ok");
-  eval qq[ \\&$xFD ];
+  eval qq[ \\&$xFB ]; # take a ref since I don't want to call it
+  is($@, "", "251 character & sigil ident ok");
+  eval qq[ \\&$xFC ];
   like($@, qr/Identifier too long/, "too long id in & sigil ctx");
 
   eval qq[ *$xFC ];
@@ -341,6 +348,12 @@ like($@, qr/BEGIN failed--compilation aborted/, 'BEGIN 7' );
   is(defined &zlonk, '', 'but no body defined');
 }
 
+# [perl #113016] CORE::print::foo
+sub CORE'print'foo { 43 } # apostrophes intentional; do not tempt fate
+sub CORE'foo'bar { 43 }
+is CORE::print::foo, 43, 'CORE::print::foo is not CORE::print ::foo';
+is scalar eval "CORE::foo'bar", 43, "CORE::foo'bar is not an error";
+
 # bug #71748
 eval q{
 	$_ = "";
@@ -353,7 +366,99 @@ eval q{
 };
 is($@, "", "multiline whitespace inside substitute expression");
 
-# Add new tests HERE:
+eval '@A =~ s/a/b/; # compilation error
+      sub tahi {}
+      sub rua;
+      sub toru ($);
+      sub wha :lvalue;
+      sub rima ($%&*$&*\$%\*&$%*&) :method;
+      sub ono :lvalue { die }
+      sub whitu (_) { die }
+      sub waru ($;) :method { die }
+      sub iwa { die }
+      BEGIN { }';
+is $::{tahi}, undef, 'empty sub decl ignored after compilation error';
+is $::{rua}, undef, 'stub decl ignored after compilation error';
+is $::{toru}, undef, 'stub+proto decl ignored after compilation error';
+is $::{wha}, undef, 'stub+attr decl ignored after compilation error';
+is $::{rima}, undef, 'stub+proto+attr ignored after compilation error';
+is $::{ono}, undef, 'sub decl with attr ignored after compilation error';
+is $::{whitu}, undef, 'sub decl w proto ignored after compilation error';
+is $::{waru}, undef, 'sub w attr+proto ignored after compilation error';
+is $::{iwa}, undef, 'non-empty sub decl ignored after compilation error';
+is *BEGIN{CODE}, undef, 'BEGIN leaves no stub after compilation error';
+
+$test = $test + 1;
+"ok $test - format inside re-eval" =~ /(?{
+    format =
+@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+$_
+.
+write
+}).*/;
+
+eval '
+"${;
+
+=pod
+
+=cut
+
+}";
+';
+is $@, "", 'pod inside string in string eval';
+"${;
+
+=pod
+
+=cut
+
+}";
+print "ok ", ++$test, " - pod inside string outside of string eval\n";
+
+like "blah blah blah\n", qr/${\ <<END
+blah blah blah
+END
+ }/, 'here docs in multiline quoted construct';
+like "blah blah blah\n", eval q|qr/${\ <<END
+blah blah blah
+END
+ }/|, 'here docs in multiline quoted construct in string eval';
+
+# Unterminated here-docs in subst in eval; used to crash
+eval 's/${<<END}//';
+eval 's//${<<END}/';
+print "ok ", ++$test, " - unterminated here-docs in s/// in string eval\n";
+
+sub 'Hello'_he_said (_);
+is prototype "Hello::_he_said", '_', 'initial tick in sub declaration';
+
+{
+    my @x = 'string';
+    is(eval q{ "$x[0]->strung" }, 'string->strung',
+	'literal -> after an array subscript within ""');
+    @x = ['string'];
+    # this used to give "string"
+    like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/,
+	'literal -> [0] after an array subscript within ""');
+}
+
+eval 'no if $] >= 5.17.4 warnings => "deprecated"';
+is 1,1, ' no crash for "no ... syntax error"';
+
+for my $pkg(()){}
+$pkg = 3;
+is $pkg, 3, '[perl #114942] for my $foo()){} $foo';
+
+eval 'Fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
+    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
+    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
+    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
+    .'oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo'
+    .'ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo';
+like $@, "^Identifier too long at ", 'ident buffer overflow';
+
+# Add new tests HERE (above this line)
 
 # bug #74022: Loop on characters in \p{OtherIDContinue}
 # This test hangs if it fails.
@@ -437,15 +542,16 @@ eval <<'EOSTANZA'; die $@ if $@;
 check(qr/^Great hail!.*no more\.$/, 61, "Overflow both small buffer checks");
 EOSTANZA
 
-{
-    my @x = 'string';
-    is(eval q{ "$x[0]->strung" }, 'string->strung',
-	'literal -> after an array subscript within ""');
-    @x = ['string'];
-    # this used to give "string"
-    like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/,
-	'literal -> [0] after an array subscript within ""');
-}
+#line 531 parser.t
+<<EOU; check('parser\.t', 531, 'on same line as heredoc');
+EOU
+s//<<EOV/e if 0;
+EOV
+check('parser\.t', 535, 'after here-doc in quotes');
+<<EOW;
+${check('parser\.t', 537, 'first line of interp in here-doc');;
+  check('parser\.t', 538, 'second line of interp in here-doc');}
+EOW
 
 __END__
 # Don't add new tests HERE. See note above
diff --git a/gnu/usr.bin/perl/t/comp/uproto.t b/gnu/usr.bin/perl/t/comp/uproto.t
index d3ad19f849e..f81e31411c6 100644
--- a/gnu/usr.bin/perl/t/comp/uproto.t
+++ b/gnu/usr.bin/perl/t/comp/uproto.t
@@ -72,7 +72,11 @@ eval q{ f(1,2,3,4) };
 like( $@, qr/Too many arguments for main::f at/ );
 
 {
+    # We have not tested require/use/no yet, so we must avoid this:
+    #    no warnings 'deprecated';
+    BEGIN { $SIG{__WARN__} = sub {} }
     my $_ = "quarante-deux";
+    BEGIN { $SIG{__WARN__} = undef }
     $foo = "FOO";
     $bar = "BAR";
     f("FOO quarante-deux", $foo);
@@ -97,7 +101,9 @@ $_ = $expected;
 g();
 g;
 undef $expected; &g; # $_ not passed
+BEGIN { $SIG{__WARN__} = sub {} }
 { $expected = my $_ = "bar"; g() }
+BEGIN { $SIG{__WARN__} = undef }
 
 eval q{ sub wrong1 (_$); wrong1(1,2) };
 like( $@, qr/Malformed prototype for main::wrong1/, 'wrong1' );
@@ -142,7 +148,9 @@ $_ = 21;
 double();
 is( $_, 42, '$_ is modifiable' );
 {
+    BEGIN { $SIG{__WARN__} = sub {} }
     my $_ = 22;
+    BEGIN { $SIG{__WARN__} = undef }
     double();
     is( $_, 44, 'my $_ is modifiable' );
 }
diff --git a/gnu/usr.bin/perl/t/io/crlf.t b/gnu/usr.bin/perl/t/io/crlf.t
index ff0f2085546..1e93ee02a82 100644
--- a/gnu/usr.bin/perl/t/io/crlf.t
+++ b/gnu/usr.bin/perl/t/io/crlf.t
@@ -12,8 +12,10 @@ use Config;
 
 my $file = tempfile();
 
+my $ungetc_count = 8200;    # Somewhat over the likely buffer size
+
 {
-    plan(tests => 16);
+    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));
@@ -42,6 +44,16 @@ my $file = tempfile();
 	$/ = "\n";
 	$s = <$fh>.<$fh>;
 	is($s, "\nxxy\n");
+
+        for my $i (0 .. $ungetc_count - 1) {
+            my $j = $i % 256;
+            is($fh->ungetc($j), $j, "ungetc of $j returns itself");
+        }
+
+        for (my $i = $ungetc_count - 1; $i >= 0; $i--) {
+            my $j = $i % 256;
+            is(ord($fh->getc()), $j, "getc gets back $j");
+        }
     }
 
     ok(close(FOO));
diff --git a/gnu/usr.bin/perl/t/io/eintr.t b/gnu/usr.bin/perl/t/io/eintr.t
index 966922bbe7b..9ea9cc7879d 100644
--- a/gnu/usr.bin/perl/t/io/eintr.t
+++ b/gnu/usr.bin/perl/t/io/eintr.t
@@ -49,9 +49,11 @@ if (exists $ENV{PERLIO} && $ENV{PERLIO} =~ /stdio/  ) {
 # Also skip on release builds, to avoid other possibly problematic
 # platforms
 
-if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O =~ /freebsd/ || 
-     ($^O eq 'solaris' && $Config{osvers} eq '2.8')
-	|| ((int($]*1000) & 1) == 0)
+my ($osmajmin) = $Config{osvers} =~ /^(\d+\.\d+)/;
+if ($^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O =~ /freebsd/ || $^O eq 'midnightbsd' ||
+     ($^O eq 'solaris' && $Config{osvers} eq '2.8') || $^O eq 'nto' ||
+     ($^O eq 'darwin' && $osmajmin < 9) ||
+    ((int($]*1000) & 1) == 0)
 ) {
 	skip_all('various portability issues');
 	exit 0;
diff --git a/gnu/usr.bin/perl/t/io/errno.t b/gnu/usr.bin/perl/t/io/errno.t
index dadc4e04fca..e9a6c097629 100755
--- a/gnu/usr.bin/perl/t/io/errno.t
+++ b/gnu/usr.bin/perl/t/io/errno.t
@@ -34,8 +34,6 @@ SKIP:
 		for my $rs_code ('', '$/=undef', '$/=\2', '$/=\1024') {
 		    TODO:
 		    {
-			local $::TODO = "We get RMS\$_IOP at EOF on VMS when \$/ is undef"
-			    if $^O eq 'VMS' && $rs_code eq '$/=undef';
 			is( runperl( prog => "$rs_code; $test_prog",
 						 stdin => $test_in, stderr => 1),
 				$test_in,
diff --git a/gnu/usr.bin/perl/t/io/shm.t b/gnu/usr.bin/perl/t/io/shm.t
index 0ba566b1d4c..4a8941ec753 100644
--- a/gnu/usr.bin/perl/t/io/shm.t
+++ b/gnu/usr.bin/perl/t/io/shm.t
@@ -55,7 +55,7 @@ if (not defined $key) {
   }
 }
 else {
-	plan(tests => 13);
+	plan(tests => 15);
 	pass('acquired shared mem');
 }
 
@@ -80,3 +80,13 @@ shmwrite $key, $int, 0, 1;
 shmread $key, $number, 0, 1;
 is("$number", $int, qq{"\$id" eq "$int"});
 cmp_ok($number + 0, '==', $int, "\$id + 0 == $int");
+
+my ($fetch, $store) = (0, 0);
+{ package Counted;
+  sub TIESCALAR { bless [undef] }
+  sub FETCH     { ++$fetch; $_[0][0] }
+  sub STORE     { ++$store; $_[0][0] = $_[1] } }
+tie $ct, 'Counted';
+shmread $key, $ct, 0, 1;
+is($fetch, 1, "shmread FETCH once");
+is($store, 1, "shmread STORE once");
diff --git a/gnu/usr.bin/perl/t/io/utf8.t b/gnu/usr.bin/perl/t/io/utf8.t
index 4b017479431..29beba20202 100644
--- a/gnu/usr.bin/perl/t/io/utf8.t
+++ b/gnu/usr.bin/perl/t/io/utf8.t
@@ -10,7 +10,7 @@ BEGIN {
 no utf8; # needed for use utf8 not griping about the raw octets
 
 
-plan(tests => 55);
+plan(tests => 61);
 
 $| = 1;
 
@@ -348,3 +348,41 @@ is($failed, undef);
 	  "<:utf8 rcatline must warn about bad utf8");
     close F;
 }
+
+{
+    # 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");
+}
diff --git a/gnu/usr.bin/perl/t/lib/1_compile.t b/gnu/usr.bin/perl/t/lib/1_compile.t
index a4dea830544..2802ae2ad64 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;
 
@@ -27,28 +27,22 @@ if (eval { require Socket }) {
 
 @Core_Modules = sort @Core_Modules;
 
-print "1..".(1+@Core_Modules)."\n";
+plan tests => 1+@Core_Modules;
 
-my $message
-  = "ok 1 - All modules should have tests # TODO Make Schwern Poorer\n";
-if (@Core_Modules) {
-  print "not $message";
-} else {
-  print $message;
-}
-print <<'EOREWARD';
-# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-04/msg01223.html
-# 20010421230349.P2946@blackrider.blackstar.co.uk
-EOREWARD
-
-my $test_num = 2;
+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");
 
 foreach my $module (@Core_Modules) {
-    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++;
+    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");
+    }
 }
 
 # We do this as a separate process else we'll blow the hell
@@ -60,7 +54,6 @@ sub compile_module {
     my $lib     = '-I' . catdir(updir(), 'lib');
 
     my $out = scalar `$^X $lib $compmod $module`;
-    print "# $out";
     return $out =~ /^ok/;
 }
 
diff --git a/gnu/usr.bin/perl/t/lib/Count.pm b/gnu/usr.bin/perl/t/lib/Count.pm
new file mode 100644
index 00000000000..635b5de6910
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/Count.pm
@@ -0,0 +1,8 @@
+# zero! ha ha ha
+package Count;
+"ha!";
+__DATA__
+one! ha ha ha
+two! ha ha ha
+three! ha ha ha
+four! ha ha ha
diff --git a/gnu/usr.bin/perl/t/lib/Devel/nodb.pm b/gnu/usr.bin/perl/t/lib/Devel/nodb.pm
new file mode 100644
index 00000000000..069380f5364
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/Devel/nodb.pm
@@ -0,0 +1,3 @@
+package Devel::nodb;
+*DB::DB = sub { } if 0;
+1;
diff --git a/gnu/usr.bin/perl/t/lib/charnames/alias b/gnu/usr.bin/perl/t/lib/charnames/alias
index 75280be7b37..b8786db30c2 100644
--- a/gnu/usr.bin/perl/t/lib/charnames/alias
+++ b/gnu/usr.bin/perl/t/lib/charnames/alias
@@ -12,7 +12,8 @@ unsupported special ':scoobydoo' in charnames at
 print "Here: \N{DIGIT ONE}\n";
 charnames::vianame("DIGIT TWO");
 EXPECT
-Undefined subroutine &charnames::vianame called at - line 2.
+OPTIONS regex
+Undefined subroutine &charnames::vianame called at - line \d+.
 Here: 1
 ########
 # NAME autoload doesn't get viacode
@@ -20,7 +21,7 @@ print "Here: \N{DIGIT THREE}\n";
 charnames::viacode(0x34);
 EXPECT
 OPTIONS regex
-Undefined subroutine &charnames::viacode called at - line 2.
+Undefined subroutine &charnames::viacode called at - line \d+.
 Here: 3
 ########
 # NAME autoload doesn't get string_vianame
@@ -28,7 +29,7 @@ print "Here: \N{DIGIT FOUR}\n";
 charnames::string_vianame("DIGIT FIVE");
 EXPECT
 OPTIONS regex
-Undefined subroutine &charnames::string_vianame called at - line 2.
+Undefined subroutine &charnames::string_vianame called at - line \d+.
 Here: 4
 ########
 # NAME wrong type of alias (missing colon)
@@ -36,8 +37,8 @@ no warnings;
 use charnames "alias";
 "Here: \N{e_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'e_ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
 # NAME alias without an argument
 use warnings;
@@ -55,22 +56,14 @@ EXPECT
 OPTIONS regex
 :alias cannot use existing pragma :full \(reversed order\?\) at
 ########
-# NAME alias with hashref but no :full
-use warnings;
-use charnames ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
-"Here: \N{e_ACUTE}!\n";
-EXPECT
-OPTIONS regex
-Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
-########
 # NAME alias with hashref but with :short
 use warnings;
 no warnings 'void';
 use charnames ":short", ":alias" => { e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE" };
 "Here: \N{e_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref to :full OK
 use warnings;
@@ -96,8 +89,8 @@ no warnings 'void';
 use charnames ":loose", ":alias" => { e_ACUTE => "latin SMALL LETTER E WITH ACUTE" };
 "Here: \N{e_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'latin SMALL LETTER E WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref to :short but using :full
 use warnings;
@@ -105,8 +98,8 @@ no warnings 'void';
 use charnames ":full", ":alias" => { e_ACUTE => "LATIN:e WITH ACUTE" };
 "Here: \N{e_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN:e WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref to :short OK
 use warnings;
@@ -152,8 +145,8 @@ use charnames ":short", ":alias" => {
     };
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname '' at
+OPTIONS regex fatal
+Unknown charname 'a_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref two aliases
 use warnings;
@@ -175,8 +168,8 @@ use charnames ":short", ":alias" => {
     };
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN SMALL LETTER A WITH ACUT' at
+OPTIONS regex fatal
+Unknown charname 'a_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref using mixed aliases
 use warnings;
@@ -186,8 +179,8 @@ use charnames ":short", ":alias" => {
     };
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN SMALL LETTER A WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'a_ACUTE' at - line \d+, within string
 ########
 # NAME alias with hashref using mixed aliases
 use warnings;
@@ -198,8 +191,8 @@ use charnames ":full", ":alias" => {
     };
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN:e WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
 # NAME alias with nonexisting file
 use warnings;
@@ -217,7 +210,7 @@ use charnames ":full", ":alias" => "xy 7-";
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
 OPTIONS regex
-Charnames alias files can only have identifier characters at
+Charnames alias file names can only have identifier characters at
 ########
 # NAME alias with non_absolute (existing) file name (which it should /not/ use)
 use warnings;
@@ -228,7 +221,7 @@ EXPECT
 OPTIONS regex
 unicore/perl_alias.pl cannot be used as alias file for charnames at
 ########
-# alias with bad file
+# NAME alias with bad file
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 0;
@@ -241,7 +234,7 @@ EXPECT
 OPTIONS regex
 unicore/xyzzy_alias.pl did not return a \(valid\) list of alias pairs at
 ########
-# alias with file with empty list
+# NAME alias with file with empty list
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 ();
@@ -251,10 +244,10 @@ no warnings 'void';
 use charnames ":full", ":alias" => "xyzzy";
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'e_ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
-# alias with file OK but file has :short aliases
+# NAME alias with file OK but file has :short aliases
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 (   e_ACUTE => "LATIN:e WITH ACUTE",
@@ -266,10 +259,10 @@ no warnings 'void';
 use charnames ":full", ":alias" => "xyzzy";
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN:e WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
-# alias with :short and file OK
+# NAME alias with :short and file OK
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 (   e_ACUTE => "LATIN:e WITH ACUTE",
@@ -284,7 +277,7 @@ EXPECT
 OPTIONS regex
 $
 ########
-# alias with :short and file OK has :long aliases
+# NAME alias with :short and file OK has :long aliases
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 (   e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
@@ -296,10 +289,10 @@ no warnings 'void';
 use charnames ":short", ":alias" => "xyzzy";
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN SMALL LETTER E WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
-# alias with file implicit :full but file has :short aliases
+# NAME alias with file implicit :full but file has :short aliases
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 (   e_ACUTE => "LATIN:e WITH ACUTE",
@@ -311,10 +304,10 @@ no warnings 'void';
 use charnames ":alias" => ":xyzzy";
 "Here: \N{e_ACUTE}\N{a_ACUTE}!\n";
 EXPECT
-OPTIONS regex
-Unknown charname 'LATIN:e WITH ACUTE' at
+OPTIONS regex fatal
+Unknown charname 'e_ACUTE' at - line \d+, within string
 ########
-# alias with file implicit :full and file has :long aliases
+# NAME alias with file implicit :full and file has :long aliases
 --FILE-- ../../lib/unicore/xyzzy_alias.pl
 #!perl
 (   e_ACUTE => "LATIN SMALL LETTER E WITH ACUTE",
@@ -346,3 +339,68 @@ print charnames::viacode(0x80), "\n";
 EXPECT
 OPTIONS regex
 PADDING CHARACTER
+########
+# NAME various wrong characters in :alias are errors
+# Below, one of the EXPECT regexes matches both the UTF-8 and non-UTF-8 form.
+# This is because under some circumstances the message gets output as UTF-8.
+use charnames ":full", ":alias" => {
+                            "4e_ACUTE" => "LATIN SMALL LETTER E WITH ACUTE",
+                            "e_A,CUTE" => "LATIN SMALL LETTER E WITH ACUTE",
+                            "e_ACUT\x{d7}E" => "LATIN SMALL LETTER E WITH ACUTE",
+                    };
+EXPECT
+OPTIONS regex
+Invalid character in charnames alias definition; marked by <-- HERE in '4<-- HERE e_ACUTE'
+Invalid character in charnames alias definition; marked by <-- HERE in 'e_A,<-- HERE CUTE'
+Invalid character in charnames alias definition; marked by <-- HERE in 'e_ACUT(?:\x{d7}|\x{C3}\x{97})<-- HERE E'
+########
+# RT#73022
+# NAME \N{...} interprets ... as octets rather than UTF-8
+use utf8;
+use open qw( :utf8 :std );
+use charnames ":full", ":alias" => { "自転車に乗る人" => "BICYCLIST" };
+print "ok\n" if "\N{自転車に乗る人}" eq "\x{1F6B4}";
+EXPECT
+ok
+########
+# NAME Misspelled \N{} UTF-8 names are errors
+use utf8;
+use open qw( :utf8 :std );
+use charnames ":full", ":alias" => { "自転車に乗る人" => "BICYCLIST" };
+print "ok\n" if "\N{転車に乗る人}" eq "\x{1F6B4}";
+EXPECT
+OPTIONS regex
+Unknown charname '転車に乗る人' at - line \d+, within string
+########
+# NAME various wrong UTF-8 characters in :alias are errors
+# First has a punctuation, KATAKANA MIDDLE DOT, in it; second begins with a
+# digit: ARABIC-INDIC DIGIT FOUR
+use utf8;
+use open qw( :utf8 :std );
+use charnames ":full", ":alias" => { "自転車・に乗る人" => "BICYCLIST",
+                                     "٤転車に乗る人" => "BICYCLIST",
+                                    };
+print "ok\n" if "\N{自転車・に乗る人}" eq "\x{1F6B4}";
+print "ok\n" if "\N{٤転車に乗る人}" eq "\x{1F6B4}";
+EXPECT
+OPTIONS regex
+Invalid character in charnames alias definition; marked by <-- HERE in '٤<-- HERE 転車に乗る人'
+Invalid character in charnames alias definition; marked by <-- HERE in '自転車・<-- HERE に乗る人' at - line \d+
+########
+# NAME trailing and sequences of multiple spaces in :alias names are deprectated
+use charnames ":alias" => { "TOO  MANY SPACES" => "NO ENTRY SIGN",
+                            "TRAILING SPACE " => "FACE WITH NO GOOD GESTURE"
+                          };
+print "ok\n" if "\N{TOO  MANY SPACES}" eq "\x{1F6AB}";
+print "ok\n" if "\N{TRAILING SPACE }" eq "\x{1F645}";
+no warnings 'deprecated';
+print "ok\n" if "\N{TOO  MANY SPACES}" eq "\x{1F6AB}";
+print "ok\n" if "\N{TRAILING SPACE }" eq "\x{1F645}";
+EXPECT
+OPTIONS regex
+A sequence of multiple spaces in a charnames alias definition is deprecated; marked by <-- HERE in 'TOO   <-- HERE MANY SPACES' at - line \d+.
+Trailing white-space in a charnames alias definition is deprecated; marked by <-- HERE in 'TRAILING SPACE  <-- HERE ' at - line \d+.
+ok
+ok
+ok
+ok
diff --git a/gnu/usr.bin/perl/t/lib/common.pl b/gnu/usr.bin/perl/t/lib/common.pl
index e6a33b20242..beb59a021d4 100644
--- a/gnu/usr.bin/perl/t/lib/common.pl
+++ b/gnu/usr.bin/perl/t/lib/common.pl
@@ -54,11 +54,11 @@ foreach my $file (@w_files) {
 }
 
 $^X = rel2abs($^X);
+@INC = map { rel2abs($_) } @INC;
 my $tempdir = tempfile;
 
 mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
 chdir $tempdir or die die "Can't chdir '$tempdir': $!";
-unshift @INC, '../../lib';
 my $cleanup = 1;
 
 END {
diff --git a/gnu/usr.bin/perl/t/lib/commonsense.t b/gnu/usr.bin/perl/t/lib/commonsense.t
index 27fd302fb19..9f0f13f634c 100644
--- a/gnu/usr.bin/perl/t/lib/commonsense.t
+++ b/gnu/usr.bin/perl/t/lib/commonsense.t
@@ -1,21 +1,26 @@
 #!./perl
 
-chdir 't' if -d 't';
-@INC = '../lib';
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan( tests => 1);
+
 require Config; import Config;
+
 if (($Config{'extensions'} !~ /\bFcntl\b/) ){
-  print "Bail out! Perl configured without Fcntl module\n";
-  exit 0;
+  BAIL_OUT("Perl configured without Fcntl module");
 }
-if (($Config{'extensions'} !~ /\bIO\b/) ){
-  print "Bail out! Perl configured without IO module\n";
-  exit 0;
+##Finds IO submodules when using \b
+if (($Config{'extensions'} !~ /\bIO\s/) ){
+  BAIL_OUT("Perl configured without IO module");
 }
 # hey, DOS users do not need this kind of common sense ;-)
 if ($^O ne 'dos' && ($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
-  print "Bail out! Perl configured without File::Glob module\n";
-  exit 0;
+  BAIL_OUT("Perl configured without File::Glob module");
 }
 
-print "1..1\nok 1\n";
+pass('common sense');
 
diff --git a/gnu/usr.bin/perl/t/lib/croak/op b/gnu/usr.bin/perl/t/lib/croak/op
index eb5974ffc43..22f1e7621b5 100644
--- a/gnu/usr.bin/perl/t/lib/croak/op
+++ b/gnu/usr.bin/perl/t/lib/croak/op
@@ -5,14 +5,6 @@ EXPECT
 Can't use global $! in "my" at - line 1, near "my $!"
 Execution of - aborted due to compilation errors.
 ########
-# NAME my $<special_unicode>
-use utf8;
-BEGIN { binmode STDERR, ":utf8" }
-my $♠;
-EXPECT
-Can't use global $♠ in "my" at - line 3, near "my $♠"
-Execution of - aborted due to compilation errors.
-########
 # NAME OP_HELEM fields
 package Foo;
 use fields qw(a b);
@@ -37,11 +29,6 @@ my Foo $f = Foo->new;
 EXPECT
 No such class field "c" in variable $f of type Foo at - line 8.
 ########
-# NAME my sub
-my sub foo { }
-EXPECT
-"my sub" not yet implemented at - line 1.
-########
 # NAME delete BAD
 delete $x;
 EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/croak/pp_ctl b/gnu/usr.bin/perl/t/lib/croak/pp_ctl
index 0f075cd783e..ee1edbaffab 100644
--- a/gnu/usr.bin/perl/t/lib/croak/pp_ctl
+++ b/gnu/usr.bin/perl/t/lib/croak/pp_ctl
@@ -1,6 +1,12 @@
 __END__
+# NAME dump with computed label
+my $label = "foo";
+dump $label;
+EXPECT
+Can't find label foo at - line 2.
+########
 # NAME when outside given
-use 5.01;
+use 5.01; no warnings 'experimental::smartmatch';
 when(undef){}
 EXPECT
 Can't "when" outside a topicalizer at - line 2.
diff --git a/gnu/usr.bin/perl/t/lib/croak/pp_hot b/gnu/usr.bin/perl/t/lib/croak/pp_hot
new file mode 100644
index 00000000000..bc00a484c6d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/croak/pp_hot
@@ -0,0 +1,60 @@
+__END__
+# NAME local %$ref on last line of lvalue sub in lv cx
+   sub foo :lvalue { local %{\%foo} }
+   (foo) = 3;
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME local @$ref on last line of lvalue sub in lv cx
+   sub foo :lvalue { local @{\@foo} }
+   (foo) = 3;
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME local %$ref on last line of lvalue sub in non-lv cx
+   sub foo :lvalue { local %{\%foo} }
+   foo;
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME local @$ref on last line of lvalue sub in non-lv cx
+   sub foo :lvalue { local @{\@foo} }
+   foo;
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME \local %$ref
+   \local %{\%hash}
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME \local @$ref
+   \local @{\@hash}
+EXPECT
+Can't localize through a reference at - line 1.
+########
+# NAME calling undef sub belonging to undef GV
+   my $foosub = \&foo;
+   undef *foo;
+   &$foosub;
+EXPECT
+Undefined subroutine &main::foo called at - line 3.
+########
+# NAME calling undef sub resident in its GV
+   my $foosub = \&foo;
+   &$foosub;
+EXPECT
+Undefined subroutine &main::foo called at - line 2.
+########
+# NAME calling undef scalar
+   &{+undef};
+EXPECT
+Can't use an undefined value as a subroutine reference at - line 1.
+########
+# NAME calling undef magical scalar
+   sub TIESCALAR {bless[]}
+   sub FETCH {}
+   tie $tied, "";
+   &$tied;
+EXPECT
+Can't use an undefined value as a subroutine reference at - line 4.
diff --git a/gnu/usr.bin/perl/t/lib/croak/toke b/gnu/usr.bin/perl/t/lib/croak/toke
new file mode 100644
index 00000000000..8e4b0338a30
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/croak/toke
@@ -0,0 +1,130 @@
+__END__
+# NAME Unterminated here-doc in string eval
+eval "<<foo"; die $@
+EXPECT
+Can't find string terminator "foo" anywhere before EOF at (eval 1) line 1.
+########
+# NAME Unterminated here-doc in s/// string eval
+eval "s//<<foo/e"; die $@
+EXPECT
+Can't find string terminator "foo" anywhere before EOF at (eval 1) line 1.
+########
+# NAME Missing name in "my sub"
+use feature 'lexical_subs'; my sub;
+EXPECT
+The lexical_subs feature is experimental at - line 1.
+Missing name in "my sub" at - line 1.
+########
+# NAME Missing name in "our sub"
+use feature 'lexical_subs'; our sub;
+EXPECT
+The lexical_subs feature is experimental at - line 1.
+Missing name in "our sub" at - line 1.
+########
+# NAME Missing name in "state sub"
+use 5.01; use feature 'lexical_subs';
+state sub;
+EXPECT
+The lexical_subs feature is experimental at - line 2.
+Missing name in "state sub" at - line 2.
+########
+# NAME Integer constant overloading returning undef
+use overload;
+BEGIN { overload::constant integer => sub {}; undef *^H }
+1
+EXPECT
+Constant(1) unknown at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME Float constant overloading returning undef
+use overload;
+BEGIN { overload::constant float => sub {}; undef *^H }
+1.1
+EXPECT
+Constant(1.1) unknown at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME Binary constant overloading returning undef
+use overload;
+BEGIN { overload::constant binary => sub {}; undef *^H }
+0x1
+EXPECT
+Constant(0x1) unknown at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME String constant overloading returning undef
+use overload;
+BEGIN { overload::constant q => sub {}; undef *^H }
+'1', "1$_", tr"a"", s""a"
+EXPECT
+Constant(q) unknown at - line 3, near "'1'"
+Constant(qq) unknown at - line 3, within string
+Constant(tr) unknown at - line 3, within string
+Constant(s) unknown at - line 3, within string
+Execution of - aborted due to compilation errors.
+########
+# NAME Regexp constant overloading when *^H is undefined
+use overload;
+BEGIN { overload::constant qr => sub {}; undef *^H }
+/a/, m'a'
+EXPECT
+Constant(qq) unknown at - line 3, within pattern
+Constant(q) unknown at - line 3, within pattern
+Execution of - aborted due to compilation errors.
+########
+# NAME \N{...} when charnames fails to load but without an error
+# SKIP ? exists $ENV{PERL_UNICODE} ? "Unreliable under some PERL_UNICODE settings" : 0
+BEGIN { ++$_ for @INC{"charnames.pm","_charnames.pm"} }
+"\N{a}"
+EXPECT
+Constant(\N{a}) unknown at - line 2, within string
+Execution of - aborted due to compilation errors.
+########
+# NAME Integer constant overloading returning undef
+use overload;
+BEGIN { overload::constant integer => sub {} }
+1
+EXPECT
+Constant(1): Call to &{$^H{integer}} did not return a defined value at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME Float constant overloading returning undef
+use overload;
+BEGIN { overload::constant float => sub {} }
+1.1
+EXPECT
+Constant(1.1): Call to &{$^H{float}} did not return a defined value at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME Binary constant overloading returning undef
+use overload;
+BEGIN { overload::constant binary => sub {} }
+0x1
+EXPECT
+Constant(0x1): Call to &{$^H{binary}} did not return a defined value at - line 3, at end of line
+Execution of - aborted due to compilation errors.
+########
+# NAME String constant overloading returning undef
+use overload;
+BEGIN { overload::constant q => sub {} }
+'1', "1$_", tr"a"", s""a"
+EXPECT
+Constant(q): Call to &{$^H{q}} did not return a defined value at - line 3, near "'1'"
+Constant(qq): Call to &{$^H{q}} did not return a defined value at - line 3, within string
+Constant(tr): Call to &{$^H{q}} did not return a defined value at - line 3, within string
+Constant(s): Call to &{$^H{q}} did not return a defined value at - line 3, within string
+Execution of - aborted due to compilation errors.
+########
+# NAME Regexp constant overloading returning undef
+use overload;
+BEGIN { overload::constant qr => sub {} }
+/a/, m'a'
+EXPECT
+Constant(qq): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern
+Constant(q): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern
+Execution of - aborted due to compilation errors.
+########
+# NAME Unterminated delimiter for here document
+<<"foo
+EXPECT
+Unterminated delimiter for here document at - line 1.
diff --git a/gnu/usr.bin/perl/t/lib/feature/switch b/gnu/usr.bin/perl/t/lib/feature/switch
index 5da635b6d51..0dee7f51cf9 100644
--- a/gnu/usr.bin/perl/t/lib/feature/switch
+++ b/gnu/usr.bin/perl/t/lib/feature/switch
@@ -3,28 +3,28 @@ Check the lexical scoping of the switch keywords.
 
 __END__
 # No switch; given should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 print STDOUT given;
 EXPECT
 Unquoted string "given" may clash with future reserved word at - line 3.
 given
 ########
 # No switch; when should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 print STDOUT when;
 EXPECT
 Unquoted string "when" may clash with future reserved word at - line 3.
 when
 ########
 # No switch; default should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 print STDOUT default;
 EXPECT
 Unquoted string "default" may clash with future reserved word at - line 3.
 default
 ########
 # No switch; break should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 print STDOUT break;
 EXPECT
 Unquoted string "break" may clash with future reserved word at - line 3.
@@ -36,19 +36,19 @@ EXPECT
 Can't "continue" outside a when block at - line 2.
 ########
 # Use switch; so given is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
 given("okay\n") { print }
 EXPECT
 okay
 ########
 # Use switch; so when is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
 given(1) { when(1) { print "okay" } }
 EXPECT
 okay
 ########
 # Use switch; so default is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
 given(1) { default { print "okay" } }
 EXPECT
 okay
@@ -60,7 +60,7 @@ EXPECT
 Can't "break" outside a given block at - line 3.
 ########
 # switch out of scope; given should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 { use feature 'switch';
   given (1) {print "Okay here\n";}
 }
@@ -71,7 +71,7 @@ Okay here
 given
 ########
 # switch out of scope; when should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 { use feature 'switch';
   given (1) { when(1) {print "Okay here\n";} }
 }
@@ -82,7 +82,7 @@ Okay here
 when
 ########
 # switch out of scope; default should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 { use feature 'switch';
   given (1) { default {print "Okay here\n";} }
 }
@@ -93,7 +93,7 @@ Okay here
 default
 ########
 # switch out of scope; break should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 { use feature 'switch';
   given (1) { break }  
 }
@@ -103,7 +103,7 @@ Unquoted string "break" may clash with future reserved word at - line 6.
 break
 ########
 # C<no feature 'switch'> should work
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 use feature 'switch';
 given (1) { when(1) {print "Okay here\n";} }
 no feature 'switch';
@@ -114,7 +114,7 @@ Okay here
 when
 ########
 # C<no feature> should work too
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 use feature 'switch';
 given (1) { when(1) {print "Okay here\n";} }
 no feature;
@@ -125,14 +125,14 @@ Okay here
 when
 ########
 # Without the feature, no 'Unambiguous use of' warning:
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 @break = ($break = "break");
 print ${break}, ${break[0]};
 EXPECT
 breakbreak
 ########
 # With the feature, we get an 'Unambiguous use of' warning:
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
 use feature 'switch';
 @break = ($break = "break");
 print ${break}, ${break[0]};
diff --git a/gnu/usr.bin/perl/t/lib/strict/refs b/gnu/usr.bin/perl/t/lib/strict/refs
index d9bff7cd840..e74851220e7 100644
--- a/gnu/usr.bin/perl/t/lib/strict/refs
+++ b/gnu/usr.bin/perl/t/lib/strict/refs
@@ -27,6 +27,29 @@ Can't use string ("A::Really::Big::Package::Name::T"...) as a HASH ref while "st
 
 # 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
@@ -308,7 +331,7 @@ Can't use string ("Fred") as a SCALAR ref while "strict refs" in use at - line 8
 use strict 'refs';
 /(?{${"foo"}++})/;
 EXPECT
-Can't use string ("foo") as a SCALAR ref while "strict refs" in use at (re_eval 1) line 1.
+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';
diff --git a/gnu/usr.bin/perl/t/lib/strict/subs b/gnu/usr.bin/perl/t/lib/strict/subs
index 57327cca0bb..5fd0b03de7f 100644
--- a/gnu/usr.bin/perl/t/lib/strict/subs
+++ b/gnu/usr.bin/perl/t/lib/strict/subs
@@ -378,8 +378,8 @@ Execution of - aborted due to compilation errors.
 use strict 'subs';
 qr/(?{my $x=foo})/;
 EXPECT
-Bareword "foo" not allowed while "strict subs" in use at (re_eval 1) line 1.
-Compilation failed in regexp at - line 3.
+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';
@@ -387,8 +387,8 @@ use utf8;
 use open qw( :utf8 :std );
 qr/(?{my $x=fòò})/;
 EXPECT
-Bareword "fòò" not allowed while "strict subs" in use at (re_eval 1) line 1.
-Compilation failed in regexp at - line 5.
+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';
@@ -451,3 +451,10 @@ sub foo {
 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 87e5a773309..c6cb0679396 100644
--- a/gnu/usr.bin/perl/t/lib/strict/vars
+++ b/gnu/usr.bin/perl/t/lib/strict/vars
@@ -518,8 +518,8 @@ Execution of - aborted due to compilation errors.
 use strict 'vars';
 qr/(?{$foo++})/;
 EXPECT
-Global symbol "$foo" requires explicit package name at (re_eval 1) line 1.
-Compilation failed in regexp at - line 3.
+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';
@@ -527,8 +527,8 @@ use utf8;
 use open qw( :utf8 :std );
 qr/(?{$fòò++})/;
 EXPECT
-Global symbol "$fòò" requires explicit package name at (re_eval 1) line 1.
-Compilation failed in regexp at - line 5.
+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;
diff --git a/gnu/usr.bin/perl/t/lib/test_require.pm b/gnu/usr.bin/perl/t/lib/test_require.pm
new file mode 100644
index 00000000000..381e068c854
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/test_require.pm
@@ -0,0 +1,6 @@
+#!perl -w
+# Don't use strict because this is for testing require
+
+package test_require;
+
+++$test_require::loaded;
diff --git a/gnu/usr.bin/perl/t/lib/universal.t b/gnu/usr.bin/perl/t/lib/universal.t
index a52e01972fe..71223b4faef 100644
--- a/gnu/usr.bin/perl/t/lib/universal.t
+++ b/gnu/usr.bin/perl/t/lib/universal.t
@@ -15,12 +15,10 @@ sub tryit { eval shift or warn \$@ }
 tryit "&Internals::SvREADONLY($arg)";
 tryit "&Internals::SvREFCNT($arg)";
 tryit "&Internals::hv_clear_placeholders($arg)";
-tryit "&Internals::HvREHASH($arg)";
 ----
 Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
 Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
 Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
-Internals::HvREHASH $hashref at (eval 4) line 1.
 ====
 }
 
diff --git a/gnu/usr.bin/perl/t/lib/warnings/2use b/gnu/usr.bin/perl/t/lib/warnings/2use
index e5a8103b810..c0d203a399d 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/2use
+++ b/gnu/usr.bin/perl/t/lib/warnings/2use
@@ -358,3 +358,22 @@ $a =+ 1 ;
 EXPECT
 Reversed += operator at - line 6.
 Use of uninitialized value $c in scalar chop at - line 9.
+########
+
+# Check that deprecation warnings are not implicitly disabled by use
+$*;
+use warnings "void";
+$#;
+EXPECT
+$* is no longer supported at - line 3.
+$# is no longer supported at - line 5.
+Useless use of a variable in void context at - line 5.
+########
+
+# Check that deprecation warnings are not implicitly disabled by no
+$*;
+no warnings "void";
+$#;
+EXPECT
+$* is no longer supported at - line 3.
+$# is no longer supported at - line 5.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/9uninit b/gnu/usr.bin/perl/t/lib/warnings/9uninit
index 37e24e73859..829e2de8386 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/9uninit
+++ b/gnu/usr.bin/perl/t/lib/warnings/9uninit
@@ -820,6 +820,7 @@ undef $g1;
 $m1 = '$g1';
 $foo =~ s//$m1/ee;
 EXPECT
+Use of my $_ is experimental at - line 16.
 Use of uninitialized value $_ in pattern match (m//) at - line 5.
 Use of uninitialized value $m1 in regexp compilation at - line 6.
 Use of uninitialized value $_ in pattern match (m//) at - line 6.
@@ -830,9 +831,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 10.
 Use of uninitialized value $_ in substitution (s///) at - line 11.
-Use of uninitialized value $g1 in substitution (s///) at - line 11.
 Use of uninitialized value $_ in substitution (s///) at - line 11.
-Use of uninitialized value $g1 in substitution (s///) at - line 11.
+Use of uninitialized value $g1 in substitution iterator at - line 11.
 Use of uninitialized value $m1 in regexp compilation at - line 12.
 Use of uninitialized value $_ in substitution (s///) at - line 12.
 Use of uninitialized value $_ in substitution (s///) at - line 12.
@@ -849,9 +849,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 21.
 Use of uninitialized value $_ in substitution (s///) at - line 22.
-Use of uninitialized value $g1 in substitution (s///) at - line 22.
 Use of uninitialized value $_ in substitution (s///) at - line 22.
-Use of uninitialized value $g1 in substitution (s///) at - line 22.
+Use of uninitialized value $g1 in substitution iterator at - line 22.
 Use of uninitialized value $m1 in regexp compilation at - line 23.
 Use of uninitialized value $_ in substitution (s///) at - line 23.
 Use of uninitialized value $_ in substitution (s///) at - line 23.
@@ -868,9 +867,8 @@ Use of uninitialized value $m1 in regexp compilation at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 31.
 Use of uninitialized value $g2 in substitution (s///) at - line 32.
-Use of uninitialized value $g1 in substitution (s///) at - line 32.
 Use of uninitialized value $g2 in substitution (s///) at - line 32.
-Use of uninitialized value $g1 in substitution (s///) at - line 32.
+Use of uninitialized value $g1 in substitution iterator at - line 32.
 Use of uninitialized value $m1 in regexp compilation at - line 33.
 Use of uninitialized value $g2 in substitution (s///) at - line 33.
 Use of uninitialized value $g2 in substitution (s///) at - line 33.
@@ -880,10 +878,10 @@ Use of uninitialized value in transliteration (tr///) at - line 35.
 Use of uninitialized value $m1 in regexp compilation at - line 38.
 Use of uninitialized value $g1 in regexp compilation at - line 39.
 Use of uninitialized value $m1 in regexp compilation at - line 41.
-Use of uninitialized value $g1 in substitution (s///) at - line 42.
+Use of uninitialized value $g1 in substitution iterator at - line 42.
 Use of uninitialized value $m1 in regexp compilation at - line 43.
 Use of uninitialized value $g1 in substitution iterator at - line 43.
-Use of uninitialized value $m1 in substitution iterator at - line 44.
+Use of uninitialized value $m1 in substitution (s///) at - line 44.
 Use of uninitialized value in substitution iterator at - line 47.
 ########
 use warnings 'uninitialized';
@@ -1035,7 +1033,6 @@ Use of uninitialized value $g1 in vec at - line 11.
 Use of uninitialized value $m1 in vec at - line 11.
 Use of uninitialized value $m2 in vec at - line 12.
 Use of uninitialized value $g1 in vec at - line 12.
-Use of uninitialized value $m1 in vec at - line 12.
 Use of uninitialized value $m1 in index at - line 14.
 Use of uninitialized value $m2 in index at - line 14.
 Use of uninitialized value $g1 in index at - line 15.
@@ -1144,8 +1141,8 @@ our @foo3=(1,undef); chop  @foo3;
 my  @foo4=(1,undef); chop  @foo4;
 our @foo5=(1,undef); $v = sprintf "%s%s",@foo5;
 my  @foo6=(1,undef); $v = sprintf "%s%s",@foo6;
-our %foo7=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s",%foo7;
-my  %foo8=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s",%foo8;
+our %foo7=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s%s%s",%foo7;
+my  %foo8=('foo'=>'bar','baz'=>undef); $v = sprintf "%s%s%s%s",%foo8;
 our @foo9 =(1,undef); $v = sprintf "%s%s%s%s",$m1,@foo9, $ma[2];
 my  @foo10=(1,undef); $v = sprintf "%s%s%s%s",$m2,@foo10,$ma[2];
 our %foo11=('foo'=>'bar','baz'=>undef); $v = join '', %foo11;
@@ -1226,8 +1223,6 @@ Use of uninitialized value $m1 in splice at - line 10.
 Use of uninitialized value $g1 in splice at - line 10.
 Use of uninitialized value in addition (+) at - line 10.
 Use of uninitialized value $m1 in method lookup at - line 13.
-Use of uninitialized value in subroutine entry at - line 15.
-Use of uninitialized value in subroutine entry at - line 16.
 Use of uninitialized value $m1 in warn at - line 18.
 Use of uninitialized value $g1 in warn at - line 18.
 foo at - line 18.
@@ -1962,7 +1957,7 @@ $v = 1 + prototype $fn;
 EXPECT
 Use of uninitialized value in addition (+) at - line 4.
 ########
-use warnings 'uninitialized';
+use warnings 'uninitialized'; no warnings 'experimental::smartmatch';
 my $v;
 my $fn = sub {};
 $v = 1 + (1 ~~ $fn);
@@ -2037,3 +2032,58 @@ use warnings 'uninitialized';
 "@{[ $x ]}";
 EXPECT
 Use of uninitialized value in join or string at - line 3.
+########
+# inside formats
+use warnings 'uninitialized';
+my $x;
+format =
+@
+"$x";
+.
+write;
+EXPECT
+Use of uninitialized value $x in string at - line 6.
+########
+# NAME off-by-one error in hash bucket walk in key detection logic
+use warnings 'uninitialized';
+
+for ( 0 .. 20 ) { # we assume that this means we test keys for every bucket
+    my %h= ( $_ => undef );
+    my $s= sprintf "%s", $h{$_};
+}
+EXPECT
+Use of uninitialized value $h{"0"} in sprintf at - line 5.
+Use of uninitialized value $h{"1"} in sprintf at - line 5.
+Use of uninitialized value $h{"2"} in sprintf at - line 5.
+Use of uninitialized value $h{"3"} in sprintf at - line 5.
+Use of uninitialized value $h{"4"} in sprintf at - line 5.
+Use of uninitialized value $h{"5"} in sprintf at - line 5.
+Use of uninitialized value $h{"6"} in sprintf at - line 5.
+Use of uninitialized value $h{"7"} in sprintf at - line 5.
+Use of uninitialized value $h{"8"} in sprintf at - line 5.
+Use of uninitialized value $h{"9"} in sprintf at - line 5.
+Use of uninitialized value $h{"10"} in sprintf at - line 5.
+Use of uninitialized value $h{"11"} in sprintf at - line 5.
+Use of uninitialized value $h{"12"} in sprintf at - line 5.
+Use of uninitialized value $h{"13"} in sprintf at - line 5.
+Use of uninitialized value $h{"14"} in sprintf at - line 5.
+Use of uninitialized value $h{"15"} in sprintf at - line 5.
+Use of uninitialized value $h{"16"} in sprintf at - line 5.
+Use of uninitialized value $h{"17"} in sprintf at - line 5.
+Use of uninitialized value $h{"18"} in sprintf at - line 5.
+Use of uninitialized value $h{"19"} in sprintf at - line 5.
+Use of uninitialized value $h{"20"} in sprintf at - line 5.
+########
+# NAME SvPOK && SvLEN==0 should not produce uninit warning
+use warnings 'uninitialized';
+
+$v = int(${qr||}); # sv_2iv on a regexp
+$v = 1.1 *  ${qr||}; # sv_2nv on a regexp
+$v = ${qr||} << 2; # sv_2uv on a regexp
+
+sub TIESCALAR{bless[]}
+sub FETCH {${qr||}}
+tie $t, "";
+$v = 1.1 * $t; # sv_2nv on a tied regexp
+
+EXPECT
diff --git a/gnu/usr.bin/perl/t/lib/warnings/doio b/gnu/usr.bin/perl/t/lib/warnings/doio
index 732f66d3184..37b55e3e770 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/doio
+++ b/gnu/usr.bin/perl/t/lib/warnings/doio
@@ -159,10 +159,16 @@ Unsuccessful stat on filename containing newline at - line 4.
 # doio.c [Perl_my_stat]
 use warnings 'io';
 -l STDIN;
+-l $fh;
+open $fh, $0 or die "# $!";
+-l $fh;
 no warnings 'io';
 -l STDIN;
+-l $fh;
+close $fh;
 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;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/gv b/gnu/usr.bin/perl/t/lib/warnings/gv
index 6101f691320..6b022e1294c 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/gv
+++ b/gnu/usr.bin/perl/t/lib/warnings/gv
@@ -63,6 +63,56 @@ $# is no longer supported at - line 2.
 $* is no longer supported at - line 3.
 ########
 # gv.c
+$a = ${#};
+$a = ${*};
+no warnings 'deprecated' ;
+$a = ${#};
+$a = ${*};
+EXPECT
+$# is no longer supported at - line 2.
+$* is no longer supported at - line 3.
+########
+# gv.c
+$a = $#;
+$a = $*;
+$# = $a;
+$* = $a;
+$a = \$#;
+$a = \$*;
+no warnings 'deprecated' ;
+$a = $#;
+$a = $*;
+$# = $a;
+$* = $a;
+$a = \$#;
+$a = \$*;
+EXPECT
+$# is no longer supported at - line 2.
+$* is no longer supported at - line 3.
+$# is no longer supported at - line 4.
+$* is no longer supported at - line 5.
+$# is no longer supported at - line 6.
+$* is no longer supported at - line 7.
+########
+# gv.c
+@a = @#;
+@a = @*;
+$a = $#;
+$a = $*;
+EXPECT
+$# is no longer supported at - line 4.
+$* is no longer supported at - line 5.
+########
+# gv.c
+$a = $#;
+$a = $*;
+@a = @#;
+@a = @*;
+EXPECT
+$# is no longer supported at - line 2.
+$* is no longer supported at - line 3.
+########
+# gv.c
 use warnings 'syntax' ;
 use utf8;
 use open qw( :utf8 :std );
diff --git a/gnu/usr.bin/perl/t/lib/warnings/op b/gnu/usr.bin/perl/t/lib/warnings/op
index de74d2e3604..83d3705f560 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/op
+++ b/gnu/usr.bin/perl/t/lib/warnings/op
@@ -1,5 +1,8 @@
   op.c		AOK
 
+     Use of my $_ is experimental
+	my $_ ;
+
      Found = in conditional, should be ==
 	1 if $a = 1 ;
 
@@ -73,6 +76,8 @@
      	(Maybe you should just omit the defined()?)
 	my %h ; defined %h ;
 
+     "my %s" used in sort comparison
+
      $[ used in comparison (did you mean $] ?)
 
      length() used on @array (did you mean "scalar(@array)"?)
@@ -97,18 +102,33 @@
         sub fred() ;
         sub fred($) {}
 
-    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 $_;
+EXPECT
+Use of my $_ is experimental at - line 3.
+Use of state $_ is experimental at - line 4.
+########
+# op.c
 use warnings 'syntax' ;
 1 if $a = 1 ;
+1 if $a
+  = 1 ;
 no warnings 'syntax' ;
 1 if $a = 1 ;
+1 if $a
+  = 1 ;
 EXPECT
 Found = in conditional, should be == at - line 3.
+Found = in conditional, should be == at - line 4.
 ########
 # op.c
 use warnings 'syntax' ;
@@ -148,8 +168,10 @@ Using an array as a reference is deprecated at - line 9.
 Using an array as a reference is deprecated at - line 10.
 ########
 # op.c
-use warnings 'void' ; close STDIN ;
-1 x 3 ;			# OP_REPEAT
+use warnings 'void' ; no warnings 'experimental::smartmatch'; close STDIN ;
+#line 2
+1 x 3 ;			# OP_REPEAT (folded)
+(1) x 3 ;		# OP_REPEAT
 			# OP_GVSV
 wantarray ; 		# OP_WANTARRAY
 			# OP_GV
@@ -206,6 +228,7 @@ $a <=> $b;		# OP_NCMP
 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.
@@ -660,28 +683,43 @@ 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' ;
@@ -722,10 +760,15 @@ EXPECT
 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' ;
@@ -749,6 +792,28 @@ 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 }
@@ -840,8 +905,13 @@ 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;
@@ -926,6 +996,116 @@ 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';
@@ -1360,3 +1540,24 @@ sub ᚠርƊ () { 1 }
 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\.
+########
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pad b/gnu/usr.bin/perl/t/lib/warnings/pad
index b226239ab1b..03c4ddb7c06 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pad
+++ b/gnu/usr.bin/perl/t/lib/warnings/pad
@@ -173,7 +173,7 @@ sub {
 }->();
 f();
 EXPECT
-Variable "$x" is not available at (eval 1) line 2.
+Variable "$x" is not available at (eval 1) line 1.
 ########
 # pad.c
 use warnings 'closure' ;
@@ -195,7 +195,7 @@ sub f {
 }
 f()->();
 EXPECT
-Variable "$x" is not available at (eval 1) line 2.
+Variable "$x" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 {
@@ -205,7 +205,7 @@ use warnings 'closure' ;
 }
 f2();
 EXPECT
-Variable "$x" is not available at (eval 1) line 2.
+Variable "$x" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 for my $x (1,2,3) {
@@ -214,7 +214,7 @@ for my $x (1,2,3) {
 }
 f();
 EXPECT
-Variable "$x" is not available at (eval 4) line 2.
+Variable "$x" is not available at (eval 4) line 1.
 ########
 # pad.c
 no warnings 'closure' ;
@@ -433,7 +433,7 @@ sub {
 }->();
 f();
 EXPECT
-Variable "$に" is not available at (eval 1) line 2.
+Variable "$に" is not available at (eval 1) line 1.
 ########
 # pad.c
 # see bugid 1754
@@ -446,7 +446,7 @@ sub f {
 }
 f()->();
 EXPECT
-Variable "$に" is not available at (eval 1) line 2.
+Variable "$に" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 BEGIN { binmode STDERR, 'utf8'; }
@@ -458,7 +458,7 @@ BEGIN { binmode STDERR, 'utf8'; }
 }
 f2();
 EXPECT
-Variable "$に" is not available at (eval 1) line 2.
+Variable "$に" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 BEGIN { binmode STDERR, 'utf8'; }
@@ -469,7 +469,7 @@ for my $に (1,2,3) {
 }
 f();
 EXPECT
-Variable "$に" is not available at (eval 4) line 2.
+Variable "$に" is not available at (eval 4) line 1.
 ########
 # pad.c
 use warnings 'closure' ;
@@ -534,7 +534,7 @@ sub {
 }->();
 f();
 EXPECT
-Variable "$è" is not available at (eval 1) line 2.
+Variable "$è" is not available at (eval 1) line 1.
 ########
 # pad.c
 # see bugid 1754
@@ -547,7 +547,7 @@ sub f {
 }
 f()->();
 EXPECT
-Variable "$è" is not available at (eval 1) line 2.
+Variable "$è" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 BEGIN { binmode STDERR, 'utf8'; }
@@ -559,7 +559,7 @@ BEGIN { binmode STDERR, 'utf8'; }
 }
 f2();
 EXPECT
-Variable "$è" is not available at (eval 1) line 2.
+Variable "$è" is not available at (eval 1) line 1.
 ########
 use warnings 'closure' ;
 BEGIN { binmode STDERR, 'utf8'; }
@@ -570,5 +570,5 @@ for my $è (1,2,3) {
 }
 f();
 EXPECT
-Variable "$è" is not available at (eval 4) line 2.
+Variable "$è" is not available at (eval 4) line 1.
 ########
diff --git a/gnu/usr.bin/perl/t/lib/warnings/perl b/gnu/usr.bin/perl/t/lib/warnings/perl
index f619cc6a249..a00ed62b395 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/perl
+++ b/gnu/usr.bin/perl/t/lib/warnings/perl
@@ -223,3 +223,9 @@ BEGIN { $^W = 1 }
 $ŷ = 3 ;
 EXPECT
 Name "ɕლȃṢȿ::ŷ" used only once: possible typo at - line 9.
+########
+
+use warnings 'once';
+$foo++; BEGIN { eval q|@a =~ s///; sub foo;| }
+EXPECT
+Name "main::foo" used only once: possible typo at - line 3.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/perly b/gnu/usr.bin/perl/t/lib/warnings/perly
index d2b95607c00..c912c0ea3c3 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/perly
+++ b/gnu/usr.bin/perl/t/lib/warnings/perly
@@ -8,23 +8,6 @@
 	sub fred {} $a = "fred" ; do $a()
 	sub fred {} $a = "fred" ; do $a(1)
 
-  Use of qw(...) as parentheses is deprecated
-
-	if qw(a) {}
-	unless qw(a) {}
-	if (0) {} elsif qw(a) {}
-	given qw(a) {}
-	when qw(a) {}
-	while qw(a) {}
-	until qw(a) {}
-	foreach $x qw(a b c) {}
-	foreach my $x qw(a b c) {}
-	$obj->meth qw(a b c)
-	do foo qw(a b c)
-	do $subref qw(a b c)
-	&foo qw(a b c)
-	$a[0] qw(a b c)
-
 __END__
 # perly.y
 use warnings 'deprecated' ;
@@ -45,222 +28,3 @@ Use of "do" to call subroutines is deprecated at - line 4.
 Use of "do" to call subroutines is deprecated at - line 5.
 Use of "do" to call subroutines is deprecated at - line 7.
 Use of "do" to call subroutines is deprecated at - line 8.
-########
-use warnings qw(deprecated void);
-if qw(a) { print "x0\n"; } else { }
-if qw(0) { print "x1\n"; } else { }
-if qw(z a) { print "x2\n"; } else { }
-if qw(z 0) { print "x3\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x0
-x2
-########
-if qw() { print "x0\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "if qw()"
-Execution of - aborted due to compilation errors.
-########
-use warnings qw(deprecated void);
-unless qw(a) { print "x0\n"; } else { }
-unless qw(0) { print "x1\n"; } else { }
-unless qw(z a) { print "x2\n"; } else { }
-unless qw(z 0) { print "x3\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x1
-x3
-########
-unless qw() { print "x0\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "unless qw()"
-Execution of - aborted due to compilation errors.
-########
-use warnings qw(deprecated void);
-if(0) { print "eek\n"; } elsif qw(a) { print "x0\n"; } else { }
-if(0) { print "eek\n"; } elsif qw(0) { print "x1\n"; } else { }
-if(0) { print "eek\n"; } elsif qw(z a) { print "x2\n"; } else { }
-if(0) { print "eek\n"; } elsif qw(z 0) { print "x3\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x0
-x2
-########
-if(0) { print "eek\n"; } elsif qw() { print "x0\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "elsif qw()"
-Execution of - aborted due to compilation errors.
-########
-use warnings qw(deprecated void); use feature "switch";
-given qw(a) { print "x0 $_\n"; }
-given qw(z a) { print "x1 $_\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Useless use of a constant ("z") in void context at - line 3.
-x0 a
-x1 a
-########
-use feature "switch";
-given qw() { print "x0\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-syntax error at - line 2, near "given qw()"
-Execution of - aborted due to compilation errors.
-########
-use warnings qw(deprecated void); use feature "switch";
-given("a") { when qw(a) { print "x0\n"; } }
-given("a") { when qw(b) { print "x1\n"; } }
-given("a") { when qw(z a) { print "x2\n"; } }
-given("a") { when qw(z b) { print "x3\n"; } }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x0
-x2
-########
-use feature "switch";
-given("a") { when qw() { print "x0\n"; } }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-syntax error at - line 2, near "when qw()"
-syntax error at - line 2, near "} }"
-Execution of - aborted due to compilation errors.
-########
-use warnings qw(deprecated void);
-while qw(a) { print "x0\n"; last; } {;}
-while qw(0) { print "x1\n"; last; } {;}
-while qw(z a) { print "x2\n"; last; } {;}
-while qw(z 0) { print "x3\n"; last; } {;}
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x0
-x2
-########
-while qw() { print "x0\n"; last; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-x0
-########
-use warnings qw(deprecated void);
-until qw(a) { print "x0\n"; last; } {;}
-until qw(0) { print "x1\n"; last; } {;}
-until qw(z a) { print "x2\n"; last; } {;}
-until qw(z 0) { print "x3\n"; last; } {;}
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of qw(...) as parentheses is deprecated at - line 4.
-Useless use of a constant ("z") in void context at - line 4.
-Use of qw(...) as parentheses is deprecated at - line 5.
-Useless use of a constant ("z") in void context at - line 5.
-x1
-x3
-########
-until qw() { print "x0\n"; } else { }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "until qw()"
-Execution of - aborted due to compilation errors.
-########
-foreach $x qw(a b c) { print $x, "\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-a
-b
-c
-########
-foreach $x qw() { print $x, "\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "$x qw()"
-Execution of - aborted due to compilation errors.
-########
-foreach my $x qw(a b c) { print $x, "\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-a
-b
-c
-########
-foreach my $x qw() { print $x, "\n"; }
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 1.
-syntax error at - line 1, near "$x qw()"
-Execution of - aborted due to compilation errors.
-########
-sub a5c85eef3bf30129e20989e96b099d13::foo { print "+", join(":", @_), "\n"; }
-"a5c85eef3bf30129e20989e96b099d13"->foo qw(); {;}
-"a5c85eef3bf30129e20989e96b099d13"->foo qw(a b c); {;}
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-+a5c85eef3bf30129e20989e96b099d13
-+a5c85eef3bf30129e20989e96b099d13:a:b:c
-########
-sub fd4de2af1449cec72693c36842d41862 { print "+", join(":", @_), "\n"; }
-do fd4de2af1449cec72693c36842d41862 qw(); {;}
-do fd4de2af1449cec72693c36842d41862 qw(a b c); {;}
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of "do" to call subroutines is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of "do" to call subroutines is deprecated at - line 3.
-+
-+a:b:c
-########
-$subref = sub { print "+", join(":", @_), "\n"; };
-do $subref qw();
-do $subref qw(a b c);
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of "do" to call subroutines is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-Use of "do" to call subroutines is deprecated at - line 3.
-+
-+a:b:c
-########
-sub e293a8f7cb38880a48867fcb336448e5 { print "+", join(":", @_), "\n"; }
-&e293a8f7cb38880a48867fcb336448e5 qw();
-&e293a8f7cb38880a48867fcb336448e5 qw(a b c);
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-+
-+a:b:c
-########
-my @a = (sub { print "+", join(":", @_), "\n"; });
-$a[0] qw();
-$a[0] qw(a b c);
-EXPECT
-Use of qw(...) as parentheses is deprecated at - line 2.
-Use of qw(...) as parentheses is deprecated at - line 3.
-+
-+a:b:c
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp b/gnu/usr.bin/perl/t/lib/warnings/pp
index 89ebcbcbc47..ab8f9516518 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp
@@ -37,10 +37,16 @@ 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' ;
diff --git a/gnu/usr.bin/perl/t/lib/warnings/pp_hot b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
index 9ef68e01eba..ad63d2a935f 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/pp_hot
+++ b/gnu/usr.bin/perl/t/lib/warnings/pp_hot
@@ -61,6 +61,15 @@ 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
@@ -90,6 +99,24 @@ 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";
diff --git a/gnu/usr.bin/perl/t/lib/warnings/regcomp b/gnu/usr.bin/perl/t/lib/warnings/regcomp
index b435d2a1da6..19b6b06f6f4 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/regcomp
+++ b/gnu/usr.bin/perl/t/lib/warnings/regcomp
@@ -1,266 +1,3 @@
-  regcomp.c	AOK
-
-  Quantifier unexpected on zero-length expression [S_study_chunk] 
-
-  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]
+  regcomp.c	These tests have been moved to t/re/reg_mesg.t
 
 __END__
-# regcomp.c [S_regpiece]
-use warnings 'regexp' ;
-my $a = "ABC123" ; 
-$a =~ /(?=a)*/ ;
-no warnings 'regexp' ;
-$a =~ /(?=a)*/ ;
-EXPECT
-(?=a)* matches null string many times 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_regatom]
-# The \q should warn, the \_ should NOT warn.
-use warnings 'regexp';
-"foo" =~ /\q/;
-"foo" =~ /\q{/;
-"foo" =~ /a\b{cde/;
-"foo" =~ /a\B{cde/;
-"bar" =~ /\_/;
-no warnings 'regexp';
-"foo" =~ /\q/;
-"foo" =~ /\q{/;
-"foo" =~ /a\b{cde/;
-"foo" =~ /a\B{cde/;
-"bar" =~ /\_/;
-EXPECT
-Unrecognized escape \q passed through in regex; marked by <-- HERE in m/\q <-- HERE / at - line 4.
-Unrecognized escape \q{ passed through in regex; marked by <-- HERE in m/\q{ <-- HERE / at - line 5.
-"\b{" is deprecated; use "\b\{" instead in regex; marked by <-- HERE in m/a\ <-- HERE b{cde/ at - line 6.
-"\B{" is deprecated; use "\B\{" instead in regex; marked by <-- HERE in m/a\ <-- HERE B{cde/ at - line 7.
-########
-# 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 / at - line 5.
-########
-# 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_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
-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.
-########
-# regcomp.c [S_regatom]
-$a = qr/\o{/;
-EXPECT
-Missing right brace on \o{ in regex; marked by <-- HERE in m/\o{ <-- HERE / at - line 2.
-########
-# regcomp.c [S_regatom]
-$a = qr/\o/;
-EXPECT
-Missing braces on \o{} in regex; marked by <-- HERE in m/\o <-- HERE / at - line 2.
-########
-# regcomp.c [S_regatom]
-$a = qr/\o{}/;
-EXPECT
-Number with no digits in regex; marked by <-- HERE in m/\o{} <-- HERE / at - line 2.
-########
-# regcomp.c [S_regclass]
-$a = qr/[\o{]/;
-EXPECT
-Missing right brace on \o{ in regex; marked by <-- HERE in m/[\o{ <-- HERE ]/ at - line 2.
-########
-# regcomp.c [S_regclass]
-$a = qr/[\o]/;
-EXPECT
-Missing braces on \o{} in regex; marked by <-- HERE in m/[\o <-- HERE ]/ at - line 2.
-########
-# regcomp.c [S_regclass]
-$a = qr/[\o{}]/;
-EXPECT
-Number with no digits in regex; marked by <-- HERE in m/[\o{} <-- HERE ]/ at - line 2.
-########
-# regcomp.c [S_regclass]
-use warnings 'regexp' ;
-$a = qr/[\8\9]/;
-$a = qr/[\_\0]/; # Should have no warnings on this and the remainder of this test
-$a = qr/[\07]/;
-$a = qr/[\006]/;
-$a = qr/[\0005]/;
-no warnings 'regexp' ;
-$a = qr/[\8\9]/;
-EXPECT
-Unrecognized escape \8 in character class passed through in regex; marked by <-- HERE in m/[\8 <-- HERE \9]/ at - line 3.
-Unrecognized escape \9 in character class passed through in regex; marked by <-- HERE in m/[\8\9 <-- HERE ]/ at - line 3.
-########
-# regcomp.c [Perl_re_compile]
-$a = qr/(?^-i:foo)/;
-EXPECT
-Sequence (?^-...) not recognized in regex; marked by <-- HERE in m/(?^- <-- HERE i:foo)/ at - line 2.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/toke b/gnu/usr.bin/perl/t/lib/warnings/toke
index dd8dc3d517a..5ee3ad52109 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/toke
+++ b/gnu/usr.bin/perl/t/lib/warnings/toke
@@ -143,19 +143,39 @@ Use of comma-less variable list is deprecated at - line 4.
 Use of comma-less variable list is deprecated at - line 4.
 ########
 # toke.c
-$a =~ m/$foo/sand $bar;
-$a =~ s/$foo/fool/sand $bar;
 $a = <<;
 
 no warnings 'deprecated' ;
-$a =~ m/$foo/sand $bar;
-$a =~ s/$foo/fool/sand $bar;
 $a = <<;
 
 EXPECT
-Having no space between pattern and following word is deprecated at - line 2.
-Having no space between pattern and following word is deprecated at - line 3.
-Use of bare << to mean <<"" is deprecated at - line 4.
+Use of bare << to mean <<"" is deprecated at - line 2.
+########
+# toke.c
+$a =~ m/$foo/eq;
+$a =~ s/$foo/fool/seq;
+
+EXPECT
+OPTION fatal
+Unknown regexp modifier "/e" at - line 2, near "=~ "
+Unknown regexp modifier "/q" at - line 2, near "=~ "
+Unknown regexp modifier "/q" at - line 3, near "=~ "
+Execution of - aborted due to compilation errors.
+########
+# toke.c
+use utf8;
+use open qw( :utf8 :std );
+$a =~ m/$foo/eネq;
+$a =~ s/$foo/fool/seネq;
+
+EXPECT
+OPTION fatal
+Unknown regexp modifier "/e" at - line 4, near "=~ "
+Unknown regexp modifier "/ネ" at - line 4, near "=~ "
+Unknown regexp modifier "/q" at - line 4, near "=~ "
+Unknown regexp modifier "/ネ" at - line 5, near "=~ "
+Unknown regexp modifier "/q" at - line 5, near "=~ "
+Execution of - aborted due to compilation errors.
 ########
 # toke.c
 use warnings 'syntax' ;
@@ -662,6 +682,8 @@ yelp at foo line 30.
 ########
 # toke.c
 my $a = rand + 4 ;
+$a = rand *^H ;
+$a = rand $^H ;
 EXPECT
 Warning: Use of "rand" without parentheses is ambiguous at - line 2.
 ########
@@ -696,6 +718,8 @@ EXPECT
 # toke.c
 sub fred {};
 -fred ;
+sub hank : lvalue {$_}
+--hank; # This should *not* warn [perl #77240]
 EXPECT
 Ambiguous use of -fred resolved as -&fred() at - line 3.
 ########
@@ -1063,7 +1087,7 @@ Number found where operator expected at (eval 1) line 1, near "5 6"
 	(Missing operator before  6?)
 ########
 # toke.c
-use warnings "syntax";
+use warnings "syntax"; no warnings "deprecated";
 $_ = $a = 1;
 $a !=~  /1/;
 $a !=~ m#1#;
@@ -1111,7 +1135,7 @@ Use of :locked is deprecated at - line 4.
 Use of :locked is deprecated at - line 6.
 ########
 # toke.c
-use warnings "syntax";
+use warnings "syntax"; use feature 'lexical_subs';
 sub proto_after_array(@$);
 sub proto_after_arref(\@$);
 sub proto_after_arref2(\[@$]);
@@ -1123,6 +1147,14 @@ sub underscore_last_pos($_);
 sub underscore2($_;$);
 sub underscore_fail($_$);
 sub underscore_after_at(@_);
+our sub hour (@$);
+my sub migh (@$);
+use feature 'state';
+state sub estate (@$);
+package other;
+sub hour (@$);
+sub migh (@$);
+sub estate (@$);
 no warnings "syntax";
 sub proto_after_array(@$);
 sub proto_after_hash(%$);
@@ -1132,6 +1164,15 @@ Prototype after '@' for main::proto_after_array : @$ at - line 3.
 Prototype after '%' for main::proto_after_hash : %$ at - line 7.
 Illegal character after '_' in prototype for main::underscore_fail : $_$ at - line 12.
 Prototype after '@' for main::underscore_after_at : @_ at - line 13.
+The lexical_subs feature is experimental at - line 14.
+Prototype after '@' for hour : @$ at - line 14.
+The lexical_subs feature is experimental at - line 15.
+Prototype after '@' for migh : @$ at - line 15.
+The lexical_subs feature is experimental at - line 17.
+Prototype after '@' for estate : @$ at - line 17.
+Prototype after '@' for hour : @$ at - line 19.
+Prototype after '@' for migh : @$ at - line 20.
+Prototype after '@' for estate : @$ at - line 21.
 ########
 # toke.c
 use warnings "ambiguous";
@@ -1250,3 +1291,45 @@ use warnings;
 CORE::렏;
 EXPECT
 CORE::렏 is not a keyword at - line 5.
+########
+# toke.c
+# [perl #16249]
+print '';
+eval this_method_is_fake ();
+EXPECT
+Undefined subroutine &main::this_method_is_fake called at - line 4.
+########
+# toke.c
+# [perl #107002] Erroneous ambiguity warnings
+sub { # do not actually call require
+  require a::b . 1; # These used to produce erroneous
+  require a::b + 1; # ambiguity warnings.
+}
+EXPECT
+########
+# toke.c
+# [perl #113094]
+print "aa" =~ m{^a\{1,2\}$}, "\n";
+print "aa" =~ m{^a\x\{61\}$}, "\n";
+print "aa" =~ m{^a{1,2}$}, "\n";
+print "aq" =~ m[^a\[a-z\]$], "\n";
+print "aq" =~ m(^a\(q\)$), "\n";
+no warnings 'deprecated';
+print "aa" =~ m{^a\{1,2\}$}, "\n";
+print "aa" =~ m{^a\x\{61\}$}, "\n";
+print "aq" =~ m[^a\[a-z\]$], "\n";
+print "aq" =~ m(^a\(q\)$), "\n";
+EXPECT
+Useless use of '\'; doesn't escape metacharacter '{' at - line 3.
+Useless use of '\'; doesn't escape metacharacter '{' at - line 4.
+Useless use of '\'; doesn't escape metacharacter '[' at - line 6.
+Useless use of '\'; doesn't escape metacharacter '(' at - line 7.
+1
+1
+1
+1
+q
+1
+1
+1
+q
diff --git a/gnu/usr.bin/perl/t/lib/warnings/utf8 b/gnu/usr.bin/perl/t/lib/warnings/utf8
index 603cfa0faf4..1274cf9f2f7 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/utf8
+++ b/gnu/usr.bin/perl/t/lib/warnings/utf8
@@ -170,7 +170,283 @@ chr(0x10000) =~ /\p{Any}/;
 chr(0x100000) =~ /\p{Any}/;
 chr(0x10FFFE) =~ /\p{Any}/;
 chr(0x10FFFF) =~ /\p{Any}/;
-chr(0x110000) =~ /\p{Any}/;
+chr(0x110000) =~ /[\w\p{Any}]/;
+chr(0x110010) =~ /[\w\p{PosixWord}]/;
+chr(0x110011) =~ /[\w\P{PosixWord}]/;
+chr(0x110012) =~ /[\w\p{XPosixWord}]/;
+chr(0x110013) =~ /[\w\P{XPosixWord}]/;
+chr(0x110014) =~ /[\w\p{PosixAlnum}]/;
+chr(0x110015) =~ /[\w\P{PosixAlnum}]/;
+chr(0x110016) =~ /[\w\p{XPosixAlnum}]/;
+chr(0x110017) =~ /[\w\P{XPosixAlnum}]/;
+chr(0x110018) =~ /[\w\p{PosixSpace}]/;
+chr(0x110019) =~ /[\w\P{PosixSpace}]/;
+chr(0x11001A) =~ /[\w\p{XPosixSpace}]/;
+chr(0x11001B) =~ /[\w\P{XPosixSpace}]/;
+chr(0x11001C) =~ /[\w\p{PosixDigit}]/;
+chr(0x11001D) =~ /[\w\P{PosixDigit}]/;
+chr(0x11001E) =~ /[\w\p{XPosixDigit}]/;
+chr(0x11001F) =~ /[\w\P{XPosixDigit}]/;
+chr(0x110020) =~ /[\w\p{PosixAlpha}]/;
+chr(0x110021) =~ /[\w\P{PosixAlpha}]/;
+chr(0x110022) =~ /[\w\p{XPosixAlpha}]/;
+chr(0x110023) =~ /[\w\P{XPosixAlpha}]/;
+chr(0x110024) =~ /[\w\p{Ascii}]/;
+chr(0x110025) =~ /[\w\P{Ascii}]/;
+chr(0x110026) =~ /[\w\p{PosixCntrl}]/;
+chr(0x110027) =~ /[\w\P{PosixCntrl}]/;
+chr(0x110028) =~ /[\w\p{XPosixCntrl}]/;
+chr(0x110029) =~ /[\w\P{XPosixCntrl}]/;
+chr(0x11002A) =~ /[\w\p{PosixGraph}]/;
+chr(0x11002B) =~ /[\w\P{PosixGraph}]/;
+chr(0x11002C) =~ /[\w\p{XPosixGraph}]/;
+chr(0x11002D) =~ /[\w\P{XPosixGraph}]/;
+chr(0x11002E) =~ /[\w\p{PosixLower}]/;
+chr(0x11002F) =~ /[\w\P{PosixLower}]/;
+chr(0x110030) =~ /[\w\p{XPosixLower}]/;
+chr(0x110031) =~ /[\w\P{XPosixLower}]/;
+chr(0x110032) =~ /[\w\p{PosixPrint}]/;
+chr(0x110033) =~ /[\w\P{PosixPrint}]/;
+chr(0x110034) =~ /[\w\p{XPosixPrint}]/;
+chr(0x110035) =~ /[\w\P{XPosixPrint}]/;
+chr(0x110036) =~ /[\w\p{PosixPunct}]/;
+chr(0x110037) =~ /[\w\P{PosixPunct}]/;
+chr(0x110038) =~ /[\w\p{XPosixPunct}]/;
+chr(0x110039) =~ /[\w\P{XPosixPunct}]/;
+chr(0x11003A) =~ /[\w\p{PosixUpper}]/;
+chr(0x11003B) =~ /[\w\P{PosixUpper}]/;
+chr(0x11003C) =~ /[\w\p{XPosixUpper}]/;
+chr(0x11003D) =~ /[\w\P{XPosixUpper}]/;
+chr(0x11003E) =~ /[\w\p{PosixXdigit}]/;
+chr(0x11003F) =~ /[\w\P{PosixXdigit}]/;
+chr(0x110040) =~ /[\w\p{XPosixXdigit}]/;
+chr(0x110041) =~ /[\w\P{XPosixXdigit}]/;
+chr(0x110042) =~ /[\w\p{PerlSpace}]/;
+chr(0x110043) =~ /[\w\P{PerlSpace}]/;
+chr(0x110044) =~ /[\w\p{XPerlSpace}]/;
+chr(0x110045) =~ /[\w\P{XPerlSpace}]/;
+chr(0x110046) =~ /[\w\p{PosixBlank}]/;
+chr(0x110047) =~ /[\w\P{PosixBlank}]/;
+chr(0x110048) =~ /[\w\p{XPosixBlank}]/;
+chr(0x110049) =~ /[\w\P{XPosixBlank}]/;
+# Currently some warnings from the above are output twice
+# Only Unicode properties give non-Unicode warnings, 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(0x111000) =~ /[\W\p{Any}]/;
+chr(0x111010) =~ /[\W\p{PosixWord}]/;
+chr(0x111011) =~ /[\W\P{PosixWord}]/;
+chr(0x111012) =~ /[\W\p{XPosixWord}]/;
+chr(0x111013) =~ /[\W\P{XPosixWord}]/;
+chr(0x111014) =~ /[\W\p{PosixAlnum}]/;
+chr(0x111015) =~ /[\W\P{PosixAlnum}]/;
+chr(0x111016) =~ /[\W\p{XPosixAlnum}]/;
+chr(0x111017) =~ /[\W\P{XPosixAlnum}]/;
+chr(0x111018) =~ /[\W\p{PosixSpace}]/;
+chr(0x111019) =~ /[\W\P{PosixSpace}]/;
+chr(0x11101A) =~ /[\W\p{XPosixSpace}]/;
+chr(0x11101B) =~ /[\W\P{XPosixSpace}]/;
+chr(0x11101C) =~ /[\W\p{PosixDigit}]/;
+chr(0x11101D) =~ /[\W\P{PosixDigit}]/;
+chr(0x11101E) =~ /[\W\p{XPosixDigit}]/;
+chr(0x11101F) =~ /[\W\P{XPosixDigit}]/;
+chr(0x111020) =~ /[\W\p{PosixAlpha}]/;
+chr(0x111021) =~ /[\W\P{PosixAlpha}]/;
+chr(0x111022) =~ /[\W\p{XPosixAlpha}]/;
+chr(0x111023) =~ /[\W\P{XPosixAlpha}]/;
+chr(0x111024) =~ /[\W\p{Ascii}]/;
+chr(0x111025) =~ /[\W\P{Ascii}]/;
+chr(0x111026) =~ /[\W\p{PosixCntrl}]/;
+chr(0x111027) =~ /[\W\P{PosixCntrl}]/;
+chr(0x111028) =~ /[\W\p{XPosixCntrl}]/;
+chr(0x111029) =~ /[\W\P{XPosixCntrl}]/;
+chr(0x11102A) =~ /[\W\p{PosixGraph}]/;
+chr(0x11102B) =~ /[\W\P{PosixGraph}]/;
+chr(0x11102C) =~ /[\W\p{XPosixGraph}]/;
+chr(0x11102D) =~ /[\W\P{XPosixGraph}]/;
+chr(0x11102E) =~ /[\W\p{PosixLower}]/;
+chr(0x11102F) =~ /[\W\P{PosixLower}]/;
+chr(0x111030) =~ /[\W\p{XPosixLower}]/;
+chr(0x111031) =~ /[\W\P{XPosixLower}]/;
+chr(0x111032) =~ /[\W\p{PosixPrint}]/;
+chr(0x111033) =~ /[\W\P{PosixPrint}]/;
+chr(0x111034) =~ /[\W\p{XPosixPrint}]/;
+chr(0x111035) =~ /[\W\P{XPosixPrint}]/;
+chr(0x111036) =~ /[\W\p{PosixPunct}]/;
+chr(0x111037) =~ /[\W\P{PosixPunct}]/;
+chr(0x111038) =~ /[\W\p{XPosixPunct}]/;
+chr(0x111039) =~ /[\W\P{XPosixPunct}]/;
+chr(0x11103A) =~ /[\W\p{PosixUpper}]/;
+chr(0x11103B) =~ /[\W\P{PosixUpper}]/;
+chr(0x11103C) =~ /[\W\p{XPosixUpper}]/;
+chr(0x11103D) =~ /[\W\P{XPosixUpper}]/;
+chr(0x11103E) =~ /[\W\p{PosixXdigit}]/;
+chr(0x11103F) =~ /[\W\P{PosixXdigit}]/;
+chr(0x111040) =~ /[\W\p{XPosixXdigit}]/;
+chr(0x111041) =~ /[\W\P{XPosixXdigit}]/;
+chr(0x111042) =~ /[\W\p{PerlSpace}]/;
+chr(0x111043) =~ /[\W\P{PerlSpace}]/;
+chr(0x111044) =~ /[\W\p{XPerlSpace}]/;
+chr(0x111045) =~ /[\W\P{XPerlSpace}]/;
+chr(0x111046) =~ /[\W\p{PosixBlank}]/;
+chr(0x111047) =~ /[\W\P{PosixBlank}]/;
+chr(0x111048) =~ /[\W\p{XPosixBlank}]/;
+chr(0x111049) =~ /[\W\P{XPosixBlank}]/;
+chr(0x112000) =~ /[\S\p{Any}]/;
+chr(0x112010) =~ /[\S\p{PosixWord}]/;
+chr(0x112011) =~ /[\S\P{PosixWord}]/;
+chr(0x112012) =~ /[\S\p{XPosixWord}]/;
+chr(0x112013) =~ /[\S\P{XPosixWord}]/;
+chr(0x112014) =~ /[\S\p{PosixAlnum}]/;
+chr(0x112015) =~ /[\S\P{PosixAlnum}]/;
+chr(0x112016) =~ /[\S\p{XPosixAlnum}]/;
+chr(0x112017) =~ /[\S\P{XPosixAlnum}]/;
+chr(0x112018) =~ /[\S\p{PosixSpace}]/;
+chr(0x112019) =~ /[\S\P{PosixSpace}]/;
+chr(0x11201A) =~ /[\S\p{XPosixSpace}]/;
+chr(0x11201B) =~ /[\S\P{XPosixSpace}]/;
+chr(0x11201C) =~ /[\S\p{PosixDigit}]/;
+chr(0x11201D) =~ /[\S\P{PosixDigit}]/;
+chr(0x11201E) =~ /[\S\p{XPosixDigit}]/;
+chr(0x11201F) =~ /[\S\P{XPosixDigit}]/;
+chr(0x112020) =~ /[\S\p{PosixAlpha}]/;
+chr(0x112021) =~ /[\S\P{PosixAlpha}]/;
+chr(0x112022) =~ /[\S\p{XPosixAlpha}]/;
+chr(0x112023) =~ /[\S\P{XPosixAlpha}]/;
+chr(0x112024) =~ /[\S\p{Ascii}]/;
+chr(0x112025) =~ /[\S\P{Ascii}]/;
+chr(0x112026) =~ /[\S\p{PosixCntrl}]/;
+chr(0x112027) =~ /[\S\P{PosixCntrl}]/;
+chr(0x112028) =~ /[\S\p{XPosixCntrl}]/;
+chr(0x112029) =~ /[\S\P{XPosixCntrl}]/;
+chr(0x11202A) =~ /[\S\p{PosixGraph}]/;
+chr(0x11202B) =~ /[\S\P{PosixGraph}]/;
+chr(0x11202C) =~ /[\S\p{XPosixGraph}]/;
+chr(0x11202D) =~ /[\S\P{XPosixGraph}]/;
+chr(0x11202E) =~ /[\S\p{PosixLower}]/;
+chr(0x11202F) =~ /[\S\P{PosixLower}]/;
+chr(0x112030) =~ /[\S\p{XPosixLower}]/;
+chr(0x112031) =~ /[\S\P{XPosixLower}]/;
+chr(0x112032) =~ /[\S\p{PosixPrint}]/;
+chr(0x112033) =~ /[\S\P{PosixPrint}]/;
+chr(0x112034) =~ /[\S\p{XPosixPrint}]/;
+chr(0x112035) =~ /[\S\P{XPosixPrint}]/;
+chr(0x112036) =~ /[\S\p{PosixPunct}]/;
+chr(0x112037) =~ /[\S\P{PosixPunct}]/;
+chr(0x112038) =~ /[\S\p{XPosixPunct}]/;
+chr(0x112039) =~ /[\S\P{XPosixPunct}]/;
+chr(0x11203A) =~ /[\S\p{PosixUpper}]/;
+chr(0x11203B) =~ /[\S\P{PosixUpper}]/;
+chr(0x11203C) =~ /[\S\p{XPosixUpper}]/;
+chr(0x11203D) =~ /[\S\P{XPosixUpper}]/;
+chr(0x11203E) =~ /[\S\p{PosixXdigit}]/;
+chr(0x11203F) =~ /[\S\P{PosixXdigit}]/;
+chr(0x112040) =~ /[\S\p{XPosixXdigit}]/;
+chr(0x112041) =~ /[\S\P{XPosixXdigit}]/;
+chr(0x112042) =~ /[\S\p{PerlSpace}]/;
+chr(0x112043) =~ /[\S\P{PerlSpace}]/;
+chr(0x112044) =~ /[\S\p{XPerlSpace}]/;
+chr(0x112045) =~ /[\S\P{XPerlSpace}]/;
+chr(0x112046) =~ /[\S\p{PosixBlank}]/;
+chr(0x112047) =~ /[\S\P{PosixBlank}]/;
+chr(0x112048) =~ /[\S\p{XPosixBlank}]/;
+chr(0x112049) =~ /[\S\P{XPosixBlank}]/;
+chr(0x113000) =~ /[\x{110000}\p{Any}]/;
+chr(0x113010) =~ /[\x{110000}\p{PosixWord}]/;
+chr(0x113011) =~ /[\x{110000}\P{PosixWord}]/;
+chr(0x113012) =~ /[\x{110000}\p{XPosixWord}]/;
+chr(0x113013) =~ /[\x{110000}\P{XPosixWord}]/;
+chr(0x113014) =~ /[\x{110000}\p{PosixAlnum}]/;
+chr(0x113015) =~ /[\x{110000}\P{PosixAlnum}]/;
+chr(0x113016) =~ /[\x{110000}\p{XPosixAlnum}]/;
+chr(0x113017) =~ /[\x{110000}\P{XPosixAlnum}]/;
+chr(0x113018) =~ /[\x{110000}\p{PosixSpace}]/;
+chr(0x113019) =~ /[\x{110000}\P{PosixSpace}]/;
+chr(0x11301A) =~ /[\x{110000}\p{XPosixSpace}]/;
+chr(0x11301B) =~ /[\x{110000}\P{XPosixSpace}]/;
+chr(0x11301C) =~ /[\x{110000}\p{PosixDigit}]/;
+chr(0x11301D) =~ /[\x{110000}\P{PosixDigit}]/;
+chr(0x11301E) =~ /[\x{110000}\p{XPosixDigit}]/;
+chr(0x11301F) =~ /[\x{110000}\P{XPosixDigit}]/;
+chr(0x113020) =~ /[\x{110000}\p{PosixAlpha}]/;
+chr(0x113021) =~ /[\x{110000}\P{PosixAlpha}]/;
+chr(0x113022) =~ /[\x{110000}\p{XPosixAlpha}]/;
+chr(0x113023) =~ /[\x{110000}\P{XPosixAlpha}]/;
+chr(0x113024) =~ /[\x{110000}\p{Ascii}]/;
+chr(0x113025) =~ /[\x{110000}\P{Ascii}]/;
+chr(0x113026) =~ /[\x{110000}\p{PosixCntrl}]/;
+chr(0x113027) =~ /[\x{110000}\P{PosixCntrl}]/;
+chr(0x113028) =~ /[\x{110000}\p{XPosixCntrl}]/;
+chr(0x113029) =~ /[\x{110000}\P{XPosixCntrl}]/;
+chr(0x11302A) =~ /[\x{110000}\p{PosixGraph}]/;
+chr(0x11302B) =~ /[\x{110000}\P{PosixGraph}]/;
+chr(0x11302C) =~ /[\x{110000}\p{XPosixGraph}]/;
+chr(0x11302D) =~ /[\x{110000}\P{XPosixGraph}]/;
+chr(0x11302E) =~ /[\x{110000}\p{PosixLower}]/;
+chr(0x11302F) =~ /[\x{110000}\P{PosixLower}]/;
+chr(0x113030) =~ /[\x{110000}\p{XPosixLower}]/;
+chr(0x113031) =~ /[\x{110000}\P{XPosixLower}]/;
+chr(0x113032) =~ /[\x{110000}\p{PosixPrint}]/;
+chr(0x113033) =~ /[\x{110000}\P{PosixPrint}]/;
+chr(0x113034) =~ /[\x{110000}\p{XPosixPrint}]/;
+chr(0x113035) =~ /[\x{110000}\P{XPosixPrint}]/;
+chr(0x113036) =~ /[\x{110000}\p{PosixPunct}]/;
+chr(0x113037) =~ /[\x{110000}\P{PosixPunct}]/;
+chr(0x113038) =~ /[\x{110000}\p{XPosixPunct}]/;
+chr(0x113039) =~ /[\x{110000}\P{XPosixPunct}]/;
+chr(0x11303A) =~ /[\x{110000}\p{PosixUpper}]/;
+chr(0x11303B) =~ /[\x{110000}\P{PosixUpper}]/;
+chr(0x11303C) =~ /[\x{110000}\p{XPosixUpper}]/;
+chr(0x11303D) =~ /[\x{110000}\P{XPosixUpper}]/;
+chr(0x11303E) =~ /[\x{110000}\p{PosixXdigit}]/;
+chr(0x11303F) =~ /[\x{110000}\P{PosixXdigit}]/;
+chr(0x113040) =~ /[\x{110000}\p{XPosixXdigit}]/;
+chr(0x113041) =~ /[\x{110000}\P{XPosixXdigit}]/;
+chr(0x113042) =~ /[\x{110000}\p{PerlSpace}]/;
+chr(0x113043) =~ /[\x{110000}\P{PerlSpace}]/;
+chr(0x113044) =~ /[\x{110000}\p{XPerlSpace}]/;
+chr(0x113045) =~ /[\x{110000}\P{XPerlSpace}]/;
+chr(0x113046) =~ /[\x{110000}\p{PosixBlank}]/;
+chr(0x113047) =~ /[\x{110000}\P{PosixBlank}]/;
+chr(0x113048) =~ /[\x{110000}\p{XPosixBlank}]/;
+chr(0x113049) =~ /[\x{110000}\P{XPosixBlank}]/;
 no warnings 'utf8';
 chr(0xD7FF) =~ /\p{Any}/;
 chr(0xD800) =~ /\p{Any}/;
@@ -185,8 +461,187 @@ chr(0x100000) =~ /\p{Any}/;
 chr(0x10FFFE) =~ /\p{Any}/;
 chr(0x10FFFF) =~ /\p{Any}/;
 chr(0x110000) =~ /\p{Any}/;
+chr(0x110010) =~ /\p{PosixWord}/;
+chr(0x110011) =~ /\P{PosixWord}/;
+chr(0x110012) =~ /\p{XPosixWord}/;
+chr(0x110013) =~ /\P{XPosixWord}/;
+chr(0x110014) =~ /\p{PosixAlnum}/;
+chr(0x110015) =~ /\P{PosixAlnum}/;
+chr(0x110016) =~ /\p{XPosixAlnum}/;
+chr(0x110017) =~ /\P{XPosixAlnum}/;
+chr(0x110018) =~ /\p{PosixSpace}/;
+chr(0x110019) =~ /\P{PosixSpace}/;
+chr(0x11001A) =~ /\p{XPosixSpace}/;
+chr(0x11001B) =~ /\P{XPosixSpace}/;
+chr(0x11001C) =~ /\p{PosixDigit}/;
+chr(0x11001D) =~ /\P{PosixDigit}/;
+chr(0x11001E) =~ /\p{XPosixDigit}/;
+chr(0x11001F) =~ /\P{XPosixDigit}/;
+chr(0x110020) =~ /\p{PosixAlpha}/;
+chr(0x110021) =~ /\P{PosixAlpha}/;
+chr(0x110022) =~ /\p{XPosixAlpha}/;
+chr(0x110023) =~ /\P{XPosixAlpha}/;
+chr(0x110024) =~ /\p{Ascii}/;
+chr(0x110025) =~ /\P{Ascii}/;
+chr(0x110026) =~ /\p{PosixCntrl}/;
+chr(0x110027) =~ /\P{PosixCntrl}/;
+chr(0x110028) =~ /\p{XPosixCntrl}/;
+chr(0x110029) =~ /\P{XPosixCntrl}/;
+chr(0x11002A) =~ /\p{PosixGraph}/;
+chr(0x11002B) =~ /\P{PosixGraph}/;
+chr(0x11002C) =~ /\p{XPosixGraph}/;
+chr(0x11002D) =~ /\P{XPosixGraph}/;
+chr(0x11002E) =~ /\p{PosixLower}/;
+chr(0x11002F) =~ /\P{PosixLower}/;
+chr(0x110030) =~ /\p{XPosixLower}/;
+chr(0x110031) =~ /\P{XPosixLower}/;
+chr(0x110032) =~ /\p{PosixPrint}/;
+chr(0x110033) =~ /\P{PosixPrint}/;
+chr(0x110034) =~ /\p{XPosixPrint}/;
+chr(0x110035) =~ /\P{XPosixPrint}/;
+chr(0x110036) =~ /\p{PosixPunct}/;
+chr(0x110037) =~ /\P{PosixPunct}/;
+chr(0x110038) =~ /\p{XPosixPunct}/;
+chr(0x110039) =~ /\P{XPosixPunct}/;
+chr(0x11003A) =~ /\p{PosixUpper}/;
+chr(0x11003B) =~ /\P{PosixUpper}/;
+chr(0x11003C) =~ /\p{XPosixUpper}/;
+chr(0x11003D) =~ /\P{XPosixUpper}/;
+chr(0x11003E) =~ /\p{PosixXdigit}/;
+chr(0x11003F) =~ /\P{PosixXdigit}/;
+chr(0x110040) =~ /\p{XPosixXdigit}/;
+chr(0x110041) =~ /\P{XPosixXdigit}/;
+chr(0x110042) =~ /\p{PerlSpace}/;
+chr(0x110043) =~ /\P{PerlSpace}/;
+chr(0x110044) =~ /\p{XPerlSpace}/;
+chr(0x110045) =~ /\P{XPerlSpace}/;
+chr(0x110046) =~ /\p{PosixBlank}/;
+chr(0x110047) =~ /\P{PosixBlank}/;
+chr(0x110048) =~ /\p{XPosixBlank}/;
+chr(0x110049) =~ /\P{XPosixBlank}/;
+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:]]/;
 EXPECT
 Code point 0x110000 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 14.
+Code point 0x110010 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 15.
+Code point 0x110011 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 16.
+Code point 0x110011 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 16.
+Code point 0x110012 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 17.
+Code point 0x110013 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 18.
+Code point 0x110013 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 18.
+Code point 0x110014 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 19.
+Code point 0x110015 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 20.
+Code point 0x110015 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 20.
+Code point 0x110016 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 21.
+Code point 0x110017 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 22.
+Code point 0x110017 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 22.
+Code point 0x110018 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 23.
+Code point 0x110019 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 24.
+Code point 0x110019 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 24.
+Code point 0x11001A is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 25.
+Code point 0x11001B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 26.
+Code point 0x11001B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 26.
+Code point 0x11001C is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 27.
+Code point 0x11001D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 28.
+Code point 0x11001D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 28.
+Code point 0x11001E is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 29.
+Code point 0x11001F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 30.
+Code point 0x11001F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 30.
+Code point 0x110020 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 31.
+Code point 0x110021 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 32.
+Code point 0x110021 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 32.
+Code point 0x110022 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 33.
+Code point 0x110023 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 34.
+Code point 0x110023 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 34.
+Code point 0x110024 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 35.
+Code point 0x110025 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 36.
+Code point 0x110025 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 36.
+Code point 0x110026 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 37.
+Code point 0x110027 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 38.
+Code point 0x110027 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 38.
+Code point 0x110028 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 39.
+Code point 0x110029 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 40.
+Code point 0x110029 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 40.
+Code point 0x11002A is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 41.
+Code point 0x11002B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 42.
+Code point 0x11002B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 42.
+Code point 0x11002C is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 43.
+Code point 0x11002D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 44.
+Code point 0x11002D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 44.
+Code point 0x11002E is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 45.
+Code point 0x11002F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 46.
+Code point 0x11002F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 46.
+Code point 0x110030 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 47.
+Code point 0x110031 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 48.
+Code point 0x110031 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 48.
+Code point 0x110032 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 49.
+Code point 0x110033 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 50.
+Code point 0x110033 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 50.
+Code point 0x110034 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 51.
+Code point 0x110035 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 52.
+Code point 0x110035 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 52.
+Code point 0x110036 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 53.
+Code point 0x110037 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 54.
+Code point 0x110037 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 54.
+Code point 0x110038 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 55.
+Code point 0x110039 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 56.
+Code point 0x110039 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 56.
+Code point 0x11003A is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 57.
+Code point 0x11003B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 58.
+Code point 0x11003B is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 58.
+Code point 0x11003C is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 59.
+Code point 0x11003D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 60.
+Code point 0x11003D is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 60.
+Code point 0x11003E is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 61.
+Code point 0x11003F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 62.
+Code point 0x11003F is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 62.
+Code point 0x110040 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 63.
+Code point 0x110041 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 64.
+Code point 0x110041 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 64.
+Code point 0x110042 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 65.
+Code point 0x110043 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 66.
+Code point 0x110043 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 66.
+Code point 0x110044 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 67.
+Code point 0x110045 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 68.
+Code point 0x110045 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 68.
+Code point 0x110046 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 69.
+Code point 0x110047 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 70.
+Code point 0x110047 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 70.
+Code point 0x110048 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 71.
+Code point 0x110049 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 72.
+Code point 0x110049 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 72.
 ########
 use warnings 'utf8';
 chr(0x110000) =~ /\p{Any}/;
@@ -195,6 +650,14 @@ chr(0x110000) =~ /\p{Any}/;
 EXPECT
 Code point 0x110000 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 2.
 ########
+# TODO optimized regnode should still give warnings
+use warnings 'utf8';
+chr(0x110000) =~ /lb=cr/;
+no warnings 'non_unicode';
+chr(0x110000) =~ /lb=cr/;
+EXPECT
+Code point 0x110000 is not Unicode, all \p{} matches fail; all \P{} matches succeed at - line 2.
+########
 require "../test.pl";
 use warnings 'utf8';
 sub Is_Super { return '!utf8::Any' }
diff --git a/gnu/usr.bin/perl/t/mro/basic.t b/gnu/usr.bin/perl/t/mro/basic.t
index 9955b813b64..be49f9ab1fe 100644
--- a/gnu/usr.bin/perl/t/mro/basic.t
+++ b/gnu/usr.bin/perl/t/mro/basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-BEGIN { require q(./test.pl); } plan(tests => 52);
+BEGIN { require q(./test.pl); } plan(tests => 60);
 
 require mro;
 
@@ -328,3 +328,59 @@ is(eval { MRO_N->testfunc() }, 123);
     undef %Thwit::;
     ok !Thrext->isa('Sile'), 'undef %package:: updates subclasses';
 }
+
+{
+    # Obliterating @ISA via glob assignment
+    # Broken in 5.14.0; fixed in 5.17.2
+    @Gwythaint::ISA = "Fantastic::Creature";
+    undef *This_glob_haD_better_not_exist; # paranoia; must have no array
+    *Gwythaint::ISA = *This_glob_haD_better_not_exist;
+    ok !Gwythaint->isa("Fantastic::Creature"),
+       'obliterating @ISA via glob assignment';
+}
+
+{
+    # Autovivifying @ISA via @{*ISA}
+    no warnings;
+    undef *fednu::ISA;
+    @{*fednu::ISA} = "pyfg";
+    ok +fednu->isa("pyfg"), 'autovivifying @ISA via *{@ISA}';
+}
+
+{
+    sub Detached::method;
+    my $h = delete $::{"Detached::"};
+    eval { local *Detached::method };
+    is $@, "", 'localising gv-with-cv belonging to detached package';
+}
+
+{
+    # *ISA localisation
+    @il::ISA = "ilsuper";
+    sub ilsuper::can { "puree" }
+    sub il::tomatoes;
+    {
+        local *il::ISA;
+        is +il->can("tomatoes"), \&il::tomatoes, 'local *ISA';
+    }
+    is "il"->can("tomatoes"), "puree", 'local *ISA unwinding';
+    {
+        local *il::ISA = [];
+        is +il->can("tomatoes"), \&il::tomatoes, 'local *ISA = []';
+    }
+    is "il"->can("tomatoes"), "puree", 'local *ISA=[] unwinding';
+}
+
+# Changes to UNIVERSAL::DESTROY should not leave stale DESTROY caches
+# (part of #114864)
+our $destroy_output;
+sub UNIVERSAL::DESTROY { $destroy_output = "old" }
+my $x = bless[];
+undef $x; # cache the DESTROY method
+undef *UNIVERSAL::DESTROY;
+*UNIVERSAL::DESTROY = sub { $destroy_output = "new" };
+$x = bless[];
+undef $x; # should use the new DESTROY
+is $destroy_output, "new",
+    'Changes to UNIVERSAL::DESTROY invalidate DESTROY caches';
+undef *UNIVERSAL::DESTROY;
diff --git a/gnu/usr.bin/perl/t/mro/isa_aliases.t b/gnu/usr.bin/perl/t/mro/isa_aliases.t
index abdedce1208..2073e5ebe5f 100644
--- a/gnu/usr.bin/perl/t/mro/isa_aliases.t
+++ b/gnu/usr.bin/perl/t/mro/isa_aliases.t
@@ -2,7 +2,7 @@
 
 BEGIN { chdir 't'; @INC = '../lib'; require './test.pl' }
 
-plan 12;
+plan 13;
 
 @Foogh::ISA = "Bar";
 *Phoogh::ISA = *Foogh::ISA;
@@ -41,3 +41,11 @@ ok !Foo->isa("Bar"),
  '!isa when another stash has claimed the @ISA via ref-to-glob assignment';
 ok !Phoo->isa("Bar"),
  '!isa on the stash that claimed the @ISA via ref-to-glob assignment';
+
+*Fooo::ISA = *Baro::ISA;
+@Fooo::ISA = "Bazo";
+sub Bazo::ook { "Baz" }
+sub L::ook { "See" }
+Baro->ook;
+local *Fooo::ISA = ["L"];
+is 'Baro'->ook, 'See', 'localised *ISA=$ref assignment';
diff --git a/gnu/usr.bin/perl/t/mro/method_caching.t b/gnu/usr.bin/perl/t/mro/method_caching.t
index 733193ae1be..3f21b1b6b34 100644
--- a/gnu/usr.bin/perl/t/mro/method_caching.t
+++ b/gnu/usr.bin/perl/t/mro/method_caching.t
@@ -1,6 +1,7 @@
 #!./perl
 
 use strict;
+no strict 'refs'; # we do a lot of this
 use warnings;
 no warnings 'redefine'; # we do a lot of this
 no warnings 'prototype'; # we do a lot of this
@@ -10,10 +11,9 @@ BEGIN {
         chdir 't' if -d 't';
         @INC = '../lib';
     }
+    require './test.pl';
 }
 
-require './test.pl';
-
 {
     package MCTest::Base;
     sub foo { return $_[1]+1 };
@@ -35,6 +35,15 @@ my @testsubs = (
     sub { is(MCTest::Derived->foo(0), 5); },
     sub { sub FFF { $_[1]+7 }; local *MCTest::Base::foo = *FFF; is(MCTest::Derived->foo(0), 7); },
     sub { is(MCTest::Derived->foo(0), 5); },
+    sub { { local *MCTest::Base::can = sub { "tomatoes" };
+            MCTest::Derived->can(0); }
+          is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa,
+              'removing method when unwinding local *method=sub{}'); },
+    sub { sub peas { "peas" }
+          { local *MCTest::Base::can = *peas;
+            MCTest::Derived->can(0); }
+          is(MCTest::Derived->can("isa"), \&UNIVERSAL::isa,
+              'removing method when unwinding local *method=*other'); },
     sub { sub DDD { $_[1]+8 }; *MCTest::Base::foo = *DDD; is(MCTest::Derived->foo(0), 8); },
     sub { *ASDF::asdf = sub { $_[1]+9 }; *MCTest::Base::foo = \&ASDF::asdf; is(MCTest::Derived->foo(0), 9); },
     sub { undef *MCTest::Base::foo; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
@@ -57,6 +66,39 @@ my @testsubs = (
     sub { *{MCTest::Base::} = *{Foo::}; eval { MCTest::Derived->foo(0) }; like($@, qr/locate object method/); },
     sub { *MCTest::Derived::foo = \&MCTest::Base::foo; eval { MCTest::Derived::foo(0,0) }; ok(!$@); undef *MCTest::Derived::foo },
     sub { eval 'package MCTest::Base; sub foo { $_[1]+18 }'; is(MCTest::Derived->foo(0), 18); },
+
+    # Redefining through a glob alias
+    sub { *A = *{'MCTest::Base::foo'}; eval 'sub A { $_[1]+19 }';
+          is(MCTest::Derived->foo(0), 19,
+            'redefining sub through glob alias via decl'); },
+    sub { SKIP: {
+              skip_if_miniperl("no XS");
+              eval { require XS::APItest; }
+                or skip "XS::APItest not available", 1;
+              *A = *{'MCTest::Base::foo'};
+              XS::APItest::newCONSTSUB(\%main::, "A", 0, 20);
+              is (MCTest::Derived->foo(0), 20,
+                  'redefining sub through glob alias via newXS');
+        } },
+    sub { undef *{'MCTest::Base::foo'}; *A = *{'MCTest::Base::foo'};
+          eval { no warnings 'once'; local *UNIVERSAL::foo = sub {96};
+                 MCTest::Derived->foo };
+          ()=\&A;
+          eval { MCTest::Derived->foo };
+          like($@, qr/Undefined subroutine/,
+            'redefining sub through glob alias via stub vivification'); },
+    sub { *A = *{'MCTest::Base::foo'};
+          local *A = sub { 21 };
+          is(MCTest::Derived->foo, 21,
+            'redef sub through glob alias via local cv-to-glob assign'); },
+    sub { *A = *{'MCTest::Base::foo'};
+          eval 'sub MCTest::Base::foo { 22 }';
+          { local *A = sub { 23 }; MCTest::Derived->foo }
+          is(MCTest::Derived->foo, 22,
+            'redef sub through glob alias via localisation unwinding'); },
+    sub { *A = *{'MCTest::Base::foo'}; *A = sub { 24 };
+          is(MCTest::Derived->foo(0), 24,
+            'redefining sub through glob alias via cv-to-glob assign'); },
 );
 
 plan(tests => scalar(@testsubs));
diff --git a/gnu/usr.bin/perl/t/mro/package_aliases.t b/gnu/usr.bin/perl/t/mro/package_aliases.t
index 3bc3c8fa741..34aa2d68b9b 100755
--- a/gnu/usr.bin/perl/t/mro/package_aliases.t
+++ b/gnu/usr.bin/perl/t/mro/package_aliases.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use strict;
 use warnings;
-plan(tests => 52);
+plan(tests => 53);
 
 {
     package New;
@@ -399,4 +399,12 @@ bless [], "O:";
   'isa(foo) when inheriting from "class:" after string-to-glob assignment';
 }
 
-
+@Bazo::ISA = "Fooo::bar";
+sub Fooo::bar::ber { 'baz' }
+sub UNIVERSAL::ber { "black sheep" }
+Bazo->ber;
+local *Fooo:: = \%Baro::;
+{
+    no warnings;
+    is 'Bazo'->ber, 'black sheep', 'localised *glob=$stashref assignment';
+}
diff --git a/gnu/usr.bin/perl/t/op/anonsub.t b/gnu/usr.bin/perl/t/op/anonsub.t
index b83e4afe6d9..6b8745f4e43 100644
--- a/gnu/usr.bin/perl/t/op/anonsub.t
+++ b/gnu/usr.bin/perl/t/op/anonsub.t
@@ -86,7 +86,8 @@ EXPECT
 ok 1
 ########
 # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
+sub __ANON__ { print "42\n" }
 undef &{$x=sub{}};
 $x->();
 EXPECT
-Undefined subroutine called at - line 3.
+Undefined subroutine called at - line 4.
diff --git a/gnu/usr.bin/perl/t/op/args.t b/gnu/usr.bin/perl/t/op/args.t
index 02d63521e09..bfa015ee90b 100644
--- a/gnu/usr.bin/perl/t/op/args.t
+++ b/gnu/usr.bin/perl/t/op/args.t
@@ -14,32 +14,32 @@ sub new1 { bless \@_ }
 {
     my $x = new1("x");
     my $y = new1("y");
-    is("@$y","y");
-    is("@$x","x");
+    is("@$y","y", 'bless');
+    is("@$x","x", 'bless');
 }
 
 sub new2 { splice @_, 0, 0, "a", "b", "c"; return \@_ }
 {
     my $x = new2("x");
     my $y = new2("y");
-    is("@$x","a b c x");
-    is("@$y","a b c y");
+    is("@$x","a b c x", 'splice');
+    is("@$y","a b c y", 'splice');
 }
 
 sub new3 { goto &new1 }
 {
     my $x = new3("x");
     my $y = new3("y");
-    is("@$y","y");
-    is("@$x","x");
+    is("@$y","y", 'goto: single element');
+    is("@$x","x", 'goto: single element');
 }
 
 sub new4 { goto &new2 }
 {
     my $x = new4("x");
     my $y = new4("y");
-    is("@$x","a b c x");
-    is("@$y","a b c y");
+    is("@$x","a b c x", 'goto: multiple elements');
+    is("@$y","a b c y", 'goto: multiple elements');
 }
 
 # see if POPSUB gets to see the right pad across a dounwind() with
@@ -54,24 +54,27 @@ sub method {
     &methimpl;
 }
 
+my $failcount = 0;
 sub try {
     eval { method('foo', 'bar'); };
     print "# $@" if $@;
+    $failcount++;
 }
 
 for (1..5) { try() }
-pass();
+is($failcount, 5,
+    'POPSUB sees right pad across a dounwind() with reified @_');
 
 # bug #21542 local $_[0] causes reify problems and coredumps
 
 sub local1 { local $_[0] }
 my $foo = 'foo'; local1($foo); local1($foo);
-print "got [$foo], expected [foo]\nnot " if $foo ne 'foo';
-pass();
+is($foo, 'foo',
+    "got 'foo' as expected rather than '\$foo': RT \#21542");
 
 sub local2 { local $_[0]; last L }
 L: { local2 }
-pass();
+pass("last to label");
 
 # the following test for local(@_) used to be in t/op/nothr5005.t (because it
 # failed with 5005threads)
@@ -82,9 +85,9 @@ sub foo { local(@_) = ('p', 'q', 'r'); }
 sub bar { unshift @_, 'D'; @_ }
 sub baz { push @_, 'E'; return @_ }
 for (1..3) { 
-    is(join('',foo('a', 'b', 'c')),'pqr');
-    is(join('',bar('d')),'Dd');
-    is(join('',baz('e')),'eE');
+    is(join('',foo('a', 'b', 'c')),'pqr', 'local @_');
+    is(join('',bar('d')),'Dd', 'unshift @_');
+    is(join('',baz('e')),'eE', 'push @_');
 } 
 
 # [perl #28032] delete $_[0] was freeing things too early
diff --git a/gnu/usr.bin/perl/t/op/attrs.t b/gnu/usr.bin/perl/t/op/attrs.t
index 79ef3614fb9..d4c8b69bedb 100644
--- a/gnu/usr.bin/perl/t/op/attrs.t
+++ b/gnu/usr.bin/perl/t/op/attrs.t
@@ -313,6 +313,16 @@ foreach my $test (@tests) {
      'Calling closure proto with no @_ that returns a lexical';
 }
 
+# Referencing closure prototypes
+{
+  package buckbuck;
+  my @proto;
+  sub MODIFY_CODE_ATTRIBUTES { push @proto, $_[1], \&{$_[1]}; _: }
+  my $id;
+  () = sub :buck {$id};
+  &::is(@proto, 'referencing closure prototype');
+}
+
 # [perl #68658] Attributes on stately variables
 {
   package thwext;
diff --git a/gnu/usr.bin/perl/t/op/blocks.t b/gnu/usr.bin/perl/t/op/blocks.t
index e6c53d7bb95..d07e844df87 100644
--- a/gnu/usr.bin/perl/t/op/blocks.t
+++ b/gnu/usr.bin/perl/t/op/blocks.t
@@ -13,13 +13,13 @@ b1
 b2
 b3
 b4
-b6
-u5
+b6-c
 b7
 u6
+u5-c
 u1
 c3
-c2
+c2-c
 c1
 i1
 i2
@@ -27,6 +27,8 @@ b5
 u2
 u3
 u4
+b6-r
+u5-r
 e2
 e1
 		);
@@ -45,9 +47,18 @@ UNITCHECK {print ":u1"}
 eval 'BEGIN {print ":b5"}';
 eval 'UNITCHECK {print ":u2"}';
 eval 'UNITCHECK {print ":u3"; UNITCHECK {print ":u4"}}';
-"a" =~ /(?{UNITCHECK {print ":u5"};
-	   CHECK {print ":c2"};
-	   BEGIN {print ":b6"}})/x;
+"a" =~ /(?{UNITCHECK {print ":u5-c"};
+	   CHECK {print ":c2-c"};
+	   BEGIN {print ":b6-c"}})/x;
+{
+    use re 'eval';
+    my $runtime = q{
+    (?{UNITCHECK {print ":u5-r"};
+	       CHECK {print ":c2-r"};
+	       BEGIN {print ":b6-r"}})/
+    };
+    "a" =~ /$runtime/x;
+}
 eval {BEGIN {print ":b7"}};
 eval {UNITCHECK {print ":u6"}};
 eval {INIT {print ":i2"}};
diff --git a/gnu/usr.bin/perl/t/op/caller.t b/gnu/usr.bin/perl/t/op/caller.t
index af732420c3d..efce8dfd5c8 100644
--- a/gnu/usr.bin/perl/t/op/caller.t
+++ b/gnu/usr.bin/perl/t/op/caller.t
@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan( tests => 85 );
+    plan( tests => 91 );
 }
 
 my @c;
@@ -19,7 +19,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))[3] };
+eval q{ @c = caller(0) };
 is( $c[3], "(eval)", "subroutine name in an eval ''" );
 ok( !$c[4], "hasargs false in an eval ''" );
 
@@ -111,8 +111,8 @@ sub testwarn {
 
     # The repetition number must be set to the value of $BYTES in
     # lib/warnings.pm
-    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 13, 'all bits off via "no warnings"' ) }
-    testwarn("\0" x 13, 'no bits');
+    BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 14, 'all bits off via "no warnings"' ) }
+    testwarn("\0" x 14, 'no bits');
 
     use warnings;
     BEGIN { check_bits( ${^WARNING_BITS}, $default,
@@ -250,6 +250,53 @@ eval { sub { () = caller 0; } ->(1..3) };
 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;';
+
+# 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}';
+}
+
 $::testing_caller = 1;
 
 do './op/caller.pl' or die $@;
diff --git a/gnu/usr.bin/perl/t/op/chars.t b/gnu/usr.bin/perl/t/op/chars.t
index efdea027bb4..d26a632b176 100644
--- a/gnu/usr.bin/perl/t/op/chars.t
+++ b/gnu/usr.bin/perl/t/op/chars.t
@@ -1,74 +1,82 @@
 #!./perl
 
-print "1..33\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 34;
 
 # because of ebcdic.c these should be the same on asciiish 
 # and ebcdic machines.
 # Peter Prymmer <pvhp@best.com>.
 
 my $c = "\c@";
-print +((ord($c) == 0) ? "" : "not "),"ok 1\n";
+is (ord($c), 0, '\c@');
 $c = "\cA";
-print +((ord($c) == 1) ? "" : "not "),"ok 2\n";
+is (ord($c), 1, '\cA');
 $c = "\cB";
-print +((ord($c) == 2) ? "" : "not "),"ok 3\n";
+is (ord($c), 2, '\cB');
 $c = "\cC";
-print +((ord($c) == 3) ? "" : "not "),"ok 4\n";
+is (ord($c), 3, '\cC');
 $c = "\cD";
-print +((ord($c) == 4) ? "" : "not "),"ok 5\n";
+is (ord($c), 4, '\cD');
 $c = "\cE";
-print +((ord($c) == 5) ? "" : "not "),"ok 6\n";
+is (ord($c), 5, '\cE');
 $c = "\cF";
-print +((ord($c) == 6) ? "" : "not "),"ok 7\n";
+is (ord($c), 6, '\cF');
 $c = "\cG";
-print +((ord($c) == 7) ? "" : "not "),"ok 8\n";
+is (ord($c), 7, '\cG');
 $c = "\cH";
-print +((ord($c) == 8) ? "" : "not "),"ok 9\n";
+is (ord($c), 8, '\cH');
 $c = "\cI";
-print +((ord($c) == 9) ? "" : "not "),"ok 10\n";
+is (ord($c), 9, '\cI');
 $c = "\cJ";
-print +((ord($c) == 10) ? "" : "not "),"ok 11\n";
+is (ord($c), 10, '\cJ');
 $c = "\cK";
-print +((ord($c) == 11) ? "" : "not "),"ok 12\n";
+is (ord($c), 11, '\cK');
 $c = "\cL";
-print +((ord($c) == 12) ? "" : "not "),"ok 13\n";
+is (ord($c), 12, '\cL');
 $c = "\cM";
-print +((ord($c) == 13) ? "" : "not "),"ok 14\n";
+is (ord($c), 13, '\cM');
 $c = "\cN";
-print +((ord($c) == 14) ? "" : "not "),"ok 15\n";
+is (ord($c), 14, '\cN');
 $c = "\cO";
-print +((ord($c) == 15) ? "" : "not "),"ok 16\n";
+is (ord($c), 15, '\cO');
 $c = "\cP";
-print +((ord($c) == 16) ? "" : "not "),"ok 17\n";
+is (ord($c), 16, '\cP');
 $c = "\cQ";
-print +((ord($c) == 17) ? "" : "not "),"ok 18\n";
+is (ord($c), 17, '\cQ');
 $c = "\cR";
-print +((ord($c) == 18) ? "" : "not "),"ok 19\n";
+is (ord($c), 18, '\cR');
 $c = "\cS";
-print +((ord($c) == 19) ? "" : "not "),"ok 20\n";
+is (ord($c), 19, '\cS');
 $c = "\cT";
-print +((ord($c) == 20) ? "" : "not "),"ok 21\n";
+is (ord($c), 20, '\cT');
 $c = "\cU";
-print +((ord($c) == 21) ? "" : "not "),"ok 22\n";
+is (ord($c), 21, '\cU');
 $c = "\cV";
-print +((ord($c) == 22) ? "" : "not "),"ok 23\n";
+is (ord($c), 22, '\cV');
 $c = "\cW";
-print +((ord($c) == 23) ? "" : "not "),"ok 24\n";
+is (ord($c), 23, '\cW');
 $c = "\cX";
-print +((ord($c) == 24) ? "" : "not "),"ok 25\n";
+is (ord($c), 24, '\cX');
 $c = "\cY";
-print +((ord($c) == 25) ? "" : "not "),"ok 26\n";
+is (ord($c), 25, '\cY');
 $c = "\cZ";
-print +((ord($c) == 26) ? "" : "not "),"ok 27\n";
+is (ord($c), 26, '\cZ');
 $c = "\c[";
-print +((ord($c) == 27) ? "" : "not "),"ok 28\n";
+is (ord($c), 27, '\c[');
 $c = "\c\\";
-print +((ord($c) == 28) ? "" : "not "),"ok 29\n";
+is (ord($c), 28, '\c\\');
 $c = "\c]";
-print +((ord($c) == 29) ? "" : "not "),"ok 30\n";
+is (ord($c), 29, '\c]');
 $c = "\c^";
-print +((ord($c) == 30) ? "" : "not "),"ok 31\n";
+is (ord($c), 30, '\c^');
 $c = "\c_";
-print +((ord($c) == 31) ? "" : "not "),"ok 32\n";
+is (ord($c), 31, '\c_');
 $c = "\c?";
-print +((ord($c) == 127) ? "" : "not "),"ok 33\n";
+is (ord($c), 127, '\c?');
+$c = '';
+is (ord($c), 0, 'ord("") is 0');
diff --git a/gnu/usr.bin/perl/t/op/chr.t b/gnu/usr.bin/perl/t/op/chr.t
index 5ac453f4279..57b4adeb2c6 100755
--- a/gnu/usr.bin/perl/t/op/chr.t
+++ b/gnu/usr.bin/perl/t/op/chr.t
@@ -6,7 +6,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan tests => 34;
+plan tests => 42;
 
 # Note that t/op/ord.t already tests for chr() <-> ord() rountripping.
 
@@ -31,6 +31,22 @@ is(chr(-3.0), "\x{FFFD}");
     is(chr(-3.0), "\xFD");
 }
 
+# Make sure -1 is treated the same way when coming from a tied variable
+sub TIESCALAR {bless[]}
+sub STORE { $_[0][0] = $_[1] }
+sub FETCH { $_[0][0] }
+tie $t, "";
+$t = -1; is chr $t, chr -1, 'chr $tied when $tied is -1';
+$t = -2; is chr $t, chr -2, 'chr $tied when $tied is -2';
+$t = -1.1; is chr $t, chr -1.1, 'chr $tied when $tied is -1.1';
+$t = -2.2; is chr $t, chr -2.2, 'chr $tied when $tied is -2.2';
+
+# And that stringy scalars are treated likewise
+is chr "-1", chr -1, 'chr "-1" eq chr -1';
+is chr "-2", chr -2, 'chr "-2" eq chr -2';
+is chr "-1.1", chr -1.1, 'chr "-1.1" eq chr -1.1';
+is chr "-2.2", chr -2.2, 'chr "-2.2" eq chr -2.2';
+
 # Check UTF-8 (not UTF-EBCDIC).
 SKIP: {
     skip "no UTF-8 on EBCDIC", 21 if chr(193) eq 'A';
@@ -63,3 +79,4 @@ sub hexes {
     is(hexes(0x1FFFFF), "f7 bf bf bf"); # last four byte encoding
     is(hexes(0x200000), "f8 88 80 80 80");
 }
+
diff --git a/gnu/usr.bin/perl/t/op/closure_test.pl b/gnu/usr.bin/perl/t/op/closure_test.pl
new file mode 100644
index 00000000000..c06250d975f
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/closure_test.pl
@@ -0,0 +1,10 @@
+# This file exists to test closure prototypes with no CvOUTSIDE.  Only
+# by putting this in a separate file can we get a sub (this file’s
+# main CV) with no CvOUTSIDE.  When the outer sub is freed, the inner
+# subs also get CvOUTSIDE set to null.
+
+	my $x;
+	$closure_test::s2 = sub {
+	    $x;
+	    sub { $x; '10 cubes' };
+	};
diff --git a/gnu/usr.bin/perl/t/op/concat2.t b/gnu/usr.bin/perl/t/op/concat2.t
index 2a66c3c07b3..cc6a5415e83 100644
--- a/gnu/usr.bin/perl/t/op/concat2.t
+++ b/gnu/usr.bin/perl/t/op/concat2.t
@@ -9,14 +9,48 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    skip_all_if_miniperl("no dynamic loading on miniperl, no Encode");
 }
 
-plan 1;
+plan 3;
 
+SKIP: {
+skip_if_miniperl("no dynamic loading on miniperl, no Encode", 1);
+skip('encoding pragma is deprecated', 1) if $] >= 5.017009;
 fresh_perl_is <<'end', "ok\n", {},
     use encoding 'utf8';
     map { "a" . $a } ((1)x5000);
     print "ok\n";
 end
  "concat does not lose its stack pointer after utf8 upgrade [perl #78674]";
+}
+
+# This test is in the file because overload.pm uses concatenation.
+{ package o; use overload '""' => sub { $_[0][0] } }
+$x = bless[chr 256],o::;
+"$x";
+$x->[0] = "\xff";
+$x.= chr 257;
+$x.= chr 257;
+is $x, "\xff\x{101}\x{101}", '.= is not confused by changing utf8ness';
+
+# Ops should not share the same TARG between recursion levels.  This may
+# affect other ops, too, but concat seems more susceptible to this than
+# others, since it can call itself recursively.  (Where else would I put
+# this test, anyway?)
+fresh_perl_is <<'end', "tmp\ntmp\n", {},
+ sub canonpath {
+     my ($path) = @_;
+     my $node = '';
+     $path =~ s|/\z||;
+     return "$node$path";
+ }
+ 
+ {
+  package Path::Class::Dir;
+  use overload q[""] => sub { ::canonpath("tmp") };
+ }
+ 
+ print canonpath("tmp"), "\n";
+ print canonpath(bless {},"Path::Class::Dir"), "\n";
+end
+ "recursive concat does not share TARGs";
diff --git a/gnu/usr.bin/perl/t/op/coreamp.t b/gnu/usr.bin/perl/t/op/coreamp.t
index 78ced663040..c1f7181fe79 100644
--- a/gnu/usr.bin/perl/t/op/coreamp.t
+++ b/gnu/usr.bin/perl/t/op/coreamp.t
@@ -14,6 +14,8 @@ BEGIN {
     $^P |= 0x100;
 }
 
+no warnings 'experimental::smartmatch';
+
 sub lis($$;$) {
   &is(map(@$_ ? "[@{[map $_//'~~u~~', @$_]}]" : 'nought', @_[0,1]), $_[2]);
 }
@@ -28,10 +30,13 @@ package sov {
 my %op_desc = (
  evalbytes=> 'eval "string"',
  join     => 'join or string',
+ pos      => 'match position',
+ prototype=> 'subroutine prototype',
  readline => '<HANDLE>',
  readpipe => 'quoted execution (``, qx)',
  reset    => 'symbol reset',
  ref      => 'reference-type operator',
+ undef    => 'undef operator',
 );
 sub op_desc($) {
   return $op_desc{$_[0]} || $_[0];
@@ -56,7 +61,7 @@ sub test_proto {
     like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
 
   }
-  elsif ($p eq '_') {
+  elsif ($p =~ /^_;?\z/) {
     $tests ++;
 
     eval " &CORE::$o(1,2) ";
@@ -83,6 +88,7 @@ sub test_proto {
     # works in all cases.
     undef $_;
     {
+      no warnings 'experimental::lexical_topic';
       my $_ = $in;
       is &{"CORE::$o"}(), $out, "&$o with no args uses lexical \$_";
     }
@@ -90,6 +96,7 @@ sub test_proto {
     my $r;
     $r = sub {
       if($_[0]) {
+        no warnings 'experimental::lexical_topic';
         my $_ = $in;
         is &{"CORE::$o"}(), $out,
            "&$o with no args uses the right lexical \$_ under recursion";
@@ -99,6 +106,7 @@ sub test_proto {
       }
     };
     &$r(0);
+    no warnings 'experimental::lexical_topic';
     my $_ = $in;
     eval {
        is "CORE::$o"->(), $out, "&$o with the right lexical \$_ in an eval"
@@ -187,47 +195,74 @@ sub test_proto {
     like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
         "&$o with non-hash arg with hash overload (which does not count)";
   }
-  elsif ($p =~ /^\\\[(\$\@%&?\*)](\$\@)?\z/) {
-    $tests += 4;
+  elsif ($p =~ /^(;)?\\\[(\$\@%&?\*)](\$\@)?\z/) {
+    $tests += 3;
 
-    unless ($2) {
+    unless ($3) {
       $tests ++;
       eval " &CORE::$o(1,2) ";
-      like $@, qr/^Too many arguments for $o at /,
+      like $@, qr/^Too many arguments for ${\op_desc($o)} at /,
         "&$o with too many args";
     }
-    eval { &{"CORE::$o"}($2 ? 1 : ()) };
-    like $@, qr/^Not enough arguments for $o at /,
+    unless ($1) {
+      $tests ++;
+      eval { &{"CORE::$o"}($3 ? 1 : ()) };
+      like $@, qr/^Not enough arguments for $o at /,
          "&$o with too few args";
-    my $more_args = $2 ? ',1' : '';
+    }
+    my $more_args = $3 ? ',1' : '';
     eval " &CORE::$o(2$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with non-ref arg";
     eval " &CORE::$o(*STDOUT{IO}$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with ioref arg";
     my $class = ref *DATA{IO};
     eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) ";
     like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
-                ) \[\Q$1\E] at /,
+                ) \[\Q$2\E] at /,
         "&$o with ioref arg with hash overload (which does not count)";
     bless *DATA{IO}, $class;
-    if (do {$1 !~ /&/}) {
+    if (do {$2 !~ /&/}) {
       $tests++;
       eval " &CORE::$o(\\&scriggle$more_args) ";
       like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x:
-                  )of \[\Q$1\E] at /,
+                  )of \[\Q$2\E] at /,
         "&$o with coderef arg";
     }    
   }
+  elsif ($p eq ';\[$*]') {
+    $tests += 4;
+
+    my $desc = quotemeta op_desc($o);
+    eval " &CORE::$o(1,2) ";
+    like $@, qr/^Too many arguments for $desc at /,
+        "&$o with too many args";
+    eval " &CORE::$o([]) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with array ref arg";
+    eval " &CORE::$o(1) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with scalar arg";
+    eval " &CORE::$o(bless([], 'sov')) ";
+    like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+        "&$o with non-scalar arg w/scalar overload (which does not count)";
+  }
 
   else {
     die "Please add tests for the $p prototype";
   }
 }
 
+# Test that &CORE::foo calls without parentheses (no new @_) can handle the
+# total absence of any @_ without crashing.
+undef *_;
+&CORE::wantarray;
+$tests++;
+pass('no crash with &CORE::foo when *_{ARRAY} is undef');
+
 test_proto '__FILE__';
 test_proto '__LINE__';
 test_proto '__PACKAGE__';
@@ -480,6 +515,20 @@ test_proto "get$_" for qw '
   pwent pwnam pwuid servbyname servbyport servent sockname sockopt
 ';
 
+# Make sure the following tests test what we think they are testing.
+ok ! $CORE::{glob}, '*CORE::glob not autovivified yet'; $tests ++;
+{
+  # Make sure ck_glob does not respect the override when &CORE::glob is
+  # autovivified (by test_proto).
+  local *CORE::GLOBAL::glob = sub {};
+  test_proto 'glob';
+}
+$_ = "t/*.t";
+@_ = &myglob($_);
+is join($", &myglob()), "@_", '&glob without arguments';
+is join($", &myglob("t/*.t")), "@_", '&glob with an arg';
+$tests += 2;
+
 test_proto 'gmtime';
 &CORE::gmtime;
 pass '&gmtime without args does not crash'; ++$tests;
@@ -564,13 +613,33 @@ is &mypack("H*", '5065726c'), 'Perl', '&pack';
 lis [&mypack("H*", '5065726c')], ['Perl'], '&pack in list context';
 
 test_proto 'pipe';
+
+test_proto 'pos';
+$tests += 4;
+$_ = "hello";
+pos = 3;
+is &mypos, 3, 'reading &pos without args';
+&mypos = 4;
+is pos, 4, 'writing to &pos without args';
+{
+  my $x = "gubai";
+  pos $x = 3;
+  is &mypos(\$x), 3, 'reading &pos without args';
+  &mypos(\$x) = 4;
+  is pos $x, 4, 'writing to &pos without args';
+}
+
+test_proto 'prototype';
+$tests++;
+is &myprototype(\&myprototype), prototype("CORE::prototype"), '&prototype';
+
 test_proto 'quotemeta', '$', '\$';
 
 test_proto 'rand';
 $tests += 3;
-like &CORE::rand, qr/^0[.\d]*\z/, '&rand';
+like &CORE::rand, qr/^0[.\d+-e]*\z/, '&rand';
 unlike join(" ", &CORE::rand), qr/ /, '&rand in list context';
-&cmp_ok(&CORE::rand(78), qw '< 78', '&rand with 2 args');
+&cmp_ok(&CORE::rand(78), qw '< 78', '&rand with 1 arg');
 
 test_proto 'read';
 {
@@ -637,12 +706,12 @@ $tests += 2;
 my $oncer = sub { "a" =~ m?a? };
 &$oncer;
 &myreset;
-ok &$oncer, '&reset with one arg';
+ok &$oncer, '&reset with no args';
 package resettest {
   $b = "c";
   $banana = "cream";
   &::myreset('b');
-  ::lis [$b,$banana],[(undef)x2], '2-arg &reset';
+  ::lis [$b,$banana],[(undef)x2], '1-arg &reset';
 }
 
 test_proto 'reverse';
@@ -661,6 +730,11 @@ is &myrindex("foffooo","o"),6,'&rindex with 2 args';
 
 test_proto 'rmdir';
 
+test_proto 'scalar';
+$tests += 2;
+is &myscalar(3), 3, '&scalar';
+lis [&myscalar(3)], [3], '&scalar in list cx';
+
 test_proto 'seek';
 {
     last if is_miniperl;
@@ -733,8 +807,11 @@ test_proto 'sqrt', 4, 2;
 test_proto 'srand';
 $tests ++;
 &CORE::srand;
+() = &CORE::srand;
 pass '&srand with no args does not crash';
 
+test_proto 'study';
+
 test_proto 'substr';
 $tests += 5;
 $_ = "abc";
@@ -808,6 +885,34 @@ test_proto 'umask';
 $tests ++;
 is &myumask, umask, '&umask with no args';
 
+test_proto 'undef';
+$tests += 12;
+is &myundef(), undef, '&undef returns undef';
+lis [&myundef()], [undef], '&undef returns undef in list cx';
+lis [&myundef(\$_)], [undef], '&undef(...) returns undef in list cx';
+is \&myundef(), \undef, '&undef returns the right undef';
+$_ = 'anserine questions';
+&myundef(\$_);
+is $_, undef, '&undef(\$_) undefines $_';
+@_ = 1..3;
+&myundef(\@_);
+is @_, 0, '&undef(\@_) undefines @_';
+%_ = 1..4;
+&myundef(\%_);
+ok !%_, '&undef(\%_) undefines %_';
+&myundef(\&utf8::valid); # nobody should be using this :-)
+ok !defined &utf8::valid, '&undef(\&foo) undefines &foo';
+@_ = \*_;
+&myundef;
+is *_{ARRAY}, undef, '@_=\*_, &undef undefines *_';
+@_ = \*_;
+&myundef(\*_);
+is *_{ARRAY}, undef, '&undef(\*_) undefines *_';
+(&myundef(), @_) = 1..10;
+lis \@_, [2..10], 'list assignment to &undef()';
+ok !defined undef, 'list assignment to &undef() does not affect undef'; 
+undef @_;
+
 test_proto 'unpack';
 $tests += 2;
 $_ = 'abcd';
@@ -875,10 +980,17 @@ like $@, qr'^Undefined format "STDOUT" called',
   open my $kh, $keywords_file
     or die "$0 cannot open $keywords_file: $!";
   while(<$kh>) {
-    if (m?__END__?..${\0} and /^[-](.*)/) {
+    if (m?__END__?..${\0} and /^[-+](.*)/) {
       my $word = $1;
       next if
-       $word =~ /^(?:CORE|and|cmp|dump|eq|ge|gt|le|lt|ne|or|x|xor)\z/;
+       $word =~ /^(?:s(?:tate|ort|ay|ub)?|d(?:ef
+                  ault|ump|o)|p(?:rintf?|ackag
+                  e)|e(?:ls(?:if|e)|val|q)|g(?:[et]|iven|oto
+                  |rep)|u(?:n(?:less|til)|se)|l(?:(?:as)?t|ocal|e)|re
+                  (?:quire|turn|do)|__(?:DATA|END)__|for(?:each|mat)?|(?:
+                  AUTOLOA|EN)D|n(?:e(?:xt)?|o)|C(?:HECK|ORE)|wh(?:ile|en)
+                  |(?:ou?|t)r|m(?:ap|y)?|UNITCHECK|q[qrwx]?|x(?:or)?|DEST
+                  ROY|BEGIN|INIT|and|cmp|if|y)\z/x;
       $tests ++;
       ok   exists &{"my$word"}
         || (eval{&{"CORE::$word"}}, $@ =~ /cannot be called directly/),
@@ -906,6 +1018,7 @@ like $@, qr'^Undefined format "STDOUT" called',
   my $warnings;
   local $SIG{__WARN__} = sub { ++$warnings };
 
+  no warnings 'experimental::lexical_topic';
   my $_ = 'Phoo';
   ok &mymkdir(), '&mkdir';
   like <*>, qr/^phoo(.DIR)?\z/i, 'mkdir works with implicit $_';
diff --git a/gnu/usr.bin/perl/t/op/coresubs.t b/gnu/usr.bin/perl/t/op/coresubs.t
index 85084bb5313..86118bca18b 100644
--- a/gnu/usr.bin/perl/t/op/coresubs.t
+++ b/gnu/usr.bin/perl/t/op/coresubs.t
@@ -15,11 +15,22 @@ BEGIN {
 use B::Deparse;
 my $bd = new B::Deparse '-p';
 
-my %unsupported = map +($_=>1), qw (CORE and cmp dump eq ge gt le
-                                    lt ne or x xor);
+my %unsupported = map +($_=>1), qw (
+ __DATA__ __END__ AUTOLOAD BEGIN UNITCHECK CORE DESTROY END INIT CHECK and
+  cmp default do dump else elsif eq eval for foreach
+  format ge given goto grep gt if last le local lt m map my ne next
+  no  or  our  package  print  printf  q  qq  qr  qw  qx  redo  require
+  return s say sort state sub tr unless until use
+  when while x xor y
+);
 my %args_for = (
   dbmopen  => '%1,$2,$3',
   dbmclose => '%1',
+  delete   => '$1[2]',
+  exists   => '$1[2]',
+);
+my %desc = (
+  pos => 'match position',
 );
 
 use File::Spec::Functions;
@@ -29,7 +40,7 @@ open my $kh, $keywords_file
 while(<$kh>) {
   if (m?__END__?..${\0} and /^[+-]/) {
     chomp(my $word = $');
-    if($& eq '+' || $unsupported{$word}) {
+    if($unsupported{$word}) {
       $tests ++;
       ok !defined &{"CORE::$word"}, "no CORE::$word";
     }
@@ -44,7 +55,8 @@ while(<$kh>) {
 
       CORE::state $protochar = qr/([^\\]|\\(?:[^[]|\[[^]]+\]))/;
       my $numargs =
-            () = $proto =~ s/;.*//r =~ /\G$protochar/g;
+            $word eq 'delete' || $word eq 'exists' ? 1 :
+            (() = $proto =~ s/;.*//r =~ /\G$protochar/g);
       my $code =
          "#line 1 This-line-makes-__FILE__-easier-to-test.
           sub { () = (my$word("
@@ -83,7 +95,8 @@ while(<$kh>) {
       next if ($proto =~ /\@/);
       # These ops currently accept any number of args, despite their
       # prototypes, if they have any:
-      next if $word =~ /^(?:chom?p|exec|keys|each|not|read(?:lin|pip)e
+      next if $word =~ /^(?:chom?p|exec|keys|each|not
+                           |(?:prototyp|read(?:lin|pip))e
                            |reset|system|values|l?stat)|evalbytes/x;
 
       $tests ++;
@@ -100,7 +113,8 @@ while(<$kh>) {
                )
        . "))}";
       eval $code;
-      like $@, qr/^Too many arguments for $word/,
+      my $desc = $desc{$word} || $word;
+      like $@, qr/^Too many arguments for $desc/,
           "inlined CORE::$word with too many args"
         or warn $code;
 
@@ -121,6 +135,12 @@ is runperl(prog => 'print CORE->lc, qq-\n-'), "core\n",
 is runperl(prog => '@ISA=CORE; print main->uc, qq-\n-'), "MAIN\n",
  'inherted method calls autovivify coresubs';
 
+{ # RT #117607
+  $tests++;
+  like runperl(prog => '$foo/; \&CORE::lc', stderr => 1),
+    qr/^syntax error/, "RT #117607: \\&CORE::foo doesn't crash in error context";
+}
+
 $tests++;
 ok eval { *CORE::exit = \42 },
   '[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only';
diff --git a/gnu/usr.bin/perl/t/op/cproto.t b/gnu/usr.bin/perl/t/op/cproto.t
index 8870df8d083..85b86db4195 100644
--- a/gnu/usr.bin/perl/t/op/cproto.t
+++ b/gnu/usr.bin/perl/t/op/cproto.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 BEGIN { require './test.pl'; }
-plan tests => 248;
+plan tests => 254;
 
 while (<DATA>) {
     chomp;
@@ -20,7 +20,10 @@ while (<DATA>) {
 	like( $@, qr/Can't find an opnumber for/, $keyword );
     }
     else {
-	is( "(".prototype("CORE::".$keyword).")", $proto, $keyword );
+	is(
+	    "(".(prototype("CORE::".$keyword) // 'undef').")", $proto,
+	    $keyword
+	);
     }
 }
 
@@ -33,7 +36,13 @@ __PACKAGE__ ()
 __DATA__ undef
 __END__ undef
 __SUB__ ()
+AUTOLOAD undef
+BEGIN undef
 CORE unknown
+DESTROY undef
+END undef
+INIT undef
+CHECK undef
 abs (_)
 accept (**)
 alarm (_)
@@ -120,7 +129,7 @@ getservent ()
 getsockname (*)
 getsockopt (*$$)
 given undef
-glob undef
+glob (_;)
 gmtime (;$)
 goto undef
 grep undef
@@ -168,10 +177,10 @@ pack ($@)
 package undef
 pipe (**)
 pop (;+)
-pos undef
+pos (;\[$*])
 print undef
 printf undef
-prototype undef
+prototype ($)
 push (+@)
 q undef
 qq undef
@@ -198,7 +207,7 @@ rindex ($$;$)
 rmdir (_)
 s undef
 say undef
-scalar undef
+scalar ($)
 seek (*$$)
 seekdir (*$)
 select undef
@@ -233,7 +242,7 @@ sqrt (_)
 srand (;$)
 stat (;*)
 state undef
-study undef
+study (_)
 sub undef
 substr ($$;$$)
 symlink ($$)
@@ -254,7 +263,7 @@ truncate ($$)
 uc (_)
 ucfirst (_)
 umask (;$)
-undef undef
+undef (;\[$@%&*])
 unless undef
 unlink (@)
 unpack ($_)
diff --git a/gnu/usr.bin/perl/t/op/current_sub.t b/gnu/usr.bin/perl/t/op/current_sub.t
index e72a0c5cde8..8c82d112d6e 100644
--- a/gnu/usr.bin/perl/t/op/current_sub.t
+++ b/gnu/usr.bin/perl/t/op/current_sub.t
@@ -4,7 +4,7 @@ BEGIN {
     chdir 't';
     @INC = qw(../lib);
     require './test.pl';
-    plan (tests => 13);
+    plan (tests => 17);
 }
 
 is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
@@ -45,3 +45,33 @@ BEGIN {
     return "begin 2" if @_;
     is &CORE::__SUB__->(0), "begin 2", 'in BEGIN block via & (unoptimised)'
 }
+
+sub bar;
+sub bar {
+    () = sort {
+          is  CORE::__SUB__, \&bar,   'in sort block in sub with forw decl'
+         } 1,2;
+}
+bar();
+sub bur;
+sub bur {
+    () = sort {
+          is &CORE::__SUB__, \&bur, '& in sort block in sub with forw decl'
+         } 1,2;
+}
+bur();
+
+sub squog;
+sub squog {
+    grep { is  CORE::__SUB__, \&squog,
+          'in grep block in sub with forw decl'
+    } 1;
+}
+squog();
+sub squag;
+sub squag {
+    grep { is &CORE::__SUB__, \&squag,
+          '& in grep block in sub with forw decl'
+    } 1;
+}
+squag();
diff --git a/gnu/usr.bin/perl/t/op/defined.t b/gnu/usr.bin/perl/t/op/defined.t
new file mode 100644
index 00000000000..7129e47a882
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/defined.t
@@ -0,0 +1,20 @@
+#!perl
+BEGIN {
+    chdir 't';
+    require './test.pl';
+}
+
+plan 5;
+
+sub notdef { undef }
+
+# [perl #97466]
+# These should actually call the sub, instead of testing the sub itself
+ok !defined do { &notdef }, 'defined do { &sub }';
+ok !defined(scalar(42,&notdef)), 'defined(scalar(42,&sub))';
+ok !defined do{();&notdef}, '!defined do{();&sub}';
+
+# Likewise, these should evaluate @array in scalar context
+no warnings "deprecated";
+ok defined($false ? $scalar : @array), 'defined( ... ? ... : @array)';
+ok defined(scalar @array), 'defined(scalar @array)';
diff --git a/gnu/usr.bin/perl/t/op/defins.t b/gnu/usr.bin/perl/t/op/defins.t
index 80127b444d8..54d31507e62 100644
--- a/gnu/usr.bin/perl/t/op/defins.t
+++ b/gnu/usr.bin/perl/t/op/defins.t
@@ -10,7 +10,7 @@ BEGIN {
     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
 }
 require 'test.pl';
-plan( tests => 19 );
+plan( tests => 27 );
 
 my $unix_mode = 1;
 
@@ -33,14 +33,23 @@ if ($^O eq 'VMS') {
     $unix_mode = 1 if $drop_dot && unix_rpt;
 }
 
+# $wanted_filename should be 0 for readdir() and glob() tests.
+# This is because it is the only valid filename that is false in a boolean test.
+
+# $filename = '0';
+# print "hi\n" if $filename; # doesn't print
+
+# In the case of VMS, '0' isn't always the filename that you get.
+# Which makes those particular tests pointless.
+
 $wanted_filename = $unix_mode ? '0' : '0.';
 $saved_filename = './0';
 
 cmp_ok($warns,'==',0,'no warns at start');
 
 ok(open(FILE,">$saved_filename"),'created work file');
+print FILE "0\n";
 print FILE "1\n";
-print FILE "0";
 close(FILE);
 
 open(FILE,"<$saved_filename");
@@ -49,6 +58,7 @@ my $seen = 0;
 my $dummy;
 while (my $name = <FILE>)
  {
+  chomp($name);
   $seen++ if $name eq '0';
  }
 cmp_ok($seen,'==',1,'seen in while()');
@@ -58,6 +68,7 @@ $seen = 0;
 my $line = '';
 do
  {
+  chomp($line);
   $seen++ if $line eq '0';
  } while ($line = <FILE>);
 cmp_ok($seen,'==',1,'seen in do/while');
@@ -66,15 +77,17 @@ seek(FILE,0,0);
 $seen = 0;
 while (($seen ? $dummy : $name) = <FILE> )
  {
+  chomp($name);
   $seen++ if $name eq '0';
  }
-cmp_ok($seen,'==',1,'seen in while() ternary');
+cmp_ok($seen,'==',2,'seen in while() ternary');
 
 seek(FILE,0,0);
 $seen = 0;
 my %where;
 while ($where{$seen} = <FILE>)
  {
+  chomp($where{$seen});
   $seen++ if $where{$seen} eq '0';
  }
 cmp_ok($seen,'==',1,'seen in hash while()');
@@ -106,6 +119,31 @@ while ($where{$seen} = readdir(DIR))
  }
 cmp_ok($seen,'==',1,'saw file in hash while()');
 
+rewinddir(DIR);
+$seen = 0;
+$_ = 'not 0';
+while (readdir(DIR))
+ {
+  $seen++ if $_ eq $wanted_filename;
+ }
+cmp_ok($seen,'==',1,'saw file in bare while(readdir){...}');
+
+rewinddir(DIR);
+$seen = 0;
+$_ = 'not 0';
+
+$_ eq $wanted_filename && $seen++ while readdir(DIR);
+cmp_ok($seen,'==',1,'saw file in bare "... while readdir"');
+
+rewinddir(DIR);
+$seen = 0;
+$_ = "";  # suppress uninit warning
+do
+ {
+  $seen++ if $_ eq $wanted_filename;
+ } while (readdir(DIR));
+cmp_ok($seen,'==',1,'saw file in bare do{...}while(readdir)');
+
 $seen = 0;
 while (my $name = glob('*'))
  {
@@ -132,12 +170,17 @@ unlink($saved_filename);
 ok(!(-f $saved_filename),'work file unlinked');
 
 my %hash = (0 => 1, 1 => 2);
+my @array = 1;
+my $neg_sum= 0;
 
 $seen = 0;
+
 while (my $name = each %hash)
  {
+  $neg_sum = $name - $neg_sum;
   $seen++ if $name eq '0';
  }
+cmp_ok(abs($neg_sum),'==',1,'abs(neg_sum) should equal 1');
 cmp_ok($seen,'==',1,'seen in each');
 
 $seen = 0;
@@ -146,7 +189,7 @@ while (($seen ? $dummy : $name) = each %hash)
  {
   $seen++ if $name eq '0';
  }
-cmp_ok($seen,'==',1,'seen in each ternary');
+cmp_ok($seen,'==',$neg_sum < 0 ? 1 : 2,'seen in each ternary');
 
 $seen = 0;
 while ($where{$seen} = each %hash)
@@ -155,4 +198,30 @@ while ($where{$seen} = each %hash)
  }
 cmp_ok($seen,'==',1,'seen in each hash');
 
+$seen = 0;
+undef $_;
+while (each %hash)
+ {
+  $seen++ if $_ eq '0';
+ }
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash)');
+
+$seen = 0;
+undef $_;
+while (each @array)
+ {
+  $seen++ if $_ eq '0';
+ }
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array)');
+
+$seen = 0;
+undef $_;
+$_ eq '0' and $seen++ while each %hash;
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each %hash) as stm mod');
+
+$seen = 0;
+undef $_;
+$_ eq '0' and $seen++ while each @array;
+cmp_ok($seen,'==',1,'0 seen in $_ in while(each @array) as stm mod');
+
 cmp_ok($warns,'==',0,'no warns at finish');
diff --git a/gnu/usr.bin/perl/t/op/die.t b/gnu/usr.bin/perl/t/op/die.t
index a51333f9ebf..8faef6a33c7 100644
--- a/gnu/usr.bin/perl/t/op/die.t
+++ b/gnu/usr.bin/perl/t/op/die.t
@@ -1,74 +1,97 @@
 #!./perl
 
-print "1..15\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
 
-$SIG{__DIE__} = sub { print ref($_[0]) ? ("ok ",$_[0]->[0]++,"\n") : @_ } ;
+plan tests => 19;
 
-$err = "#[\000]\nok 1\n";
 eval {
-    die $err;
+    eval {
+	die "Horribly\n";
+    };
+    die if $@;
 };
 
-print "not " unless $@ eq $err;
-print "ok 2\n";
+like($@, '^Horribly', 'die with no args propagates $@');
+like($@, 'propagated', '... and appends a phrase');
 
-$x = [3];
-eval { die $x; };
+{
+    local $SIG{__DIE__} = sub { is( $_[0], "[\000]\n", 'Embedded null passed to signal handler' )};
 
-print "not " unless $x->[0] == 4;
-print "ok 4\n";
+    $err = "[\000]\n";
+    eval {
+        die $err;
+    };
+    is( $@, $err, 'Embedded null passed back into $@' );
+}
+
+{
+    local $SIG{__DIE__} = sub {
+	isa_ok( $_[0], 'ARRAY', 'pass an array ref as an argument' );
+	$_[0]->[0]++;
+    };
+    $x = [3];
+    eval { die $x; };
+
+    is( $x->[0], 4, 'actual array, not a copy, passed to signal handler' );
 
-eval {
     eval {
-	die [ 5 ];
+        eval {
+            die [ 5 ];
+        };
+        die if $@;
     };
-    die if $@;
-};
 
-eval {
+    is($@->[0], 7, 'die with no arguments propagates $@, but leaves references alone');
+
     eval {
-	die bless [ 7 ], "Error";
+	eval {
+	    die bless [ 7 ], "Error";
+	};
+	isa_ok( $@, 'Error', '$@ is an Error object' );
+	die if $@;
     };
-    die if $@;
-};
 
-print "not " unless ref($@) eq "Out";
-print "ok 10\n";
+    isa_ok( $@, 'Out', 'returning a different object than what was passed in, via PROPAGATE' );
+    is($@->[0], 9, 'reference returned correctly');
+}
 
 {
     package Error;
 
     sub PROPAGATE {
-	print "ok ",$_[0]->[0]++,"\n";
 	bless [$_[0]->[0]], "Out";
     }
 }
 
+
 {
     # die/warn and utf8
     use utf8;
     local $SIG{__DIE__};
     my $msg = "ce ºtii tu, bã ?\n";
-    eval { die $msg }; print "not " unless $@ eq $msg;
-    print "ok 11\n";
+    eval { die $msg };
+    is( $@, $msg, "Literal passed to die" );
     our $err;
     local $SIG{__WARN__} = $SIG{__DIE__} = sub { $err = shift };
-    eval { die $msg }; print "not " unless $err eq $msg;
-    print "ok 12\n";
-    eval { warn $msg }; print "not " unless $err eq $msg;
-    print "ok 13\n";
+    eval { die $msg };
+    is( $err, $msg, 'die handler with utf8' );
+    eval { warn $msg };
+    is( $err, $msg, 'warn handler with utf8' );
     eval qq/ use strict; \$\x{3b1} /;
-    print "not " unless $@ =~ /Global symbol "\$\x{3b1}"/;
-    print "ok 14\n";
+    like( $@, qr/Global symbol "\$\x{3b1}"/, 'utf8 symbol names show up in $@' );
 }
 
 # [perl #36470] got uninit warning if $@ was undef
 
 {
+    use warnings "uninitialized";
     my $ok = 1;
     local $SIG{__DIE__};
     local $SIG{__WARN__} = sub { $ok = 0 };
     eval { undef $@; die };
-    print "not " unless $ok;
-    print "ok 15\n";
+    is( $ok, 1, 'no warnings if $@ is undef' );
 }
diff --git a/gnu/usr.bin/perl/t/op/die_except.t b/gnu/usr.bin/perl/t/op/die_except.t
index 679a23fe8c3..a65bf4aa8d8 100644
--- a/gnu/usr.bin/perl/t/op/die_except.t
+++ b/gnu/usr.bin/perl/t/op/die_except.t
@@ -19,8 +19,8 @@ $val = eval {
 	$@ = "t1\n";
 	1;
 }; $err = $@;
-is($val, 1);
-is($err, "");
+is($val, 1, "true return value from successful eval block");
+is($err, "", "no exception after successful eval block");
 
 $@ = "t0\n";
 $val = eval {
@@ -30,8 +30,8 @@ $val = eval {
 	};
 	1;
 }; $err = $@;
-is($val, undef);
-is($err, "t3\n");
+is($val, undef, "undefined return value from eval block with 'die'");
+is($err, "t3\n", "exception after eval block with 'die'");
 
 $@ = "t0\n";
 $val = eval {
@@ -39,8 +39,8 @@ $val = eval {
 	local $@ = "t2\n";
 	1;
 }; $err = $@;
-is($val, 1);
-is($err, "");
+is($val, 1, "true return value from successful eval block with localized \$@");
+is($err, "", "no exception after successful eval block with localized \$@");
 
 $@ = "t0\n";
 $val = eval {
@@ -51,8 +51,10 @@ $val = eval {
 	};
 	1;
 }; $err = $@;
-is($val, undef);
-is($err, "t3\n");
+is($val, undef,
+    "undefined return value from eval block with 'die' and localized \$@");
+is($err, "t3\n",
+    "exception after eval block with 'die' and localized \$@");
 
 $@ = "t0\n";
 $val = eval {
@@ -60,8 +62,8 @@ $val = eval {
 	my $c = end { $@ = "t2\n"; };
 	1;
 }; $err = $@;
-is($val, 1);
-is($err, "");
+is($val, 1, "true return value from eval block with 'end'");
+is($err, "", "no exception after eval block with 'end'");
 
 $@ = "t0\n";
 $val = eval {
@@ -72,7 +74,7 @@ $val = eval {
 	};
 	1;
 }; $err = $@;
-is($val, undef);
-is($err, "t3\n");
+is($val, undef, "undefined return value from eval block with 'end' and 'die'");
+is($err, "t3\n", "exception after eval block with 'end' and 'die'");
 
 done_testing();
diff --git a/gnu/usr.bin/perl/t/op/die_exit.t b/gnu/usr.bin/perl/t/op/die_exit.t
index 390e0c58312..bd9ac285989 100644
--- a/gnu/usr.bin/perl/t/op/die_exit.t
+++ b/gnu/usr.bin/perl/t/op/die_exit.t
@@ -13,8 +13,6 @@ BEGIN {
 
 use strict;
 
-skip_all('broken on MPE/iX') if $^O eq 'mpeix';
-
 $| = 1;
 
 my @tests = (
diff --git a/gnu/usr.bin/perl/t/op/die_keeperr.t b/gnu/usr.bin/perl/t/op/die_keeperr.t
index 9b41cb59358..083bd5d1215 100644
--- a/gnu/usr.bin/perl/t/op/die_keeperr.t
+++ b/gnu/usr.bin/perl/t/op/die_keeperr.t
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     require 'test.pl';
-    plan(20);
+    plan(24);
 }
 
 sub End::DESTROY { $_[0]->() }
@@ -31,14 +31,45 @@ foreach my $inx ("", "aabbcc\n", [qw(aa bb cc)]) {
     no warnings "misc";
     my $warn = "";
     local $SIG{__WARN__} = sub { $warn .= $_[0] };
-    { my $e = end { die "aa\n"; }; }
+    { my $e = end { no warnings "misc"; die "aa\n"; }; }
     is $warn, "";
 }
 
 {
+    no warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
+    is $warn, "\t(in cleanup) aa\n";
+}
+
+{
     my $warn = "";
     local $SIG{__WARN__} = sub { $warn .= $_[0] };
     { my $e = end { no warnings "misc"; die "aa\n"; }; }
+    is $warn, "";
+}
+
+{
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
+    is $warn, "\t(in cleanup) aa\n";
+}
+
+{
+    use warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { no warnings "misc"; die "aa\n"; }; }
+    is $warn, "";
+}
+
+{
+    use warnings "misc";
+    my $warn = "";
+    local $SIG{__WARN__} = sub { $warn .= $_[0] };
+    { my $e = end { use warnings "misc"; die "aa\n"; }; }
     is $warn, "\t(in cleanup) aa\n";
 }
 
diff --git a/gnu/usr.bin/perl/t/op/die_unwind.t b/gnu/usr.bin/perl/t/op/die_unwind.t
index 2dc5042668d..29fa6e6b7f5 100644
--- a/gnu/usr.bin/perl/t/op/die_unwind.t
+++ b/gnu/usr.bin/perl/t/op/die_unwind.t
@@ -5,7 +5,7 @@ use strict;
 
 #
 # This test checks for $@ being set early during an exceptional
-# unwinding, and that this early setting doesn't affect the late
+# unwinding, and that this early setting does not affect the late
 # setting used to emit the exception from eval{}.  The early setting is
 # a backward-compatibility hack to satisfy modules that were relying on
 # the historical early setting in order to detect exceptional unwinding.
@@ -29,9 +29,9 @@ $val = eval {
 	my $c = end { $uerr = $@; $@ = "t2\n"; };
 	1;
 }; $err = $@;
-is($uerr, "");
-is($val, 1);
-is($err, "");
+is($uerr, "", "\$@ false at start of 'end' block inside 'eval' block");
+is($val, 1, "successful return from 'eval' block");
+is($err, "", "\$@ still false after 'end' block inside 'eval' block");
 
 $@ = "t0\n";
 $val = eval {
@@ -39,9 +39,9 @@ $val = eval {
 	my $c = end { $uerr = $@; $@ = "t2\n"; };
 	1;
 }; $err = $@;
-is($uerr, "t1\n");
-is($val, 1);
-is($err, "");
+is($uerr, "t1\n", "true value assigned to \$@ before 'end' block inside 'eval' block");
+is($val, 1, "successful return from 'eval' block");
+is($err, "", "\$@ still false after 'end' block inside 'eval' block");
 
 $@ = "";
 $val = eval {
@@ -52,7 +52,7 @@ $val = eval {
 	1;
 }; $err = $@;
 is($uerr, "t3\n");
-is($val, undef);
+is($val, undef, "undefined return value from 'eval' block with 'die'");
 is($err, "t3\n");
 
 $@ = "t0\n";
@@ -65,7 +65,7 @@ $val = eval {
 	1;
 }; $err = $@;
 is($uerr, "t3\n");
-is($val, undef);
+is($val, undef, "undefined return value from 'eval' block with 'die'");
 is($err, "t3\n");
 
 done_testing();
diff --git a/gnu/usr.bin/perl/t/op/dor.t b/gnu/usr.bin/perl/t/op/dor.t
index 9f280503ea0..e2385f1a7b1 100644
--- a/gnu/usr.bin/perl/t/op/dor.t
+++ b/gnu/usr.bin/perl/t/op/dor.t
@@ -56,15 +56,18 @@ for (qw(getc pos readline readlink undef umask <> <FOO> <$foo> -f)) {
 # Test for some ambiguous syntaxes
 
 eval q# sub f ($) { } f $x / 2; #;
-is( $@, '' );
+is( $@, '', "'/' correctly parsed as arithmetic operator" );
 eval q# sub f ($):lvalue { $y } f $x /= 2; #;
-is( $@, '' );
+is( $@, '', "'/=' correctly parsed as assigment operator" );
 eval q# sub f ($) { } f $x /2; #;
-like( $@, qr/^Search pattern not terminated/ );
+like( $@, qr/^Search pattern not terminated/,
+    "Caught unterminated search pattern error message: empty subroutine" );
 eval q# sub { print $fh / 2 } #;
-is( $@, '' );
+is( $@, '',
+    "'/' correctly parsed as arithmetic operator in sub with built-in function" );
 eval q# sub { print $fh /2 } #;
-like( $@, qr/^Search pattern not terminated/ );
+like( $@, qr/^Search pattern not terminated/,
+    "Caught unterminated search pattern error message: sub with built-in function" );
 
 # [perl #28123] Perl optimizes // away incorrectly
 
diff --git a/gnu/usr.bin/perl/t/op/each_array.t b/gnu/usr.bin/perl/t/op/each_array.t
index 95710e259e3..1055d6c88a4 100755
--- a/gnu/usr.bin/perl/t/op/each_array.t
+++ b/gnu/usr.bin/perl/t/op/each_array.t
@@ -9,94 +9,107 @@ use strict;
 use warnings;
 use vars qw(@array @r $k $v $c);
 
-plan tests => 57;
+plan tests => 63;
 
 @array = qw(crunch zam bloop);
 
 (@r) = each @array;
-is (scalar @r, 2);
-is ($r[0], 0);
-is ($r[1], 'crunch');
+is (scalar @r, 2, "'each' on array returns index and value of next element");
+is ($r[0], 0, "got expected index");
+is ($r[1], 'crunch', "got expected value");
 ($k, $v) = each @array;
-is ($k, 1);
-is ($v, 'zam');
+is ($k, 1, "got expected index of next element");
+is ($v, 'zam', "got expected value of next element");
 ($k, $v) = each @array;
-is ($k, 2);
-is ($v, 'bloop');
+is ($k, 2, "got expected index of remaining element");
+is ($v, 'bloop', "got expected value of remaining element");
 (@r) = each @array;
-is (scalar @r, 0);
+is (scalar @r, 0,
+    "no elements remaining to be iterated over in original array");
 
 (@r) = each @array;
-is (scalar @r, 2);
-is ($r[0], 0);
-is ($r[1], 'crunch');
+is (scalar @r, 2, "start second iteration over original array");
+is ($r[0], 0, "got expected index");
+is ($r[1], 'crunch', "got expected value");
 ($k) = each @array;
-is ($k, 1);
+is ($k, 1, "got index when only index was assigned to variable");
 
 my @lex_array = qw(PLOP SKLIZZORCH RATTLE);
 
 (@r) = each @lex_array;
-is (scalar @r, 2);
-is ($r[0], 0);
-is ($r[1], 'PLOP');
+is (scalar @r, 2, "'each' on array returns index and value of next element");
+is ($r[0], 0, "got expected index");
+is ($r[1], 'PLOP', "got expected value");
 ($k, $v) = each @lex_array;
-is ($k, 1);
-is ($v, 'SKLIZZORCH');
+is ($k, 1, "got expected index of next element");
+is ($v, 'SKLIZZORCH', "got expected value of next element");
 ($k) = each @lex_array;
-is ($k, 2);
+is ($k, 2, "got expected index of remaining element");
 (@r) = each @lex_array;
-is (scalar @r, 0);
+is (scalar @r, 0,
+    "no elements remaining to be iterated over in original array");
 
 my $ar = ['bacon'];
 
 (@r) = each @$ar;
-is (scalar @r, 2);
-is ($r[0], 0);
-is ($r[1], 'bacon');
+is (scalar @r, 2,
+    "'each' on array inside reference returns index and value of next element");
+is ($r[0], 0, "got expected index");
+is ($r[1], 'bacon', "got expected value of array element inside reference");
 
 (@r) = each @$ar;
-is (scalar @r, 0);
+is (scalar @r, 0,
+    "no elements remaining to be iterated over in array inside reference");
 
-is (each @$ar, 0);
-is (scalar each @$ar, undef);
+is (each @$ar, 0, "scalar context 'each' on array returns expected index");
+is (scalar each @$ar, undef,
+    "no elements remaining to be iterated over; array reference case");
 
 my @keys;
 @keys = keys @array;
-is ("@keys", "0 1 2");
+is ("@keys", "0 1 2",
+    "'keys' on array in list context returns list of indices");
 
 @keys = keys @lex_array;
-is ("@keys", "0 1 2");
+is ("@keys", "0 1 2",
+    "'keys' on another array in list context returns list of indices");
 
 ($k, $v) = each @array;
-is ($k, 0);
-is ($v, 'crunch');
+is ($k, 0, "got expected index");
+is ($v, 'crunch', "got expected value");
 
 @keys = keys @array;
-is ("@keys", "0 1 2");
+is ("@keys", "0 1 2",
+    "'keys' on array in list context returns list of indices");
 
 ($k, $v) = each @array;
-is ($k, 0);
-is ($v, 'crunch');
+is ($k, 0, "following 'keys', got expected index");
+is ($v, 'crunch', "following 'keys', got expected value");
 
 
 
 my @values;
 @values = values @array;
-is ("@values", "@array");
+is ("@values", "@array",
+    "'values' on array returns list of values");
 
 @values = values @lex_array;
-is ("@values", "@lex_array");
+is ("@values", "@lex_array",
+    "'values' on another array returns list of values");
 
 ($k, $v) = each @array;
-is ($k, 0);
-is ($v, 'crunch');
+is ($k, 0, "following 'values', got expected index");
+is ($v, 'crunch', "following 'values', got expected index");
 
 @values = values @array;
-is ("@values", "@array");
+is ("@values", "@array",
+    "following 'values' and 'each', 'values' continues to return expected list of values");
 
 ($k, $v) = each @array;
-is ($k, 0);
-is ($v, 'crunch');
+is ($k, 0,
+    "following 'values', 'each' and 'values', 'each' continues to return expected index");
+is ($v, 'crunch',
+    "following 'values', 'each' and 'values', 'each' continues to return expected value");
 
 # reset
 while (each @array) { }
@@ -104,8 +117,9 @@ while (each @array) { }
 # each(ARRAY) in the conditional loop
 $c = 0;
 while (($k, $v) = each @array) {
-    is ($k, $c);
-    is ($v, $array[$k]);
+    is ($k, $c, "'each' on array in loop returns expected index '$c'");
+    is ($v, $array[$k],
+        "'each' on array in loop returns expected value '$array[$k]'");
     $c++;
 }
 
@@ -116,15 +130,18 @@ $c = 0;
 $k = 0;
 $v = 0;
 while ($k = each @array) {
-    is ($k, $v);
+    is ($k, $v,
+        "'each' on array in scalar context in loop returns expected index '$v'");
     $v++;
 }
 
 # each(ARRAY) in the conditional loop
 $c = 0;
 for (; ($k, $v) = each @array ;) {
-    is ($k, $c);
-    is ($v, $array[$k]);
+    is ($k, $c,
+        "'each' on array in list context in loop returns expected index '$c'");
+    is ($v, $array[$k],
+        "'each' on array in list context in loop returns expected value '$array[$k]'");
     $c++;
 }
 
@@ -134,6 +151,39 @@ $c = 0;
 $k = 0;
 $v = 0;
 for (; $k = each(@array) ;) {
-    is ($k, $v);
+    is ($k, $v,
+        "'each' on array in scalar context in loop returns expected index '$v'");
     $v++;
 }
+
+# Reset the iterator when the array is cleared [RT #75596]
+{
+    my @a = 'a' .. 'c';
+    my ($i, $v) = each @a;
+    is ("$i-$v", '0-a', "got expected index and value");
+    @a = 'A' .. 'C';
+    ($i, $v) = each @a;
+    is ("$i-$v", '0-A',
+        "got expected new index and value after array gets new content");
+}
+
+# Check that the iterator is reset when localization ends
+{
+    @array = 'a' .. 'c';
+    my ($i, $v) = each @array;
+    is ("$i-$v", '0-a', "got expected index and value");
+    {
+        local @array = 'A' .. 'C';
+        my ($i, $v) = each @array;
+        is ("$i-$v", '0-A',
+            "got expected new index and value after array is localized and gets new content");
+        ($i, $v) = each @array;
+        is ("$i-$v", '1-B',
+            "got expected next index and value after array is localized and gets new content");
+    }
+    ($i, $v) = each @array;
+    is ("$i-$v", '1-b',
+         "got expected next index and value upon return to pre-localized array");
+    # Explicit reset
+    while (each @array) { }
+}
diff --git a/gnu/usr.bin/perl/t/op/exists_sub.t b/gnu/usr.bin/perl/t/op/exists_sub.t
index 012ea331e70..a08e0f5422d 100644
--- a/gnu/usr.bin/perl/t/op/exists_sub.t
+++ b/gnu/usr.bin/perl/t/op/exists_sub.t
@@ -3,10 +3,9 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..9\n";
-
 sub t1;
 sub t2 : lvalue;
 sub t3 ();
@@ -19,28 +18,66 @@ sub t5 {1;}
     @ISA = 'P1';
 }
 
-print "not " unless exists &t1 && not defined &t1;
-print "ok 1\n";
-print "not " unless exists &t2 && not defined &t2;
-print "ok 2\n";
-print "not " unless exists &t3 && not defined &t3;
-print "ok 3\n";
-print "not " unless exists &t4 && not defined &t4;
-print "ok 4\n";
-print "not " unless exists &t5 && defined &t5;
-print "ok 5\n";
-P2::->tmc;
-print "not " unless not exists &P2::tmc && not defined &P2::tmc;
-print "ok 6\n";
+my $has_t1 = ok( exists &t1, 't1 sub declared' );
+SKIP: {
+    skip 't1 sub was not declared', 1 if ! $has_t1;
+    ok( ! defined &t1, 't1 not defined' );
+}
+
+my $has_t2 = ok( exists &t2, 't2 sub declared' );
+SKIP: {
+    skip 't2 sub was not declared', 1 if ! $has_t2;
+    ok( ! defined &t2, 't2 not defined' );
+}
+
+my $has_t3 = ok( exists &t3, 't3 sub declared' );
+SKIP: {
+    skip 't3 sub was not declared', 1 if ! $has_t3;
+    ok( ! defined &t3, 't3 not defined' );
+}
+
+my $has_t4 = ok( exists &t4, 't4 sub declared' );
+SKIP: {
+    skip 't4 sub was not declared', 1 if ! $has_t4;
+    ok( ! defined &t4, 't4 not defined' );
+}
+
+my $has_t5 = ok( exists &t5, 't5 sub declared' );
+SKIP: {
+    skip 't5 sub was not declared', 1 if ! $has_t5;
+    ok( defined &t5, , 't5 defined' );
+}
+
+my $has_p2_tmc = ok(! exists &P2::tmc, 'P2::tmc not declared, it was inherited');
+SKIP: {
+    skip 'P2::tmc sub was not declared', 1 if ! $has_t5;
+    ok( ! defined &P2::tmc, 'P2::tmc not defined' );
+}
+
 my $ref;
 $ref->{A}[0] = \&t4;
-print "not " unless exists &{$ref->{A}[0]} && not defined &{$ref->{A}[0]};
-print "ok 7\n";
+my $ref_exists = ok( exists &{$ref->{A}[0]}, 'references to subroutines exist');
+SKIP: {
+    skip 1, 'Reference sub is not considered declared', 1 if ! $ref_exists;
+    ok( ! defined &{$ref->{A}[0]}, 'Reference to a sub is not defined' );
+}
+
+my $p1_tmc_exists = ok( exists &P1::tmc, 'test setup check');
+SKIP: {
+    skip 'Setup P1::tmc sub is not considered declared', 1 if ! $p1_tmc_exists;
+    ok( defined P1::tmc, 'Setup sub is defined' );
+}
+
 undef &P1::tmc;
-print "not " unless exists &P1::tmc && not defined &P1::tmc;
-print "ok 8\n";
+$p1_tmc_exists = ok( exists &P1::tmc, 'P1::tmc was once defined, and continues to be after being undeffed');
+SKIP: {
+    skip( 'Sub P1::tmc still exists after having undef called on it', 1) if ! $p1_tmc_exists;
+    ok( ! defined &P1::tmc, 'P1::tmc is not longer defined after undef was called on it' );
+}
+
 eval 'exists &t5()';
-print "not " unless $@;
-print "ok 9\n";
+like( $@, qr/not a subroutine name/, 'exists takes subroutine names with no argument list');
+
+done_testing();
 
 exit 0;
diff --git a/gnu/usr.bin/perl/t/op/fh.t b/gnu/usr.bin/perl/t/op/fh.t
index 16ba186a91e..afca57bf7bb 100644
--- a/gnu/usr.bin/perl/t/op/fh.t
+++ b/gnu/usr.bin/perl/t/op/fh.t
@@ -12,18 +12,18 @@ plan tests => 8;
 
 $|=1;
 my $a = "SYM000";
-ok(!defined(fileno($a)));
-ok(!defined *{$a});
+ok(!defined(fileno($a)), 'initial file handle is undefined');
+ok(!defined *{$a}, 'initial typeglob of file handle is undefined');
 
 select select $a;
-ok(defined *{$a});
+ok(defined *{$a}, 'typeglob of file handle defined after select');
 
 $a++;
-ok(!close $a);
-ok(!defined *{$a});
+ok(!close $a, 'close does not succeed with incremented file handle');
+ok(!defined *{$a}, 'typeglob of file handle not defined after increment');
 
-ok(open($a, ">&STDOUT"));
-ok(defined *{$a});
+ok(open($a, ">&STDOUT"), 'file handle used with open of standard output');
+ok(defined *{$a}, 'typeglob of file handle defined after opening standard output');
 
-ok(close $a);
+ok(close $a, 'close standard output via file handle;');
 
diff --git a/gnu/usr.bin/perl/t/op/filehandle.t b/gnu/usr.bin/perl/t/op/filehandle.t
index ca29069609c..a7621db59aa 100755
--- a/gnu/usr.bin/perl/t/op/filehandle.t
+++ b/gnu/usr.bin/perl/t/op/filehandle.t
@@ -1,8 +1,5 @@
 #!./perl
 
-# There are few filetest operators that are portable enough to test.
-# See pod/perlport.pod for details.
-
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
@@ -15,12 +12,12 @@ use FileHandle;
 
 my $str = "foo";
 open my $fh, "<", \$str;
-is <$fh>, "foo";
+is <$fh>, "foo", "open fh to reference to string: got expected content";
 
 eval {
    $fh->seek(0, 0);
-   is $fh->tell, 0;
-   is <$fh>, "foo";
+   is $fh->tell, 0, "after 'seek' and 'tell', got expected current fh position in bytes";
+   is <$fh>, "foo", "after 'seek' and 'tell', still got expected content";
 };
 
-is $@, '';
+is $@, '', "no errors after 'seek' or 'tell'";
diff --git a/gnu/usr.bin/perl/t/op/filetest.t b/gnu/usr.bin/perl/t/op/filetest.t
index c47a857c2e5..8878400d9a6 100644
--- a/gnu/usr.bin/perl/t/op/filetest.t
+++ b/gnu/usr.bin/perl/t/op/filetest.t
@@ -9,85 +9,79 @@ BEGIN {
     require './test.pl';
 }
 
-use Config;
-plan(tests => 47 + 27*14);
+plan(tests => 50 + 27*14);
 
-ok( -d 'op' );
-ok( -f 'TEST' );
-ok( !-f 'op' );
-ok( !-d 'TEST' );
-ok( -r 'TEST' );
+# Tests presume we are in t/op directory and that file 'TEST' is found
+# therein.
+is(-d 'op', 1, "-d: directory correctly identified");
+is(-f 'TEST', 1, "-f: plain file correctly identified");
+isnt(-f 'op', 1, "-f: directory is not a plain file");
+isnt(-d 'TEST', 1, "-d: plain file is not a directory");
+is(-r 'TEST', 1, "-r: file readable by effective uid/gid not found");
 
-# Make a read only file
-my $ro_file = tempfile();
+# Make a read only file. This happens to be empty, so we also use it later.
+my $ro_empty_file = tempfile();
 
 {
-    open my $fh, '>', $ro_file or die "open $fh: $!";
+    open my $fh, '>', $ro_empty_file or die "open $fh: $!";
     close $fh or die "close $fh: $!";
 }
 
-chmod 0555, $ro_file or die "chmod 0555, '$ro_file' failed: $!";
-
-$oldeuid = $>;		# root can read and write anything
-eval '$> = 1';		# so switch uid (may not be implemented)
-
-print "# oldeuid = $oldeuid, euid = $>\n";
+chmod 0555, $ro_empty_file or die "chmod 0555, '$ro_empty_file' failed: $!";
 
 SKIP: {
-    if (!$Config{d_seteuid}) {
-	skip('no seteuid');
-    } 
-    else {
-	ok( !-w $ro_file );
+    my $restore_root;
+    if ($> == 0) {
+	# root can read and write anything, so switch uid (may not be
+	# implemented)
+	eval '$> = 1';
+
+	skip("Can't drop root privs to test read-only files") if $> == 0;
+	note("Dropped root privs to test read-only files. \$> == $>");
+	++$restore_root;
     }
-}
 
-# Scripts are not -x everywhere so cannot test that.
-
-eval '$> = $oldeuid';	# switch uid back (may not be implemented)
-
-# this would fail for the euid 1
-# (unless we have unpacked the source code as uid 1...)
-ok( -r 'op' );
+    isnt(-w $ro_empty_file, 1, "-w: file writable by effective uid/gid");
 
-# this would fail for the euid 1
-# (unless we have unpacked the source code as uid 1...)
-SKIP: {
-    if ($Config{d_seteuid}) {
-	ok( -w 'op' );
-    } else {
-	skip('no seteuid');
+    if ($restore_root) {
+	# If the previous assignment to $> worked, so should this:
+	$> = 0;
+	note("Restored root privs after testing read-only files. \$> == $>");
     }
 }
 
-ok( -x 'op' ); # Hohum.  Are directories -x everywhere?
+# these would fail for the euid 1
+# (unless we have unpacked the source code as uid 1...)
+is(-r 'op', 1, "-r: directory readable by effective uid/gid");
+is(-w 'op', 1, "-w: directory writable by effective uid/gid");
+is(-x 'op', 1, "-x: executable by effective uid/gid"); # Hohum.  Are directories -x everywhere?
 
-is( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" );
+is( "@{[grep -r, qw(foo io noo op zoo)]}", "io op",
+    "-r: found directories readable by effective uid/gid" );
 
 # Test stackability of filetest operators
 
-ok( defined( -f -d 'TEST' ) && ! -f -d _ );
-ok( !defined( -e 'zoo' ) );
-ok( !defined( -e -d 'zoo' ) );
-ok( !defined( -f -e 'zoo' ) );
-ok( -f -e 'TEST' );
-ok( -e -f 'TEST' );
-ok( defined(-d -e 'TEST') );
-ok( defined(-e -d 'TEST') );
-ok( ! -f -d 'op' );
-ok( -x -d -x 'op' );
-ok( (-s -f 'TEST' > 1), "-s returns real size" );
-ok( -f -s 'TEST' == 1 );
+is(defined( -f -d 'TEST' ), 1, "-f and -d stackable: plain file found");
+isnt(-f -d _, 1, "-f and -d stackable: no plain file found");
+isnt(defined( -e 'zoo' ), 1, "-e: file does not exist");
+isnt(defined( -e -d 'zoo' ), 1, "-e and -d: neither file nor directory exists");
+isnt(defined( -f -e 'zoo' ), 1, "-f and -e: not a plain file and does not exist");
+is(-f -e 'TEST', 1, "-f and -e: plain file and exists");
+is(-e -f 'TEST', 1, "-e and -f: exists and is plain file");
+is(defined(-d -e 'TEST'), 1, "-d and -e: file at least exists");
+is(defined(-e -d 'TEST'), 1, "-e and -d: file at least exists");
+isnt( -f -d 'op', 1, "-f and -d: directory found but is not a plain file");
+is(-x -d -x 'op', 1, "-x, -d and -x again: directory exists and is executable");
+my ($size) = (stat 'TEST')[7];
+cmp_ok($size, '>', 1, 'TEST is longer than 1 byte');
+is( (-s -f 'TEST'), $size, "-s returns real size" );
+is(-f -s 'TEST', 1, "-f and -s: plain file with non-zero size");
 
 # now with an empty file
-my $tempfile = tempfile();
-open my $fh, ">", $tempfile;
-close $fh;
-ok( -f $tempfile );
-is( -s $tempfile, 0 );
-is( -f -s $tempfile, 0 );
-is( -s -f $tempfile, 0 );
-unlink_all $tempfile;
+is(-f $ro_empty_file, 1, "-f: plain file found");
+is(-s $ro_empty_file, 0, "-s: file has 0 bytes");
+is(-f -s $ro_empty_file, 0, "-f and -s: plain file with 0 bytes");
+is(-s -f $ro_empty_file, 0, "-s and -f: file with 0 bytes is plain file");
 
 # stacked -l
 eval { -l -e "TEST" };
@@ -101,32 +95,35 @@ like $@, qr/^The stat preceding -l _ wasn't an lstat at /,
 }
 # Make sure -l is using the previous stat buffer, and not using the previ-
 # ous op’s return value as a file name.
+# t/TEST can be a symlink under -Dmksymlinks, so use our temporary file.
 SKIP: {
  use Perl::OSType 'os_type';
- if (os_type ne 'Unix') { skip "Not Unix", 2 }
- if (-l "TEST") { skip "TEST is a symlink", 2 }
+ if (os_type ne 'Unix') { skip "Not Unix", 3 }
  chomp(my $ln = `which ln`);
- if ( ! -e $ln ) { skip "No ln"   , 2 }
- lstat "TEST";
- `ln -s TEST 1`;
- ok ! -l -e _, 'stacked -l uses previous stat, not previous retval';
+ if ( ! -e $ln ) { skip "No ln"   , 3 }
+ lstat $ro_empty_file;
+ `ln -s $ro_empty_file 1`;
+ isnt(-l -e _, 1, 'stacked -l uses previous stat, not previous retval');
  unlink 1;
 
  # Since we already have our skip block set up, we might as well put this
  # test here, too:
  # -l always treats a non-bareword argument as a file name
- system qw "ln -s TEST", \*foo;
+ system 'ln', '-s', $ro_empty_file, \*foo;
  local $^W = 1;
- ok -l \*foo, '-l \*foo is a file name';
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
+ is(-l \*foo, 1, '-l \*foo is a file name');
+ ok($warnings[0] =~ /-l on filehandle foo/, 'warning for -l $handle');
  unlink \*foo;
 }
 
 # test that _ is a bareword after filetest operators
 
 -f 'TEST';
-ok( -f _ );
+is(-f _, 1, "_ is bareword after filetest operator");
 sub _ { "this is not a file name" }
-ok( -f _ );
+is(-f _, 1, "_ is bareword after filetest operator");
 
 my $over;
 {
@@ -181,7 +178,8 @@ eval { require Fcntl } or $fcntl_not_available = 1;
 
 for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
     $over = [];
-    ok( my $rv = eval "-$op \$ft",  "overloaded -$op succeeds" )
+    my $rv = eval "-$op \$ft";
+    isnt( $rv, undef,               "overloaded -$op succeeds" )
         or diag( $@ );
     is( $over->[0], $ftstr,         "correct object for overloaded -$op" );
     is( $over->[1], $op,            "correct op for overloaded -$op" );
@@ -200,8 +198,7 @@ for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
 
     $over = 0;
     $rv = eval "-$op \$str";
-    ok( !$@,                        "-$op succeeds with string overloading" )
-        or diag( $@ );
+    is($@, "",                      "-$op succeeds with string overloading");
     is( $rv, eval "-$op 'TEST'",    "correct -$op on string overload" );
     is( $over,      $exp,           "string overload $is called for -$op" );
 
@@ -223,8 +220,7 @@ for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
     is( $rv,        "-$op",         "correct -$op on string/-X overload" );
 
     $rv = eval "-$op \$neither";
-    ok( !$@,                        "-$op succeeds with random overloading" )
-        or diag( $@ );
+    is($@, "",                      "-$op succeeds with random overloading");
     is( $rv, eval "-$op \$nstr",    "correct -$op with random overloading" );
 
     is( eval "-r -$op \$ft", "-r",      "stacked overloaded -$op" );
@@ -240,8 +236,8 @@ for my $op (split //, "rwxoRWXOezsfdlpSbctugkTMBAC") {
 # -l and fatal warnings
 stat "test.pl";
 eval { use warnings FATAL => io; -l cradd };
-ok !stat _,
-  'fatal warnings do not prevent -l HANDLE from setting stat status';
+isnt(stat _, 1,
+     'fatal warnings do not prevent -l HANDLE from setting stat status');
 
 # File test ops should not call get-magic on the topmost SV on the stack if
 # it belongs to another op.
@@ -288,17 +284,17 @@ SKIP: {
     open my $fh, 'test.pl';
     stat $Perl; # a binary file
     stat *$fh{IO};
-    ok -T _, '-T _ works after stat $ioref';
+    is(-T _, 1, '-T _ works after stat $ioref');
 
     # and after -r $ioref
     -r *$fh{IO};
-    ok -T _, '-T _ works after -r $ioref';
+    is(-T _, 1, '-T _ works after -r $ioref');
 
     # -T _ on closed filehandle should still reset stat info
     stat $fh;
     close $fh;
     -T _;
-    ok !stat _, '-T _ on closed filehandle resets stat info';
+    isnt(stat _, 1, '-T _ on closed filehandle resets stat info');
 
     lstat "test.pl";
     -T $fh; # closed
@@ -325,7 +321,7 @@ SKIP: {
     if (-e $rand_file_name) { skip "File $rand_file_name exists", 1 }
     stat 'test.pl';
     -T $rand_file_name;
-    ok !stat _, '-T "nonexistent" resets stat success status';
+    isnt(stat _, 1, '-T "nonexistent" resets stat success status');
 }
 
 # Unsuccessful filetests on filehandles should leave stat buffers in the
diff --git a/gnu/usr.bin/perl/t/op/for.t b/gnu/usr.bin/perl/t/op/for.t
new file mode 100644
index 00000000000..0571380300a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/for.t
@@ -0,0 +1,564 @@
+#!./perl
+
+BEGIN {
+    require "test.pl";
+}
+
+plan(104);
+
+# A lot of tests to check that reversed for works.
+
+@array = ('A', 'B', 'C');
+for (@array) {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for array');
+$r = '';
+for (1,2,3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list');
+$r = '';
+for (map {$_} @array) {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for array via map');
+$r = '';
+for (map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via map');
+$r = '';
+for (1 .. 3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via ..');
+$r = '';
+for ('A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via ..');
+
+$r = '';
+for (reverse @array) {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for array');
+$r = '';
+for (reverse 1,2,3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list');
+$r = '';
+for (reverse map {$_} @array) {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for array via map');
+$r = '';
+for (reverse map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via map');
+$r = '';
+for (reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via ..');
+$r = '';
+for (reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for list via ..');
+
+$r = '';
+for my $i (@array) {
+    $r .= $i;
+}
+is ($r, 'ABC', 'Forwards for array with var');
+$r = '';
+for my $i (1,2,3) {
+    $r .= $i;
+}
+is ($r, '123', 'Forwards for list with var');
+$r = '';
+for my $i (map {$_} @array) {
+    $r .= $i;
+}
+is ($r, 'ABC', 'Forwards for array via map with var');
+$r = '';
+for my $i (map {$_} 1,2,3) {
+    $r .= $i;
+}
+is ($r, '123', 'Forwards for list via map with var');
+$r = '';
+for my $i (1 .. 3) {
+    $r .= $i;
+}
+is ($r, '123', 'Forwards for list via .. with var');
+$r = '';
+for my $i ('A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var');
+
+$r = '';
+for my $i (reverse @array) {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for array with var');
+$r = '';
+for my $i (reverse 1,2,3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list with var');
+$r = '';
+for my $i (reverse map {$_} @array) {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for array via map with var');
+$r = '';
+for my $i (reverse map {$_} 1,2,3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via map with var');
+$r = '';
+for my $i (reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with var');
+$r = '';
+for my $i (reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var');
+
+# For some reason the generate optree is different when $_ is implicit.
+$r = '';
+for $_ (@array) {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for array with explicit $_');
+$r = '';
+for $_ (1,2,3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list with explicit $_');
+$r = '';
+for $_ (map {$_} @array) {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for array via map with explicit $_');
+$r = '';
+for $_ (map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via map with explicit $_');
+$r = '';
+for $_ (1 .. 3) {
+    $r .= $_;
+}
+is ($r, '123', 'Forwards for list via .. with var with explicit $_');
+$r = '';
+for $_ ('A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'ABC', 'Forwards for list via .. with var with explicit $_');
+
+$r = '';
+for $_ (reverse @array) {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for array with explicit $_');
+$r = '';
+for $_ (reverse 1,2,3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list with explicit $_');
+$r = '';
+for $_ (reverse map {$_} @array) {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for array via map with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, '321', 'Reverse for list via .. with var with explicit $_');
+$r = '';
+for $_ (reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, 'CBA', 'Reverse for list via .. with var with explicit $_');
+
+# I don't think that my is that different from our in the optree. But test a
+# few:
+$r = '';
+for our $i (reverse @array) {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for array with our var');
+$r = '';
+for our $i (reverse 1,2,3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list with our var');
+$r = '';
+for our $i (reverse map {$_} @array) {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for array via map with our var');
+$r = '';
+for our $i (reverse map {$_} 1,2,3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via map with our var');
+$r = '';
+for our $i (reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, '321', 'Reverse for list via .. with our var');
+$r = '';
+for our $i (reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, 'CBA', 'Reverse for list via .. with our var');
+
+
+$r = '';
+for (1, reverse @array) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array with leading value');
+$r = '';
+for ('A', reverse 1,2,3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list with leading value');
+$r = '';
+for (1, reverse map {$_} @array) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array via map with leading value');
+$r = '';
+for ('A', reverse map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via map with leading value');
+$r = '';
+for ('A', reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value');
+$r = '';
+for (1, reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value');
+
+$r = '';
+for (reverse (@array), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for array with trailing value');
+$r = '';
+for (reverse (1,2,3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list with trailing value');
+$r = '';
+for (reverse (map {$_} @array), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for array via map with trailing value');
+$r = '';
+for (reverse (map {$_} 1,2,3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via map with trailing value');
+$r = '';
+for (reverse (1 .. 3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value');
+$r = '';
+for (reverse ('A' .. 'C'), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value');
+
+
+$r = '';
+for $_ (1, reverse @array) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array with leading value with explicit $_');
+$r = '';
+for $_ ('A', reverse 1,2,3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list with leading value with explicit $_');
+$r = '';
+for $_ (1, reverse map {$_} @array) {
+    $r .= $_;
+}
+is ($r, '1CBA',
+    'Reverse for array via map with leading value with explicit $_');
+$r = '';
+for $_ ('A', reverse map {$_} 1,2,3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via map with leading value with explicit $_');
+$r = '';
+for $_ ('A', reverse 1 .. 3) {
+    $r .= $_;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value with explicit $_');
+$r = '';
+for $_ (1, reverse 'A' .. 'C') {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value with explicit $_');
+
+$r = '';
+for $_ (reverse (@array), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for array with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (1,2,3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (map {$_} @array), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1',
+    'Reverse for array via map with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (map {$_} 1,2,3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A',
+    'Reverse for list via map with trailing value with explicit $_');
+$r = '';
+for $_ (reverse (1 .. 3), 'A') {
+    $r .= $_;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value with explicit $_');
+$r = '';
+for $_ (reverse ('A' .. 'C'), 1) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value with explicit $_');
+
+$r = '';
+for my $i (1, reverse @array) {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for array with leading value and var');
+$r = '';
+for my $i ('A', reverse 1,2,3) {
+    $r .= $i;
+}
+is ($r, 'A321', 'Reverse for list with leading value and var');
+$r = '';
+for my $i (1, reverse map {$_} @array) {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for array via map with leading value and var');
+$r = '';
+for my $i ('A', reverse map {$_} 1,2,3) {
+    $r .= $i;
+}
+is ($r, 'A321', 'Reverse for list via map with leading value and var');
+$r = '';
+for my $i ('A', reverse 1 .. 3) {
+    $r .= $i;
+}
+is ($r, 'A321', 'Reverse for list via .. with leading value and var');
+$r = '';
+for my $i (1, reverse 'A' .. 'C') {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for list via .. with leading value and var');
+
+$r = '';
+for my $i (reverse (@array), 1) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for array with trailing value and var');
+$r = '';
+for my $i (reverse (1,2,3), 'A') {
+    $r .= $i;
+}
+is ($r, '321A', 'Reverse for list with trailing value and var');
+$r = '';
+for my $i (reverse (map {$_} @array), 1) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for array via map with trailing value and var');
+$r = '';
+for my $i (reverse (map {$_} 1,2,3), 'A') {
+    $r .= $i;
+}
+is ($r, '321A', 'Reverse for list via map with trailing value and var');
+$r = '';
+for my $i (reverse (1 .. 3), 'A') {
+    $r .= $i;
+}
+is ($r, '321A', 'Reverse for list via .. with trailing value and var');
+$r = '';
+for my $i (reverse ('A' .. 'C'), 1) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for list via .. with trailing value and var');
+
+
+$r = '';
+for (reverse 1, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for value and array');
+$r = '';
+for (reverse map {$_} 1, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for value and array via map');
+$r = '';
+for (reverse 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array');
+$r = '';
+for (reverse 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array');
+$r = '';
+for (reverse map {$_} 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map');
+$r = '';
+for (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map');
+
+$r = '';
+for (reverse (@array, 1)) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array and value');
+$r = '';
+for (reverse (map {$_} @array, 1)) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array and value via map');
+
+$r = '';
+for $_ (reverse 1, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for value and array with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 1, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA1', 'Reverse for value and array via map with explicit $_');
+$r = '';
+for $_ (reverse 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 1 .. 3, @array) {
+    $r .= $_;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with explicit $_');
+$r = '';
+for $_ (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $_;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with explicit $_');
+
+$r = '';
+for $_ (reverse (@array, 1)) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array and value with explicit $_');
+$r = '';
+for $_ (reverse (map {$_} @array, 1)) {
+    $r .= $_;
+}
+is ($r, '1CBA', 'Reverse for array and value via map with explicit $_');
+
+
+$r = '';
+for my $i (reverse 1, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for value and array with var');
+$r = '';
+for my $i (reverse map {$_} 1, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA1', 'Reverse for value and array via map with var');
+$r = '';
+for my $i (reverse 1 .. 3, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse 'X' .. 'Z', @array) {
+    $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array with var');
+$r = '';
+for my $i (reverse map {$_} 1 .. 3, @array) {
+    $r .= $i;
+}
+is ($r, 'CBA321', 'Reverse for .. and array via map with var');
+$r = '';
+for my $i (reverse map {$_} 'X' .. 'Z', @array) {
+    $r .= $i;
+}
+is ($r, 'CBAZYX', 'Reverse for .. and array via map with var');
+
+$r = '';
+for my $i (reverse (@array, 1)) {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for array and value with var');
+$r = '';
+for my $i (reverse (map {$_} @array, 1)) {
+    $r .= $i;
+}
+is ($r, '1CBA', 'Reverse for array and value via map with var');
+
+TODO: {
+    if (do {17; foreach (1, 2) { 1; } } != 17) {
+        #print "not ";
+	todo_skip("RT #1085: what should be output of perl -we 'print do { foreach (1, 2) { 1; } }'");
+     }
+}
+
+TODO: {
+    local $TODO = "RT #2166: foreach spuriously autovivifies";
+    my %h;
+    foreach (@h{a, b}) {}
+    if(keys(%h)) {
+        todo_skip("RT #2166: foreach spuriously autovivifies");
+    }
+}
diff --git a/gnu/usr.bin/perl/t/op/getpid.t b/gnu/usr.bin/perl/t/op/getpid.t
index 7688240182d..ac1f8bb7225 100644
--- a/gnu/usr.bin/perl/t/op/getpid.t
+++ b/gnu/usr.bin/perl/t/op/getpid.t
@@ -33,10 +33,15 @@ new threads( sub { ($pid2, $ppid2) = ($$, getppid()); } ) -> join();
 # If this breaks you're either running under LinuxThreads (and we
 # haven't detected it) or your system doesn't have POSIX thread
 # semantics.
+# Newer linuxthreads from gnukfreebsd (0.11) does have POSIX thread
+# semantics, so include a version check
+# <http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=675606>
+my $thread_version = qx[getconf GNU_LIBPTHREAD_VERSION 2>&1];
+chomp $thread_version;
 if ($^O =~ /^(?:gnukfreebsd|linux)$/ and
-    (my $linuxthreads = qx[getconf GNU_LIBPTHREAD_VERSION 2>&1]) =~ /linuxthreads/) {
-    chomp $linuxthreads;
-    diag "We're running under $^O with linuxthreads <$linuxthreads>";
+    $thread_version =~ /linuxthreads/ and
+    !($thread_version =~ /linuxthreads-(.*)/ && $1 >= 0.11)) {
+    diag "We're running under $^O with linuxthreads <$thread_version>";
     isnt($pid,  $pid2, "getpid() in a thread is different from the parent on this non-POSIX system");
     isnt($ppid, $ppid2, "getppid() in a thread is different from the parent on this non-POSIX system");
 } else {
diff --git a/gnu/usr.bin/perl/t/op/getppid.t b/gnu/usr.bin/perl/t/op/getppid.t
index a63161014a4..a8d0f2cb3b8 100755
--- a/gnu/usr.bin/perl/t/op/getppid.t
+++ b/gnu/usr.bin/perl/t/op/getppid.t
@@ -20,6 +20,9 @@ BEGIN {
     plan (8);
 }
 
+# No, we don't want any zombies. kill 0, $ppid spots zombies :-(
+$SIG{CHLD} = 'IGNORE';
+
 sub fork_and_retrieve {
     my $which = shift;
     pipe my ($r, $w) or die "pipe: $!\n";
@@ -27,13 +30,16 @@ sub fork_and_retrieve {
 
     if ($pid) {
 	# parent
-	close $w;
+	close $w or die "close: $!\n";
 	$_ = <$r>;
 	chomp;
 	die "Garbled output '$_'"
-	    unless my ($first, $second) = /^(\d+),(\d+)\z/;
+	    unless my ($how, $first, $second) = /^([a-z]+),(\d+),(\d+)\z/;
 	cmp_ok ($first, '>=', 1, "Parent of $which grandchild");
-	cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild");
+	my $message = "grandchild waited until '$how'";
+	cmp_ok ($second, '>=', 1, "New parent of orphaned $which grandchild")
+	    ? note ($message) : diag ($message);
+
 	SKIP: {
 	    skip("Orphan processes are not reparented on QNX", 1)
 		if $^O eq 'nto';
@@ -46,20 +52,55 @@ sub fork_and_retrieve {
 	# child
 	# Prevent test.pl from thinking that we failed to run any tests.
 	$::NO_ENDING = 1;
-	close $r;
+	close $r or die "close: $!\n";
 
+	pipe my ($r2, $w2) or die "pipe: $!\n";
+	pipe my ($r3, $w3) or die "pipe: $!\n";
 	my $pid2 = fork; defined $pid2 or die "fork: $!\n";
 	if ($pid2) {
-	    close $w;
-	    sleep 1;
+	    close $w or die "close: $!\n";
+	    close $w2 or die "close: $!\n";
+	    close $r3 or die "close: $!\n";
+	    # Wait for our child to signal that it's read our PID:
+	    <$r2>;
+	    # Implicit close of $w3:
+	    exit 0;
 	}
 	else {
 	    # grandchild
+	    close $r2 or die "close: $!\n";
+	    close $w3 or die "close: $!\n";
 	    my $ppid1 = getppid();
-	    # Wait for immediate parent to exit
-	    sleep 2;
+	    # kill 0 isn't portable:
+	    my $can_kill0 = eval {
+		kill 0, $ppid1;
+	    };
+	    my $how = $can_kill0 ? 'undead' : 'sleep';
+
+	    # Tell immediate parent to exit:
+	    close $w2 or die "close: $!\n";
+	    # Wait for it to (start to) exit:
+	    <$r3>;
+	    # Which sadly isn't enough to be sure that it has exited - often we
+	    # get switched in during its shutdown, after $w3 closes but before
+	    # it exits and we get reparented.
+	    if ($can_kill0) {
+		# use kill 0 where possible. Try 10 times, then give up:
+		for (0..9) {
+		    my $got = kill 0, $ppid1;
+		    die "kill: $!" unless defined $got;
+		    if (!$got) {
+			$how = 'kill';
+			last;
+		    }
+		    sleep 1;
+		}
+	    } else {
+		# Fudge it by waiting a bit more:
+		sleep 2;
+	    }
 	    my $ppid2 = getppid();
-	    print $w "$ppid1,$ppid2\n";
+	    print $w "$how,$ppid1,$ppid2\n";
 	}
 	exit 0;
     }
diff --git a/gnu/usr.bin/perl/t/op/grent.t b/gnu/usr.bin/perl/t/op/grent.t
index 3611c1b890e..3b28619605e 100644
--- a/gnu/usr.bin/perl/t/op/grent.t
+++ b/gnu/usr.bin/perl/t/op/grent.t
@@ -28,11 +28,11 @@ if (not defined $where) {	# Try NIS.
         {
             print "# `ypcat group` worked\n";
 
-            # Check to make sure we're really using NIS.
+            # Check to make sure we are really using NIS.
             if( open(NSSW, "/etc/nsswitch.conf" ) ) {
                 my($group) = grep /^\s*group:/, <NSSW>;
 
-                # If there's no group line, assume it default to compat.
+                # If there is no group line, assume it default to compat.
                 if( !$group || $group !~ /(nis|compat)/ ) {
                     print "# Doesn't look like you're using NIS in ".
                           "/etc/nsswitch.conf\n";
@@ -91,7 +91,7 @@ ok( setgrent(), 'setgrent' ) || print "# $!\n";
 
 while (<GR>) {
     chomp;
-    # LIMIT -1 so that groups with no users don't fall off
+    # LIMIT -1 so that groups with no users do not fall off
     my @s = split /:/, $_, -1;
     my ($name_s,$passwd_s,$gid_s,$members_s) = @s;
     if (@s) {
@@ -158,7 +158,7 @@ EOEX
     fail();
     print "#\t (not necessarily serious: run t/op/grent.t by itself)\n";
 } else {
-    pass();
+    pass("getgrgid and getgrnam performed as expected");
 }
 
 # Test both the scalar and list contexts.
@@ -183,6 +183,6 @@ for (1..$max) {
 }
 endgrent();
 
-is("@gr1", "@gr2");
+is("@gr1", "@gr2", "getgrent gave same results in scalar and list contexts");
 
 close(GR);
diff --git a/gnu/usr.bin/perl/t/op/hashassign.t b/gnu/usr.bin/perl/t/op/hashassign.t
index 37a7674bb17..57a625cb2e4 100644
--- a/gnu/usr.bin/perl/t/op/hashassign.t
+++ b/gnu/usr.bin/perl/t/op/hashassign.t
@@ -8,7 +8,7 @@ BEGIN {
 
 # use strict;
 
-plan tests => 218;
+plan tests => 309;
 
 my @comma = ("key", "value");
 
@@ -280,9 +280,9 @@ foreach my $chr (60, 200, 600, 6000, 60000) {
 	'hash assignment in list context removes duplicates' );
     is( (join ':', %h = qw(a 1 a 2 b 3 c 4 d 5 d 6)), 'a:2:b:3:c:4:d:6',
 	'hash assignment in list context removes duplicates 2' );
-    is( scalar( %h = (1,2,1,3,1,4,1,5) ), 2,
+    is( scalar( %h = (1,2,1,3,1,4,1,5) ), 8,
 	'hash assignment in scalar context' );
-    is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 3,
+    is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 9,
 	'scalar + hash assignment in scalar context' );
     $ar = [ %h = (1,2,1,3,1,4,1,5) ];
     is( $#$ar, 1, 'hash assignment in list context' );
@@ -320,3 +320,217 @@ SKIP: {
  undef %tb;
  is $p, \%tb, "hash undef should not zap weak refs";
 }
+
+# test odd hash assignment warnings
+{
+    my ($s, %h);
+    warning_like(sub {%h = (1..3)}, qr/^Odd number of elements in hash assignment/);
+    warning_like(sub {%h = ({})}, qr/^Reference found where even-sized list expected/);
+
+    warning_like(sub { ($s, %h) = (1..4)}, qr/^Odd number of elements in hash assignment/);
+    warning_like(sub { ($s, %h) = (1, {})}, qr/^Reference found where even-sized list expected/);
+}
+
+# hash assignment in scalar and list context with odd number of elements
+{
+    no warnings 'misc', 'uninitialized';
+    my %h; my $x;
+    is( join( ':', %h = (1..3)), '1:2:3:',
+	'odd hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" );
+    is( scalar( %h = (1..3) ), 3,
+	'odd hash assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" );
+    is( join(':', ($x,%h) = (0,1,2,3) ), '0:1:2:3:',
+	'scalar + odd hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" );
+    is( scalar( ($x,%h) = (0,1,2,3) ), 4,
+	'scalar + odd hash assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => undef} ), "correct value stored" );
+}
+
+# hash assignment in scalar and list context with odd number of elements
+# and duplicates
+{
+    no warnings 'misc', 'uninitialized';
+    my %h; my $x;
+    is( (join ':', %h = (1,1,1)), '1:',
+	'odd hash assignment in list context with duplicates' );
+    ok( eq_hash( \%h, {1 => undef} ), "correct value stored" );
+    is( scalar(%h = (1,1,1)), 3,
+	'odd hash assignment in scalar context with duplicates' );
+    ok( eq_hash( \%h, {1 => undef} ), "correct value stored" );
+    is( join(':', ($x,%h) = (0,1,1,1) ), '0:1:',
+	'scalar + odd hash assignment in list context with duplicates' );
+    ok( eq_hash( \%h, {1 => undef} ), "correct value stored" );
+    is( scalar( ($x,%h) = (0,1,1,1) ), 4,
+	'scalar + odd hash assignment in scalar context with duplicates' );
+    ok( eq_hash( \%h, {1 => undef} ), "correct value stored" );
+}
+
+# hash followed by more elements on LHS of list assignment
+# (%h, ...) = ...;
+{
+    my (%h, %x, @x, $x);
+    is( scalar( (%h,$x) = (1,2,3,4)), 4,
+	'hash+scalar assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+    # this arguable, but this is how it works
+    is( join(':', (%h,$x) = (1,2,3,4)), '1:2:3:4',
+	'hash+scalar assignment in list context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+
+    is( scalar( (%h,%x) = (1,2,3,4)), 4,
+	'hash+hash assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ),               "correct hash" );
+    is( join(':', (%h,%x) = (1,2,3,4)), '1:2:3:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ),               "correct hash" );
+
+    is( scalar( (%h,@x) = (1,2,3,4)), 4,
+	'hash+array assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ),              "correct array" );
+    is( join(':', (%h,@x) = (1,2,3,4)), '1:2:3:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 2, 3 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ),              "correct array" );
+}
+
+# hash followed by more elements on LHS of list assignment
+# and duplicates on RHS
+# (%h, ...) = (1)x10;
+{
+    my (%h, %x, @x, $x);
+    is( scalar( (%h,$x) = (1,2,1,4)), 4,
+	'hash+scalar assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+    # this arguable, but this is how it works
+    is( join(':', (%h,$x) = (1,2,1,4)), '1:4',
+	'hash+scalar assignment in list context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+
+    is( scalar( (%h,%x) = (1,2,1,4)), 4,
+	'hash+hash assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ), "correct hash" );
+    is( join(':', (%h,%x) = (1,2,1,4)), '1:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ),               "correct hash" );
+
+    is( scalar( (%h,@x) = (1,2,1,4)), 4,
+	'hash+array assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ), "correct array" );
+    is( join(':', (%h,@x) = (1,2,1,4)), '1:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ),      "correct array" );
+}
+
+# hash followed by more elements on LHS of list assignment
+# and duplicates with odd number of elements on RHS
+# (%h, ...) = (1,2,3,4,1);
+{
+    no warnings 'misc'; # suppress oddball warnings
+    my (%h, %x, @x, $x);
+    is( scalar( (%h,$x) = (1,2,3,4,1)), 5,
+	'hash+scalar assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+    # this arguable, but this is how it works
+    is( join(':', map $_//'undef', (%h,$x) = (1,2,3,4,1)), '1:undef:3:4',
+	'hash+scalar assignment in list context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    is( $x, undef, "correct scalar" );
+
+    is( scalar( (%h,%x) = (1,2,3,4,1)), 5,
+	'hash+hash assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ), "correct hash" );
+    is( join(':', map $_//'undef', (%h,%x) = (1,2,3,4,1)), '1:undef:3:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    ok( eq_hash( \%x, {} ),               "correct hash" );
+
+    is( scalar( (%h,@x) = (1,2,3,4,1)), 5,
+	'hash+array assignment in scalar context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ), "correct array" );
+    is( join(':', map $_//'undef', (%h,@x) = (1,2,3,4,1)), '1:undef:3:4',
+	'hash+hash assignment in list context' );
+    ok( eq_hash( \%h, {1 => undef, 3 => 4} ), "correct hash" );
+    ok( eq_array( \@x, [] ),      "correct array" );
+}
+
+
+# not enough elements on rhs
+# ($x,$y,$z,...) = (1);
+{
+    my ($x,$y,$z,@a,%h);
+    is( join(':', ($x, $y, %h) = (1)), '1',
+        'only assigned elements are returned in list context');
+    is( join(':', ($x, $y, %h) = (1,1)), '1:1',
+        'only assigned elements are returned in list context');
+    no warnings 'misc'; # suppress oddball warnings
+    is( join(':', map $_//'undef', ($x, $y, %h) = (1,1,1)), '1:1:1:undef',
+        'only assigned elements are returned in list context');
+    is( join(':', ($x, $y, %h) = (1,1,1,1)), '1:1:1:1',
+        'only assigned elements are returned in list context');
+    is( join(':', map $_//'undef', ($x, %h, $y) = (1,2,3,4)),
+        '1:2:3:4:undef',
+        'only assigned elements are returned in list context');
+    is( join(':', ($x, $y, @h) = (1)), '1',
+        'only assigned elements are returned in list context');
+    is( join(':', ($x, @h, $y) = (1,2,3,4)), '1:2:3:4',
+        'only assigned elements are returned in list context');
+}
+
+# lvaluedness of list context
+{
+    my %h; my ($x, $y, $z);
+    $_++ foreach %h = (1,2,3,4);
+    ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "aassign in list context returns lvalues" );
+
+    $_++ foreach %h = (1,2,1,4);
+    ok( eq_hash( \%h, {1 => 5} ), "the same for assignment with duplicates" );
+
+    $_++ foreach ($x, %h) = (0,1,2,3,4);
+    is( $x, 1, "... and leading scalar" );
+    ok( eq_hash( \%h, {1 => 3, 3 => 5} ), "... scalar followed by hash" );
+
+    {
+        no warnings 'misc';
+        $_++ foreach %h = (1,2,3);
+        ok( eq_hash( \%h, {1 => 3, 3 => 1} ), "odd elements also lvalued" );
+    }
+
+    $x = 0;
+    $_++ foreach %h = ($x,$x);
+    is($x, 0, "returned values are not aliased to RHS of the assignment operation");
+
+    %h = ();
+    $x = 0;
+    $_++ foreach sub :lvalue { %h = ($x,$x) }->();
+    is($x, 0,
+     "returned values are not aliased to RHS of assignment in lvalue sub");
+
+    $_++ foreach ($x,$y,%h,$z) = (0);
+    ok( eq_array([$x,$y,%h,$z], [1,undef,undef]), "only assigned values are returned" );
+
+    $_++ foreach ($x,$y,%h,$z) = (0,1);
+    ok( eq_array([$x,$y,%h,$z], [1,2,undef]), "only assigned values are returned" );
+
+    no warnings 'misc'; # suppress oddball warnings
+    $_++ foreach ($x,$y,%h,$z) = (0,1,2);
+    ok( eq_array([$x,$y,%h,$z], [1,2,2,1,undef]), "only assigned values are returned" );
+}
+
+
diff --git a/gnu/usr.bin/perl/t/op/heredoc.t b/gnu/usr.bin/perl/t/op/heredoc.t
new file mode 100644
index 00000000000..08b0af2c2d0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/heredoc.t
@@ -0,0 +1,85 @@
+# tests for heredocs besides what is tested in base/lex.t
+
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   require './test.pl';
+}
+
+use strict;
+plan(tests => 9);
+
+
+# heredoc without newline (#65838)
+{
+    my $string = <<'HEREDOC';
+testing for 65838
+HEREDOC
+
+    my $code = "<<'HEREDOC';\n${string}HEREDOC";  # HD w/o newline, in eval-string
+    my $hd = eval $code or warn "$@ ---";
+    is($hd, $string, "no terminating newline in string-eval");
+}
+
+
+# here-doc edge cases
+{
+    my $string = "testing for 65838";
+
+    fresh_perl_is(
+        "print <<'HEREDOC';\n${string}\nHEREDOC",
+        $string,
+        {},
+        "heredoc at EOF without trailing newline"
+    );
+
+    fresh_perl_is(
+        "print <<;\n$string\n",
+        $string,
+        { switches => ['-X'] },
+        "blank-terminated heredoc at EOF"
+    );
+    fresh_perl_is(
+        "print <<\n$string\n",
+        $string,
+        { switches => ['-X'] },
+        "blank-terminated heredoc at EOF and no semicolon"
+    );
+    fresh_perl_is(
+        "print <<foo\r\nick and queasy\r\nfoo\r\n",
+        'ick and queasy',
+        { switches => ['-X'] },
+        "crlf-terminated heredoc"
+    );
+    fresh_perl_is(
+        "print qq|\${\\<<foo}|\nick and queasy\nfoo\n",
+        'ick and queasy',
+        { switches => ['-w'], stderr => 1 },
+        'no warning for qq|${\<<foo}| in file'
+    );
+}
+
+
+# here-doc parse failures
+{
+    fresh_perl_like(
+        "print <<HEREDOC;\nwibble\n HEREDOC",
+        qr/find string terminator/,
+        {},
+        "string terminator must start at newline"
+    );
+
+    fresh_perl_like(
+        "print <<;\nno more newlines",
+        qr/find string terminator/,
+        { switches => ['-X'] },
+        "empty string terminator still needs a newline"
+    );
+
+    fresh_perl_like(
+        "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
+        qr/find string terminator/,
+        {},
+        "long terminator fails correctly"
+    );
+}
diff --git a/gnu/usr.bin/perl/t/op/inccode.t b/gnu/usr.bin/perl/t/op/inccode.t
index 938a4e0665d..d34e735c39d 100644
--- a/gnu/usr.bin/perl/t/op/inccode.t
+++ b/gnu/usr.bin/perl/t/op/inccode.t
@@ -21,7 +21,7 @@ unless (is_miniperl()) {
 
 use strict;
 
-plan(tests => 49 + !is_miniperl() * (3 + 14 * $can_fork));
+plan(tests => 60 + !is_miniperl() * (3 + 14 * $can_fork));
 
 sub get_temp_fh {
     my $f = tempfile();
@@ -194,12 +194,27 @@ $ret ||= do 'abc.pl';
 is( $ret, 'abc', 'do "abc.pl" sees return value' );
 
 {
-    my $filename = './Foo.pm';
+    my $got;
     #local @INC; # local fails on tied @INC
     my @old_INC = @INC; # because local doesn't work on tied arrays
-    @INC = sub { $filename = 'seen'; return undef; };
-    eval { require $filename; };
-    is( $filename, 'seen', 'the coderef sees fully-qualified pathnames' );
+    @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;
 }
 
@@ -226,6 +241,26 @@ 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;
+}
+
 exit if is_miniperl();
 
 SKIP: {
diff --git a/gnu/usr.bin/perl/t/op/incfilter.t b/gnu/usr.bin/perl/t/op/incfilter.t
index 582b691d827..6227c4ac371 100644
--- a/gnu/usr.bin/perl/t/op/incfilter.t
+++ b/gnu/usr.bin/perl/t/op/incfilter.t
@@ -13,7 +13,7 @@ use strict;
 use Config;
 use Filter::Util::Call;
 
-plan(tests => 144);
+plan(tests => 145);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -216,6 +216,11 @@ do [\'pa', \&generator_with_state,
      "pass('And return multiple lines');\n",
     ]] or die;
 
+@origlines = keys %{{ "1\n+\n2\n" => 1 }};
+@lines = @origlines;
+do \&generator or die;
+is $origlines[0], "1\n+\n2\n", 'ink filters do not mangle cow buffers';
+
 # d8723a6a74b2c12e wasn't perfect, as the char * returned by SvPV*() can be
 # a temporary, freed at the next FREETMPS. And there is a FREETMPS in
 # pp_require
diff --git a/gnu/usr.bin/perl/t/op/length.t b/gnu/usr.bin/perl/t/op/length.t
index 55260d32b83..b144b097466 100644
--- a/gnu/usr.bin/perl/t/op/length.t
+++ b/gnu/usr.bin/perl/t/op/length.t
@@ -6,7 +6,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan (tests => 38);
+plan (tests => 41);
 
 print "not " unless length("")    == 0;
 print "ok 1\n";
@@ -191,7 +191,12 @@ is($u, undef);
 
 my $uo = bless [], 'U';
 
-is(length($uo), undef, "Length of overloaded reference");
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    is(length($uo), 0, "Length of overloaded reference");
+    like $w, qr/uninitialized/, 'uninit warning for stringifying as undef';
+}
 
 my $ul = 3;
 is(($ul = length(undef)), undef, 
@@ -204,11 +209,14 @@ is(($ul = length($u)), undef,
 is($ul, undef, "Assigned length of tied undef with result in TARG");
 
 $ul = 3;
-is(($ul = length($uo)), undef,
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    is(($ul = length($uo)), 0,
                 "Returned length of overloaded undef with result in TARG");
-is($ul, undef, "Assigned length of overloaded undef with result in TARG");
-
-# ok(!defined $uo); Turns you can't test this. FIXME for pp_defined?
+    like $w, qr/uninitialized/, 'uninit warning for stringifying as undef';
+}    
+is($ul, 0, "Assigned length of overloaded undef with result in TARG");
 
 {
     my $y = "\x{100}BC";
@@ -231,4 +239,10 @@ is($ul, undef, "Assigned length of overloaded undef with result in TARG");
     eval ' sub { length my @forecasts } ';
 }
 
+# length could be fooled by UTF8ness of non-magical variables changing with
+# stringification.
+my $ref = [];
+bless $ref, "\x{100}";
+is length $ref, length "$ref", 'length on reference blessed to utf8 class';
+
 is($warnings, 0, "There were no other warnings");
diff --git a/gnu/usr.bin/perl/t/op/lex.t b/gnu/usr.bin/perl/t/op/lex.t
index 0789077b5c9..43b4107b992 100755
--- a/gnu/usr.bin/perl/t/op/lex.t
+++ b/gnu/usr.bin/perl/t/op/lex.t
@@ -4,7 +4,7 @@ use warnings;
 
 require './test.pl';
 
-plan(tests => 4);
+plan(tests => 7);
 
 {
     no warnings 'deprecated';
@@ -45,3 +45,31 @@ curr_test(3);
 
 }
 
+{
+ delete local $ENV{PERL_UNICODE};
+ fresh_perl_is(
+  'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"',
+  'Constant(\N{a}) unknown at - line 1, within string' . "\n"
+ ."Execution of - aborted due to compilation errors.\n",
+   { stderr => 1 },
+  'correct output (and no crash) when charnames cannot load for \N{...}'
+ );
+}
+fresh_perl_is(
+  'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
+          $^H{charnames} = "foo" } "\N{a}"',
+  "Undefined subroutine &main::foo called at - line 2.\n"
+ ."Propagated at - line 2, within string\n"
+ ."Execution of - aborted due to compilation errors.\n",
+   { stderr => 1 },
+  'no crash when charnames cannot load and %^H holds string'
+);
+fresh_perl_is(
+  'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"};
+          $^H{charnames} = \"foo" } "\N{a}"',
+  "Not a CODE reference at - line 2.\n"
+ ."Propagated at - line 2, within string\n"
+ ."Execution of - aborted due to compilation errors.\n",
+   { stderr => 1 },
+  'no crash when charnames cannot load and %^H holds string reference'
+);
diff --git a/gnu/usr.bin/perl/t/op/lex_assign.t b/gnu/usr.bin/perl/t/op/lex_assign.t
index 330bf4eca25..290023cd216 100644
--- a/gnu/usr.bin/perl/t/op/lex_assign.t
+++ b/gnu/usr.bin/perl/t/op/lex_assign.t
@@ -3,6 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
 $| = 1;
@@ -24,17 +25,13 @@ sub subb {"in s"}
 
 @INPUT = <DATA>;
 @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
-print "1..", (11 + @INPUT + @simple_input), "\n";
-$ord = 0;
 
 sub wrn {"@_"}
 
 # Check correct optimization of ucfirst etc
-$ord++;
 my $a = "AB";
 my $b = "\u\L$a";
-print "not " unless $b eq 'Ab';
-print "ok $ord\n";
+is( $b, 'Ab', 'Check correct optimization of ucfirst, etc');
 
 # Check correct destruction of objects:
 my $dc = 0;
@@ -43,23 +40,18 @@ $a=8;
 my $b;
 { my $c = 6; $b = bless \$c, "A"}
 
-$ord++;
-print "not " unless $dc == 0;
-print "ok $ord\n";
+is($dc, 0, 'No destruction yet');
 
 $b = $a+5;
 
-$ord++;
-print "not " unless $dc == 1;
-print "ok $ord\n";
+is($dc, 1, 'object descruction via reassignment to variable');
 
-$ord++;
 my $xxx = 'b';
 $xxx = 'c' . ($xxx || 'e');
-print "not " unless $xxx eq 'cb';
-print "ok $ord\n";
+is( $xxx, 'cb', 'variables can be read before being overwritten');
 
 {				# Check calling STORE
+  note('Tied variables, calling STORE');
   my $sc = 0;
   sub B::TIESCALAR {bless [11], 'B'}
   sub B::FETCH { -(shift->[0]) }
@@ -69,30 +61,18 @@ print "ok $ord\n";
   tie $m, 'B';
   $m = 100;
 
-  $ord++;
-  print "not " unless $sc == 1;
-  print "ok $ord\n";
+  is( $sc, 1, 'STORE called when assigning scalar to tied variable' );
 
   my $t = 11;
   $m = $t + 89;
   
-  $ord++;
-  print "not " unless $sc == 2;
-  print "ok $ord\n";
-
-  $ord++;
-  print "# $m\nnot " unless $m == -117;
-  print "ok $ord\n";
+  is( $sc, 2, 'and again' );
+  is( $m,  -117, 'checking the tied variable result' );
 
   $m += $t;
 
-  $ord++;
-  print "not " unless $sc == 3;
-  print "ok $ord\n";
-
-  $ord++;
-  print "# $m\nnot " unless $m == 89;
-  print "ok $ord\n";
+  is( $sc, 3, 'called on self-increment' );
+  is( $m,  89, 'checking the tied variable result' );
 
 }
 
@@ -102,14 +82,14 @@ my ($l1, $l2, $l3, $l4);
 my $zzzz = 12;
 $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz;
 
-$ord++;
-print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot "
-  unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13
-  and $l2 == 13 and $l3 == 13 and $l4 == 13;
-print "ok $ord\n";
+is($zzz1, 13, 'chain assignment, part1');
+is($zzz2, 13, 'chain assignment, part2');
+is($l1,   13, 'chain assignment, part3');
+is($l2,   13, 'chain assignment, part4');
+is($l3,   13, 'chain assignment, part5');
+is($l4,   13, 'chain assignment, part6');
 
 for (@INPUT) {
-  $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
   chomp;
@@ -119,7 +99,13 @@ for (@INPUT) {
   $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i)
 	  ? "skip" : "# '$_'\nnot";
   $integer = ($comment =~ /^i_/) ? "use integer" : '' ;
-  (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip';
+  if ($skip eq 'skip') {
+    SKIP: {
+        skip $comment, 1;
+        pass();
+    }
+    next;
+  }
   
   eval <<EOE;
   local \$SIG{__WARN__} = \\&wrn;
@@ -128,23 +114,28 @@ for (@INPUT) {
   \$a = $op;
   \$b = $expectop;
   if (\$a ne \$b) {
-    print "# \$comment: got '\$a', expected '\$b'\n";
-    print "\$skip " if \$a ne \$b or \$skip eq 'skip';
+    SKIP: {
+        skip "\$comment: got '\$a', expected '\$b'", 1;
+        pass("")
+    }
   }
-  print "ok \$ord\\n";
+  pass();
 EOE
   if ($@) {
+    $warning = $@;
+    chomp $warning;
     if ($@ =~ /is unimplemented/) {
-      print "# skipping $comment: unimplemented:\nok $ord\n";
+      SKIP: {
+        skip $warning, 1;
+        pass($comment);
+      }
     } else {
-      warn $@;
-      print "# '$_'\nnot ok $ord\n";
+      fail($_ . ' ' . $warning);
     }
   }
 }
 
 for (@simple_input) {
-  $ord++;
   ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
   $comment = $op unless defined $comment;
   chomp;
@@ -155,23 +146,28 @@ for (@simple_input) {
   \$$variable = $operator \$$variable;
   \$toself = \$$variable;
   \$direct = $operator "Ac# Ca\\nxxx";
-  print "# \\\$$variable = $operator \\\$$variable\\nnot "
-    unless \$toself eq \$direct;
-  print "ok \$ord\\n";
+  is(\$toself, \$direct);
 EOE
   if ($@) {
+    $warning = $@;
+    chomp $warning;
     if ($@ =~ /is unimplemented/) {
-      print "# skipping $comment: unimplemented:\nok $ord\n";
+      SKIP: {
+        skip $warning, 1;
+        pass($comment);
+      }
     } elsif ($@ =~ /Can't (modify|take log of 0)/) {
-      print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
+      SKIP: {
+        skip $warning . ' ' . $comment . ' syntax not good for selfassign', 1;
+        pass();
+      }
     } else {
-      warn $@;
-      print "# '$_'\nnot ok $ord\n";
+      ##Something bad happened
+      fail($_ . ' ' . $warning);
     }
   }
 }
 
-$ord++;
 eval {
     sub PVBM () { 'foo' }
     index 'foo', PVBM;
@@ -183,11 +179,9 @@ eval {
 
     1;
 };
-if ($@) {
-    warn "# $@";
-    print 'not ';
-}
-print "ok $ord\n";
+is($@, '', 'ex-PVBM assert'.$@);
+
+done_testing();
 
 __END__
 ref $xref			# ref
diff --git a/gnu/usr.bin/perl/t/op/lexsub.t b/gnu/usr.bin/perl/t/op/lexsub.t
new file mode 100644
index 00000000000..0141399020c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/lexsub.t
@@ -0,0 +1,713 @@
+#!perl
+
+BEGIN {
+    chdir 't';
+    @INC = '../lib';
+    require './test.pl';
+    *bar::is = *is;
+    *bar::like = *like;
+}
+no warnings 'deprecated';
+plan 136;
+
+# -------------------- Errors with feature disabled -------------------- #
+
+eval "#line 8 foo\nmy sub foo";
+is $@, qq 'Experimental "my" subs not enabled at foo line 8.\n',
+  'my sub unexperimental error';
+eval "#line 8 foo\nCORE::state sub foo";
+is $@, qq 'Experimental "state" subs not enabled at foo line 8.\n',
+  'state sub unexperimental error';
+eval "#line 8 foo\nour sub foo";
+is $@, qq 'Experimental "our" subs not enabled at foo line 8.\n',
+  'our sub unexperimental error';
+
+# -------------------- our -------------------- #
+
+no warnings "experimental::lexical_subs";
+use feature 'lexical_subs';
+{
+  our sub foo { 42 }
+  is foo, 42, 'calling our sub from same package';
+  is &foo, 42, 'calling our sub from same package (amper)';
+  is do foo(), 42, 'calling our sub from same package (do)';
+  package bar;
+  sub bar::foo { 43 }
+  is foo, 42, 'calling our sub from another package';
+  is &foo, 42, 'calling our sub from another package (amper)';
+  is do foo(), 42, 'calling our sub from another package (do)';
+}
+package bar;
+is foo, 43, 'our sub falling out of scope';
+is &foo, 43, 'our sub falling out of scope (called via amper)';
+is do foo(), 43, 'our sub falling out of scope (called via amper)';
+package main;
+{
+  sub bar::a { 43 }
+  our sub a {
+    if (shift) {
+      package bar;
+      is a, 43, 'our sub invisible inside itself';
+      is &a, 43, 'our sub invisible inside itself (called via amper)';
+      is do a(), 43, 'our sub invisible inside itself (called via do)';
+    }
+    42
+  }
+  a(1);
+  sub bar::b { 43 }
+  our sub b;
+  our sub b {
+    if (shift) {
+      package bar;
+      is b, 42, 'our sub visible inside itself after decl';
+      is &b, 42, 'our sub visible inside itself after decl (amper)';
+      is do b(), 42, 'our sub visible inside itself after decl (do)';
+    }
+    42
+  }
+  b(1)
+}
+sub c { 42 }
+sub bar::c { 43 }
+{
+  our sub c;
+  package bar;
+  is c, 42, 'our sub foo; makes lex alias for existing sub';
+  is &c, 42, 'our sub foo; makes lex alias for existing sub (amper)';
+  is do c(), 42, 'our sub foo; makes lex alias for existing sub (do)';
+}
+{
+  our sub d;
+  sub bar::d { 'd43' }
+  package bar;
+  sub d { 'd42' }
+  is eval ::d, 'd42', 'our sub foo; applies to subsequent sub foo {}';
+}
+{
+  our sub e ($);
+  is prototype "::e", '$', 'our sub with proto';
+}
+{
+  our sub if() { 42 }
+  my $x = if if if;
+  is $x, 42, 'lexical subs (even our) override all keywords';
+  package bar;
+  my $y = if if if;
+  is $y, 42, 'our subs from other packages override all keywords';
+}
+
+# -------------------- state -------------------- #
+
+use feature 'state'; # state
+{
+  state sub foo { 44 }
+  isnt \&::foo, \&foo, 'state sub is not stored in the package';
+  is eval foo, 44, 'calling state sub from same package';
+  is eval &foo, 44, 'calling state sub from same package (amper)';
+  is eval do foo(), 44, 'calling state sub from same package (do)';
+  package bar;
+  is eval foo, 44, 'calling state sub from another package';
+  is eval &foo, 44, 'calling state sub from another package (amper)';
+  is eval do foo(), 44, 'calling state sub from another package (do)';
+}
+package bar;
+is foo, 43, 'state sub falling out of scope';
+is &foo, 43, 'state sub falling out of scope (called via amper)';
+is do foo(), 43, 'state sub falling out of scope (called via amper)';
+{
+  sub sa { 43 }
+  state sub sa {
+    if (shift) {
+      is sa, 43, 'state sub invisible inside itself';
+      is &sa, 43, 'state sub invisible inside itself (called via amper)';
+      is do sa(), 43, 'state sub invisible inside itself (called via do)';
+    }
+    44
+  }
+  sa(1);
+  sub sb { 43 }
+  state sub sb;
+  state sub sb {
+    if (shift) {
+      # ‘state sub foo{}’ creates a new pad entry, not reusing the forward
+      #  declaration.  Being invisible inside itself, it sees the stub.
+      eval{sb};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration';
+      eval{&sb};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration (amper)';
+      eval{do sb()};
+      like $@, qr/^Undefined subroutine &sb called at /,
+        'state sub foo {} after forward declaration (do)';
+    }
+    44
+  }
+  sb(1);
+  sub sb2 { 43 }
+  state sub sb2;
+  sub sb2 {
+    if (shift) {
+      package bar;
+      is sb2, 44, 'state sub visible inside itself after decl';
+      is &sb2, 44, 'state sub visible inside itself after decl (amper)';
+      is do sb2(), 44, 'state sub visible inside itself after decl (do)';
+    }
+    44
+  }
+  sb2(1);
+  state sub sb3;
+  {
+    state sub sb3 { # new pad entry
+      # The sub containing this comment is invisible inside itself.
+      # So this one here will assign to the outer pad entry:
+      sub sb3 { 47 }
+    }
+  }
+  is eval{sb3}, 47,
+    'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
+  # Same test again, but inside an anonymous sub
+  sub {
+    state sub sb4;
+    {
+      state sub sb4 {
+        sub sb4 { 47 }
+      }
+    }
+    is sb4, 47,
+      'sub foo{} applying to "state sub foo;" even inside state sub foo{}';
+  }->();
+}
+sub sc { 43 }
+{
+  state sub sc;
+  eval{sc};
+  like $@, qr/^Undefined subroutine &sc called at /,
+     'state sub foo; makes no lex alias for existing sub';
+  eval{&sc};
+  like $@, qr/^Undefined subroutine &sc called at /,
+     'state sub foo; makes no lex alias for existing sub (amper)';
+  eval{do sc()};
+  like $@, qr/^Undefined subroutine &sc called at /,
+     'state sub foo; makes no lex alias for existing sub (do)';
+}
+package main;
+{
+  state sub se ($);
+  is prototype eval{\&se}, '$', 'state sub with proto';
+  is prototype "se", undef, 'prototype "..." ignores state subs';
+}
+{
+  state sub if() { 44 }
+  my $x = if if if;
+  is $x, 44, 'state subs override all keywords';
+  package bar;
+  my $y = if if if;
+  is $y, 44, 'state subs from other packages override all keywords';
+}
+{
+  use warnings; no warnings "experimental::lexical_subs";
+  state $w ;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 87 squidges
+    state sub foo;
+    state sub foo {};
+  ';
+  is $w,
+     '"state" subroutine &foo masks earlier declaration in same scope at '
+   . "squidges line 88.\n",
+     'warning for state sub masking earlier declaration';
+}
+# Since state vars inside anonymous subs are cloned at the same time as the
+# anonymous subs containing them, the same should happen for state subs.
+sub make_closure {
+  my $x = shift;
+  sub {
+    state sub foo { $x }
+    foo
+  }
+}
+$sub1 = make_closure 48;
+$sub2 = make_closure 49;
+is &$sub1, 48, 'state sub in closure (1)';
+is &$sub2, 49, 'state sub in closure (2)';
+# But we need to test that state subs actually do persist from one invoca-
+# tion of a named sub to another (i.e., that they are not my subs).
+{
+  use warnings; no warnings "experimental::lexical_subs";
+  state $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 65 teetet
+    sub foom {
+      my $x = shift;
+      state sub poom { $x }
+      eval{\&poom}
+    }
+  ';
+  is $w, "Variable \"\$x\" will not stay shared at teetet line 67.\n",
+         'state subs get "Variable will not stay shared" messages';
+  my $poom = foom(27);
+  my $poom2 = foom(678);
+  is eval{$poom->()}, eval {$poom2->()},
+    'state subs close over the first outer my var, like pkg subs';
+  my $x = 43;
+  for $x (765) {
+    state sub etetetet { $x }
+    is eval{etetetet}, 43, 'state sub ignores for() localisation';
+  }
+}
+# And we also need to test that multiple state subs can close over each
+# other’s entries in the parent subs pad, and that cv_clone is not con-
+# fused by that.
+sub make_anon_with_state_sub{
+  sub {
+    state sub s1;
+    state sub s2 { \&s1 }
+    sub s1 { \&s2 }
+    if (@_) { return \&s1 }
+    is s1,\&s2, 'state sub in anon closure closing over sibling state sub';
+    is s2,\&s1, 'state sub in anon closure closing over sibling state sub';
+  }
+}
+{
+  my $s = make_anon_with_state_sub;
+  &$s;
+
+  # And make sure the state subs were actually cloned.
+  isnt make_anon_with_state_sub->(0), &$s(0),
+    'state subs in anon subs are cloned';
+  is &$s(0), &$s(0), 'but only when the anon sub is cloned';
+}
+{
+  state sub BEGIN { exit };
+  pass 'state subs are never special blocks';
+  state sub END { shift }
+  is eval{END('jkqeudth')}, jkqeudth,
+    'state sub END {shift} implies @_, not @ARGV';
+}
+{
+  state sub redef {}
+  use warnings; no warnings "experimental::lexical_subs";
+  state $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval "#line 56 pygpyf\nsub redef {}";
+  is $w, "Subroutine redef redefined at pygpyf line 56.\n",
+         "sub redefinition warnings from state subs";
+}
+{
+  state sub p (\@) {
+    is ref $_[0], 'ARRAY', 'state sub with proto';
+  }
+  p(my @a);
+  p my @b;
+  state sub q () { 45 }
+  is q(), 45, 'state constant called with parens';
+}
+{
+  state sub x;
+  eval 'sub x {3}';
+  is x, 3, 'state sub defined inside eval';
+
+  sub r {
+    state sub foo { 3 };
+    if (@_) { # outer call
+      r();
+      is foo(), 42,
+         'state sub run-time redefinition applies to all recursion levels';
+    }
+    else { # inner call
+      eval 'sub foo { 42 }';
+    }
+  }
+  r(1);
+}
+like runperl(
+      switches => [ '-Mfeature=:all' ],
+      prog     => 'state sub a { foo ref } a()',
+      stderr   => 1
+     ),
+     qr/syntax error/,
+    'referencing a state sub after a syntax error does not crash';
+
+# -------------------- my -------------------- #
+
+{
+  my sub foo { 44 }
+  isnt \&::foo, \&foo, 'my sub is not stored in the package';
+  is foo, 44, 'calling my sub from same package';
+  is &foo, 44, 'calling my sub from same package (amper)';
+  is do foo(), 44, 'calling my sub from same package (do)';
+  package bar;
+  is foo, 44, 'calling my sub from another package';
+  is &foo, 44, 'calling my sub from another package (amper)';
+  is do foo(), 44, 'calling my sub from another package (do)';
+}
+package bar;
+is foo, 43, 'my sub falling out of scope';
+is &foo, 43, 'my sub falling out of scope (called via amper)';
+is do foo(), 43, 'my sub falling out of scope (called via amper)';
+{
+  sub ma { 43 }
+  my sub ma {
+    if (shift) {
+      is ma, 43, 'my sub invisible inside itself';
+      is &ma, 43, 'my sub invisible inside itself (called via amper)';
+      is do ma(), 43, 'my sub invisible inside itself (called via do)';
+    }
+    44
+  }
+  ma(1);
+  sub mb { 43 }
+  my sub mb;
+  my sub mb {
+    if (shift) {
+      # ‘my sub foo{}’ creates a new pad entry, not reusing the forward
+      #  declaration.  Being invisible inside itself, it sees the stub.
+      eval{mb};
+      like $@, qr/^Undefined subroutine &mb called at /,
+        'my sub foo {} after forward declaration';
+      eval{&mb};
+      like $@, qr/^Undefined subroutine &mb called at /,
+        'my sub foo {} after forward declaration (amper)';
+      eval{do mb()};
+      like $@, qr/^Undefined subroutine &mb called at /,
+        'my sub foo {} after forward declaration (do)';
+    }
+    44
+  }
+  mb(1);
+  sub mb2 { 43 }
+  my sub sb2;
+  sub mb2 {
+    if (shift) {
+      package bar;
+      is mb2, 44, 'my sub visible inside itself after decl';
+      is &mb2, 44, 'my sub visible inside itself after decl (amper)';
+      is do mb2(), 44, 'my sub visible inside itself after decl (do)';
+    }
+    44
+  }
+  mb2(1);
+  my sub mb3;
+  {
+    my sub mb3 { # new pad entry
+      # The sub containing this comment is invisible inside itself.
+      # So this one here will assign to the outer pad entry:
+      sub mb3 { 47 }
+    }
+  }
+  is eval{mb3}, 47,
+    'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
+  # Same test again, but inside an anonymous sub
+  sub {
+    my sub mb4;
+    {
+      my sub mb4 {
+        sub mb4 { 47 }
+      }
+    }
+    is mb4, 47,
+      'sub foo{} applying to "my sub foo;" even inside my sub foo{}';
+  }->();
+}
+sub mc { 43 }
+{
+  my sub mc;
+  eval{mc};
+  like $@, qr/^Undefined subroutine &mc called at /,
+     'my sub foo; makes no lex alias for existing sub';
+  eval{&mc};
+  like $@, qr/^Undefined subroutine &mc called at /,
+     'my sub foo; makes no lex alias for existing sub (amper)';
+  eval{do mc()};
+  like $@, qr/^Undefined subroutine &mc called at /,
+     'my sub foo; makes no lex alias for existing sub (do)';
+}
+package main;
+{
+  my sub me ($);
+  is prototype eval{\&me}, '$', 'my sub with proto';
+  is prototype "me", undef, 'prototype "..." ignores my subs';
+}
+{
+  my sub if() { 44 }
+  my $x = if if if;
+  is $x, 44, 'my subs override all keywords';
+  package bar;
+  my $y = if if if;
+  is $y, 44, 'my subs from other packages override all keywords';
+}
+{
+  use warnings; no warnings "experimental::lexical_subs";
+  my $w ;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 87 squidges
+    my sub foo;
+    my sub foo {};
+  ';
+  is $w,
+     '"my" subroutine &foo masks earlier declaration in same scope at '
+   . "squidges line 88.\n",
+     'warning for my sub masking earlier declaration';
+}
+# Test that my subs are cloned inside anonymous subs.
+sub mmake_closure {
+  my $x = shift;
+  sub {
+    my sub foo { $x }
+    foo
+  }
+}
+$sub1 = mmake_closure 48;
+$sub2 = mmake_closure 49;
+is &$sub1, 48, 'my sub in closure (1)';
+is &$sub2, 49, 'my sub in closure (2)';
+# Test that they are cloned in named subs.
+{
+  use warnings; no warnings "experimental::lexical_subs";
+  my $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval '#line 65 teetet
+    sub mfoom {
+      my $x = shift;
+      my sub poom { $x }
+      \&poom
+    }
+  ';
+  is $w, undef, 'my subs get no "Variable will not stay shared" messages';
+  my $poom = mfoom(27);
+  my $poom2 = mfoom(678);
+  is $poom->(), 27, 'my subs closing over outer my var (1)';
+  is $poom2->(), 678, 'my subs closing over outer my var (2)';
+  my $x = 43;
+  my sub aoeu;
+  for $x (765) {
+    my sub etetetet { $x }
+    sub aoeu { $x }
+    is etetetet, 765, 'my sub respects for() localisation';
+    is aoeu, 43, 'unless it is declared outside the for loop';
+  }
+}
+# And we also need to test that multiple my subs can close over each
+# other’s entries in the parent subs pad, and that cv_clone is not con-
+# fused by that.
+sub make_anon_with_my_sub{
+  sub {
+    my sub s1;
+    my sub s2 { \&s1 }
+    sub s1 { \&s2 }
+    if (@_) { return eval { \&s1 } }
+    is eval{s1},eval{\&s2}, 'my sub in anon closure closing over sibling my sub';
+    is eval{s2},eval{\&s1}, 'my sub in anon closure closing over sibling my sub';
+  }
+}
+
+# Test my subs inside predeclared my subs
+{
+  my sub s2;
+  sub s2 {
+    my $x = 3;
+    my sub s3 { eval '$x' }
+    s3;
+  }
+  is s2, 3, 'my sub inside predeclared my sub';
+}
+
+{
+  my $s = make_anon_with_my_sub;
+  &$s;
+
+  # And make sure the my subs were actually cloned.
+  isnt make_anon_with_my_sub->(0), &$s(0),
+    'my subs in anon subs are cloned';
+  isnt &$s(0), &$s(0), 'at each invocation of the enclosing sub';
+}
+{
+  my sub BEGIN { exit };
+  pass 'my subs are never special blocks';
+  my sub END { shift }
+  is END('jkqeudth'), jkqeudth,
+    'my sub END {shift} implies @_, not @ARGV';
+}
+{
+  my sub redef {}
+  use warnings; no warnings "experimental::lexical_subs";
+  my $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval "#line 56 pygpyf\nsub redef {}";
+  is $w, "Subroutine redef redefined at pygpyf line 56.\n",
+         "sub redefinition warnings from my subs";
+
+  undef $w;
+  sub {
+    my sub x {};
+    sub { eval "#line 87 khaki\n\\&x" }
+  }->()();
+  is $w, "Subroutine \"&x\" is not available at khaki line 87.\n",
+         "unavailability warning during compilation of eval in closure";
+
+  undef $w;
+  no warnings 'void';
+  eval <<'->()();';
+#line 87 khaki
+    sub {
+      my sub x{}
+      sub not_lexical8 {
+        \&x
+      }
+    }
+->()();
+  is $w, "Subroutine \"&x\" is not available at khaki line 90.\n",
+         "unavailability warning during compilation of named sub in anon";
+
+  undef $w;
+  sub not_lexical9 {
+    my sub x {};
+    format =
+@
+&x
+.
+  }
+  eval { write };
+  my($f,$l) = (__FILE__,__LINE__ - 1);
+  is $w, "Subroutine \"&x\" is not available at $f line $l.\n",
+         'unavailability warning during cloning';
+  $l -= 3;
+  is $@, "Undefined subroutine &x called at $f line $l.\n",
+         'Vivified sub is correctly named';
+}
+sub not_lexical10 {
+  my sub foo;
+  foo();
+  sub not_lexical11 {
+    my sub bar {
+      my $x = 'khaki car keys for the khaki car';
+      not_lexical10();
+      sub foo {
+       is $x, 'khaki car keys for the khaki car',
+       'mysubs in inner clonables use the running clone of their CvOUTSIDE'
+      }
+    }
+    bar()
+  }
+}
+not_lexical11();
+{
+  my sub p (\@) {
+    is ref $_[0], 'ARRAY', 'my sub with proto';
+  }
+  p(my @a);
+  p @a;
+  my sub q () { 46 }
+  is q(), 46, 'my constant called with parens';
+}
+{
+  my sub x;
+  my $count;
+  sub x { x() if $count++ < 10 }
+  x();
+  is $count, 11, 'my recursive subs';
+}
+{
+  my sub x;
+  eval 'sub x {3}';
+  is x, 3, 'my sub defined inside eval';
+}
+
+{
+  state $w;
+  local $SIG{__WARN__} = sub { $w .= shift };
+  eval q{ my sub george () { 2 } };
+  is $w, undef, 'no double free from constant my subs';
+}
+like runperl(
+      switches => [ '-Mfeature=:all' ],
+      prog     => 'my sub a { foo ref } a()',
+      stderr   => 1
+     ),
+     qr/syntax error/,
+    'referencing a my sub after a syntax error does not crash';
+
+# -------------------- Interactions (and misc tests) -------------------- #
+
+is sub {
+    my sub s1;
+    my sub s2 { 3 };
+    sub s1 { state sub foo { \&s2 } foo }
+    s1
+  }->()(), 3, 'state sub inside my sub closing over my sub uncle';
+
+{
+  my sub s2 { 3 };
+  sub not_lexical { state sub foo { \&s2 } foo }
+  is not_lexical->(), 3, 'state subs that reference my sub from outside';
+}
+
+# Test my subs inside predeclared package subs
+# This test also checks that CvOUTSIDE pointers are not mangled when the
+# inner sub’s CvOUTSIDE points to another sub.
+sub not_lexical2;
+sub not_lexical2 {
+  my $x = 23;
+  my sub bar;
+  sub not_lexical3 {
+    not_lexical2();
+    sub bar { $x }
+  };
+  bar
+}
+is not_lexical3, 23, 'my subs inside predeclared package subs';
+
+# Test my subs inside predeclared package sub, where the lexical sub is
+# declared outside the package sub.
+# This checks that CvOUTSIDE pointers are fixed up even when the sub is
+# not declared inside the sub that its CvOUTSIDE points to.
+sub not_lexical5 {
+  my sub foo;
+  sub not_lexical4;
+  sub not_lexical4 {
+    my $x = 234;
+    not_lexical5();
+    sub foo { $x }
+  }
+  foo
+}
+is not_lexical4, 234,
+    'my sub defined in predeclared pkg sub but declared outside';
+
+undef *not_lexical6;
+{
+  my sub foo;
+  sub not_lexical6 { sub foo { } }
+  pass 'no crash when cloning a mysub declared inside an undef pack sub';
+}
+
+undef &not_lexical7;
+eval 'sub not_lexical7 { my @x }';
+{
+  my sub foo;
+  foo();
+  sub not_lexical7 {
+    state $x;
+    sub foo {
+      is ref \$x, 'SCALAR',
+        "redeffing a mysub's outside does not make it use the wrong pad"
+    }
+  }
+}
+
+like runperl(
+      switches => [ '-Mfeature=:all', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
+      prog     => 'my sub foo; sub foo { foo } foo',
+      stderr   => 1
+     ),
+     qr/Deep recursion on subroutine "foo"/,
+    'deep recursion warnings for lexical subs do not crash';
+
+like runperl(
+      switches => [ '-Mfeature=:all', '-Mwarnings=FATAL,all', '-M-warnings=experimental::lexical_subs' ],
+      prog     => 'my sub foo() { 42 } undef &foo',
+      stderr   => 1
+     ),
+     qr/Constant subroutine foo undefined at /,
+    'constant undefinition warnings for lexical subs do not crash';
diff --git a/gnu/usr.bin/perl/t/op/loopctl.t b/gnu/usr.bin/perl/t/op/loopctl.t
index 3a8fc9a9ba7..fcb12378467 100644
--- a/gnu/usr.bin/perl/t/op/loopctl.t
+++ b/gnu/usr.bin/perl/t/op/loopctl.t
@@ -36,7 +36,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 55 );
+plan( tests => 64 );
 
 my $ok;
 
@@ -1006,3 +1006,101 @@ cmp_ok($ok,'==',1,'dynamically scoped');
     }
     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");
+    }
+}
diff --git a/gnu/usr.bin/perl/t/op/lop.t b/gnu/usr.bin/perl/t/op/lop.t
index 2c2d2a65e8d..bc4eb85f7e9 100644
--- a/gnu/usr.bin/perl/t/op/lop.t
+++ b/gnu/usr.bin/perl/t/op/lop.t
@@ -7,11 +7,11 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
+    require './test.pl';
 }
 
-print "1..11\n";
+plan tests => 17;
 
-my $test = 0;
 for my $i (undef, 0 .. 2, "", "0 but true") {
     my $true = 1;
     my $false = 0;
@@ -29,37 +29,30 @@ for my $i (undef, 0 .. 2, "", "0 but true") {
 	    and (($i || !$j) != (!$i && $j))
 	);
     }
-    if (not $true) {
-	print "not ";
-    } elsif ($false) {
-	print "not ";
-    }
-    print "ok ", ++$test, "\n";
+    my $m = ! defined $i ? 'undef'
+       : $i eq ''   ? 'empty string'
+       : $i;
+    ok( $true, "true: $m");
+    ok( ! $false, "false: $m");
 }
 
-# $test == 6
 my $i = 0;
 (($i ||= 1) &&= 3) += 4;
-print "not " unless $i == 7;
-print "ok ", ++$test, "\n";
+is( $i, 7, '||=, &&=');
 
 my ($x, $y) = (1, 8);
 $i = !$x || $y;
-print "not " unless $i == 8;
-print "ok ", ++$test, "\n";
+is( $i, 8, 'negation precedence with ||' );
 
 ++$y;
 $i = !$x || !$x || !$x || $y;
-print "not " unless $i == 9;
-print "ok ", ++$test, "\n";
+is( $i, 9, 'negation precedence with ||, multiple operands' );
 
 $x = 0;
 ++$y;
 $i = !$x && $y;
-print "not " unless $i == 10;
-print "ok ", ++$test, "\n";
+is( $i, 10, 'negation precedence with &&' );
 
 ++$y;
 $i = !$x && !$x && !$x && $y;
-print "not " unless $i == 11;
-print "ok ", ++$test, "\n";
+is( $i, 11, 'negation precedence with &&, multiple operands' );
diff --git a/gnu/usr.bin/perl/t/op/mydef.t b/gnu/usr.bin/perl/t/op/mydef.t
index 335033bfe64..b993f1b607c 100644
--- a/gnu/usr.bin/perl/t/op/mydef.t
+++ b/gnu/usr.bin/perl/t/op/mydef.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use strict;
-no warnings 'misc';
+no warnings 'misc', 'experimental::lexical_topic';
 
 $_ = 'global';
 is($_, 'global', '$_ initial value');
diff --git a/gnu/usr.bin/perl/t/op/negate.t b/gnu/usr.bin/perl/t/op/negate.t
index 8a0ef2b59cc..3b02e35f20a 100755
--- a/gnu/usr.bin/perl/t/op/negate.t
+++ b/gnu/usr.bin/perl/t/op/negate.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 16;
+plan tests => 46;
 
 # Some of these will cause warnings if left on.  Here we're checking the
 # functionality, not the warnings.
@@ -19,7 +19,11 @@ is(-"10", -10, "Negation of a positive string to negative");
 is(-"10.0", -10, "Negation of a positive decimal sting to negative");
 is(-"10foo", -10, "Negation of a numeric-lead string returns negation of numeric");
 is(-"-10", 10, 'Negation of string starting with "-" returns a positive number - integer');
+"-10" =~ /(.*)/;
+is(-$1, 10, 'Negation of magical string starting with "-" - integer');
 is(-"-10.0", 10.0, 'Negation of string starting with "-" returns a positive number - decimal');
+"-10.0" =~ /(.*)/;
+is(-$1, 10.0, 'Negation of magical string starting with "-" - decimal');
 is(-"-10foo", "+10foo", 'Negation of string starting with "-" returns a string starting with "+" - non-numeric');
 is(-"xyz", "-xyz", 'Negation of a negative string adds "-" to the front');
 is(-"-xyz", "+xyz", "Negation of a negative string to positive");
@@ -28,4 +32,80 @@ is(-bareword, "-bareword", "Negation of bareword treated like a string");
 is(- -bareword, "+bareword", "Negation of -bareword returns string +bareword");
 is(-" -10", 10, "Negation of a whitespace-lead numeric string");
 is(-" -10.0", 10, "Negation of a whitespace-lead decimal string");
-is(-" -10foo", 10, "Negation of a whitespace-lead sting starting with a numeric")
+is(-" -10foo", 10,
+    "Negation of a whitespace-lead sting starting with a numeric");
+
+$x = "dogs";
+()=0+$x;
+is -$x, '-dogs', 'cached numeric value does not sabotage string negation';
+
+is(-"97656250000000000", -97656250000000000, '-bigint vs -"bigint"');
+"9765625000000000" =~ /(\d+)/;
+is -$1, -"$1", '-$1 vs -"$1" with big int';
+
+$a = "%apples";
+chop($au = "%apples\x{100}");
+is(-$au, -$a, 'utf8 flag makes no difference for string negation');
+is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)';
+
+sub TIESCALAR { bless[] }
+sub STORE { $_[0][0] = $_[1] }
+sub FETCH { $_[0][0] }
+
+tie $t, "";
+$a = "97656250000000000";
+() = 0+$a;
+$t = $a;
+is -$t, -97656250000000000, 'magic str+int dualvar';
+
+{ # Repeat most of the tests under use integer
+    use integer;
+    is(- 10, -10, "Simple numeric negation to negative");
+    is(- -10, 10, "Simple numeric negation to positive");
+    is(-"10", -10, "Negation of a positive string to negative");
+    is(-"10.0", -10, "Negation of a positive decimal sting to negative");
+    is(-"10foo", -10,
+        "Negation of a numeric-lead string returns negation of numeric");
+    is(-"-10", 10,
+        'Negation of string starting with "-" returns a positive number -'
+       .' integer');
+    "-10" =~ /(.*)/;
+    is(-$1, 10, 'Negation of magical string starting with "-" - integer');
+    is(-"-10.0", 10,
+        'Negation of string starting with "-" returns a positive number - '
+       .'decimal');
+    "-10.0" =~ /(.*)/;
+    is(-$1, 10, 'Negation of magical string starting with "-" - decimal');
+    is(-"-10foo", "+10foo",
+       'Negation of string starting with "-" returns a string starting '
+      .'with "+" - non-numeric');
+    is(-"xyz", "-xyz",
+       'Negation of a negative string adds "-" to the front');
+    is(-"-xyz", "+xyz", "Negation of a negative string to positive");
+    is(-"+xyz", "-xyz", "Negation of a positive string to negative");
+    is(-bareword, "-bareword",
+        "Negation of bareword treated like a string");
+    is(- -bareword, "+bareword",
+        "Negation of -bareword returns string +bareword");
+    is(-" -10", 10, "Negation of a whitespace-lead numeric string");
+    is(-" -10.0", 10, "Negation of a whitespace-lead decimal string");
+    is(-" -10foo", 10,
+        "Negation of a whitespace-lead sting starting with a numeric");
+
+    $x = "dogs";
+    ()=0+$x;
+    is -$x, '-dogs',
+        'cached numeric value does not sabotage string negation';
+
+    $a = "%apples";
+    chop($au = "%apples\x{100}");
+    is(-$au, -$a, 'utf8 flag makes no difference for string negation');
+    is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)';
+}
+
+# [perl #120288] use integer should not stop barewords from being quoted
+{
+    use strict;
+    use integer;
+    is eval "return -a"||$@, "-a", '-bareword under strict+integer';
+}
diff --git a/gnu/usr.bin/perl/t/op/not.t b/gnu/usr.bin/perl/t/op/not.t
index 3d07797daa8..8df5774af46 100755
--- a/gnu/usr.bin/perl/t/op/not.t
+++ b/gnu/usr.bin/perl/t/op/not.t
@@ -6,17 +6,22 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 16;
+plan tests => 19;
 
 # not() tests
-pass() if not();
-is(not(), 1);
-is(not(), not(0));
+pass("logical negation of empty list") if not();
+is(not(), 1, "logical negation of empty list in numeric comparison");
+is(not(), not(0),
+    "logical negation of empty list compared with logical negation of false value");
 
 # test not(..) and !
-is(! 1, not 1);
-is(! 0, not 0);
-is(! (0, 0), not(0, 0));
+note("parens needed around second argument in next two tests\nto preserve list context inside function call");
+is(! 1, (not 1),
+    "high- and low-precedence logical negation of true value");
+is(! 0, (not 0),
+    "high- and low-precedence logical negation of false value");
+is(! (0, 0), not(0, 0),
+    "high- and low-precedence logical negation of lists");
 
 # test the return of !
 {
@@ -24,13 +29,18 @@ is(! (0, 0), not(0, 0));
     my $not1 = ! 1;
 
     no warnings;
-    ok($not1 == undef);
-    ok($not1 == ());
+    ok($not1 == undef,
+        "logical negation (high-precedence) of true value is numerically equal to undefined value");
+    ok($not1 == (),
+        "logical negation (high-precedence) of true value is numerically equal to empty list");
 
     use warnings;
-    ok($not1 eq '');
-    ok($not1 == 0);
-    ok($not0 == 1);
+    ok($not1 eq '',
+        "logical negation (high-precedence) of true value in string context is equal to empty string");
+    ok($not1 == 0,
+        "logical negation (high-precedence) of true value is false in numeric context");
+    ok($not0 == 1,
+        "logical negation (high-precedence) of false value is true in numeric context");
 }
 
 # test the return of not
@@ -39,11 +49,30 @@ is(! (0, 0), not(0, 0));
     my $not1 = not 1;
 
     no warnings;
-    ok($not1 == undef);
-    ok($not1 == ());
+    ok($not1 == undef,
+        "logical negation (low-precedence) of true value is numerically equal to undefined value");
+    ok($not1 == (),
+        "logical negation (low-precedence) of true value is numerically equal to empty list");
 
     use warnings;
-    ok($not1 eq '');
-    ok($not1 == 0);
-    ok($not0 == 1);
+    ok($not1 eq '',
+        "logical negation (low-precedence) of true value in string context is equal to empty string");
+    ok($not1 == 0,
+        "logical negation (low-precedence) of true value is false in numeric context");
+    ok($not0 == 1,
+        "logical negation (low-precedence) of false value is true in numeric context");
+}
+
+# test truth of dualvars
+SKIP:
+{
+    my $got_dualvar;
+    eval 'use Scalar::Util "dualvar"; $got_dualvar++';
+    skip "No Scalar::Util::dualvar", 3 unless $got_dualvar;
+    my $a = Scalar::Util::dualvar(3, "");
+    is not($a), 1, 'not(dualvar) ignores int when string is false';
+    my $b = Scalar::Util::dualvar(3.3,"");
+    is not($b), 1, 'not(dualvar) ignores float when string is false';
+    my $c = Scalar::Util::dualvar(0,"1");
+    is not($c), "", 'not(dualvar) ignores false int when string is true';
 }
diff --git a/gnu/usr.bin/perl/t/op/or.t b/gnu/usr.bin/perl/t/op/or.t
index 1f40d61ed5b..5260780509d 100644
--- a/gnu/usr.bin/perl/t/op/or.t
+++ b/gnu/usr.bin/perl/t/op/or.t
@@ -37,20 +37,20 @@ my $a_num = sprintf "%d", $a;
 
 $c = $a || $b;
 
-is($c, $a_str);
-is($c+0, $a_num);   # force numeric context.
+is($c, $a_str, "comparison of string equality");
+is($c+0, $a_num, "comparison of numeric equality");   # force numeric context.
 
 $a =~ /./g or die "Match failed for some reason"; # Make $a magic
 
 $c = $a || $b;
 
-is($c, $a_str);
-is($c+0, $a_num);   # force numeric context.
+is($c, $a_str, "comparison of string equality");
+is($c+0, $a_num, "comparison of numeric equality");   # force numeric context.
 
 my $val = 3;
 
 $c = $val || $b;
-is($c, 3);
+is($c, 3, "|| short-circuited as expected");
 
 tie $a, 'Countdown', $val;
 
diff --git a/gnu/usr.bin/perl/t/op/overload_integer.t b/gnu/usr.bin/perl/t/op/overload_integer.t
index 073ac2a55c1..2375ab94c4e 100644
--- a/gnu/usr.bin/perl/t/op/overload_integer.t
+++ b/gnu/usr.bin/perl/t/op/overload_integer.t
@@ -1,9 +1,15 @@
 #!./perl
 
+BEGIN {
+    chdir 't' if -d 't';
+    push @INC, '../lib';
+    require './test.pl';
+}
+
 use strict;
 use warnings;
 
-print "1..2\n";
+plan tests => 2;
 
 package Foo;
 
@@ -11,7 +17,7 @@ use overload;
 
 sub import
 {
-    overload::constant 'integer' => sub { return shift; };
+    overload::constant 'integer' => sub { return shift };
 }
 
 package main;
@@ -21,35 +27,9 @@ BEGIN { $INC{'Foo.pm'} = "/lib/Foo.pm" }
 use Foo;
 
 my $result = eval "5+6";
-
 my $error = $@;
+$result //= '';
 
-my $label = "No exception was thrown with an overload::constant 'integer' inside an eval.";
-# TEST
-if ($error eq "")
-{
-    print "ok 1 - $label\n"
-}
-else
-{
-    print "not ok 1 - $label\n";
-    print "# Error is $error\n";
-}
-
-$label = "Correct solution";
-
-if (!defined($result))
-{
-    $result = "";
-}
-# TEST
-if ($result eq 11)
-{
-    print "ok 2 - $label\n";
-}
-else
-{
-    print "not ok 2 - $label\n";
-    print "# Result is $result\n";
-}
+is ($error, '', "No exception was thrown with an overload::constant 'integer' inside an eval.");
+is ($result, 11, "Correct solution");
 
diff --git a/gnu/usr.bin/perl/t/op/override.t b/gnu/usr.bin/perl/t/op/override.t
index b38c3938a18..a3cb14a30fb 100644
--- a/gnu/usr.bin/perl/t/op/override.t
+++ b/gnu/usr.bin/perl/t/op/override.t
@@ -49,7 +49,6 @@ is( $r, "Foo.pm" );
 eval "use Foo::Bar";
 is( $r, join($dirsep, "Foo", "Bar.pm") );
 
-# use VERSION also loads feature.pm.
 {
     my @r;
     local *CORE::GLOBAL::require = sub { push @r, shift; 1; };
@@ -64,6 +63,11 @@ is( $r, join($dirsep, "Foo", "Bar.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' );
diff --git a/gnu/usr.bin/perl/t/op/pos.t b/gnu/usr.bin/perl/t/op/pos.t
index 56a8d28bb06..4c50aa92b67 100644
--- a/gnu/usr.bin/perl/t/op/pos.t
+++ b/gnu/usr.bin/perl/t/op/pos.t
@@ -6,35 +6,35 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 8;
+plan tests => 12;
 
 $x='banana';
 $x=~/.a/g;
-is(pos($x), 2);
+is(pos($x), 2, "matching, pos() leaves off at offset 2");
 
 $x=~/.z/gc;
-is(pos($x), 2);
+is(pos($x), 2, "not matching, pos() remains at offset 2");
 
 sub f { my $p=$_[0]; return $p }
 
 $x=~/.a/g;
-is(f(pos($x)), 4);
+is(f(pos($x)), 4, "matching again, pos() next leaves off at offset 4");
 
 # Is pos() set inside //g? (bug id 19990615.008)
 $x = "test string?"; $x =~ s/\w/pos($x)/eg;
-is($x, "0123 5678910?");
+is($x, "0123 5678910?", "pos() set inside //g");
 
 $x = "123 56"; $x =~ / /g;
-is(pos($x), 4);
+is(pos($x), 4, "matching, pos() leaves off at offset 4");
 { local $x }
-is(pos($x), 4);
+is(pos($x), 4, "value of pos() unaffected by intermediate localization");
 
 # Explicit test that triggers the utf8_mg_len_cache_update() code path in
 # Perl_sv_pos_b2u().
 
 $x = "\x{100}BC";
 $x =~ m/.*/g;
-is(pos $x, 3);
+is(pos $x, 3, "utf8_mg_len_cache_update() test");
 
 
 my $destroyed;
@@ -47,3 +47,19 @@ $destroyed = 0;
     $x = bless({}, 'Class');
 }
 is($destroyed, 1, 'Timely scalar destruction with lvalue pos');
+
+eval 'pos @a = 1';
+like $@, qr/^Can't modify array dereference in match position at /,
+  'pos refuses @arrays';
+eval 'pos %a = 1';
+like $@, qr/^Can't modify hash dereference in match position at /,
+  'pos refuses %hashes';
+eval 'pos *a = 1';
+is eval 'pos *a', 1, 'pos *glob works';
+
+# Test that UTF8-ness of $1 changing does not confuse pos
+"f" =~ /(f)/; "$1";	# first make sure UTF8-ness is off
+"\x{100}a" =~ /(..)/;	# give PL_curpm a UTF8 string; $1 does not know yet
+pos($1) = 2;		# set pos; was ignoring UTF8-ness
+"$1";			# turn on UTF8 flag
+is pos($1), 2, 'pos is not confused about changing UTF8-ness';
diff --git a/gnu/usr.bin/perl/t/op/pow.t b/gnu/usr.bin/perl/t/op/pow.t
index c6a7ad6385b..4cfeed1e631 100644
--- a/gnu/usr.bin/perl/t/op/pow.t
+++ b/gnu/usr.bin/perl/t/op/pow.t
@@ -37,11 +37,11 @@ is(3**1, 3,      "positive ** 1 = self");
 is(3**2, 9,      "positive ** 2 = positive");
 is(3**3, 27,     "(positive int) ** (odd power) is positive");
 
-# And test order of operations while we're at it
-is(-3**0, -1);
-is(-3**1, -3);
-is(-3**2, -9);
-is(-3**3, -27);
+# And test order of operations while we are at it
+is(-3**0, -1,      "positive ** 0, then negated, = -1");
+is(-3**1, -3,      "positive ** 1, then negated, = negative of self");
+is(-3**2, -9,      "positive ** 2, then negated, = negative of square");
+is(-3**3, -27,     "(positive int) ** (odd power), then negated, is negative");
 
 
 # Ought to be 32, 64, 36 or something like that.
diff --git a/gnu/usr.bin/perl/t/op/pwent.t b/gnu/usr.bin/perl/t/op/pwent.t
index 970f4e9c589..7562bc07984 100644
--- a/gnu/usr.bin/perl/t/op/pwent.t
+++ b/gnu/usr.bin/perl/t/op/pwent.t
@@ -96,6 +96,8 @@ if (!defined $where && $Config::Config{useperlio}) {
 	    }
 	}
 	if (@rec) {
+        # see above
+        no warnings 'uninitialized';
 	    push @lines, join (':', @rec) . "\n";
 	}
 	my $data = join '', @lines;
@@ -215,7 +217,7 @@ SKIP: {
 EOEX
     }
 
-    cmp_ok(keys %perfect, '>', 0)
+    cmp_ok(keys %perfect, '>', 0, "pwent test satisfactory")
 	or note("(not necessarily serious: run t/op/pwent.t by itself)");
 }
 
@@ -241,6 +243,7 @@ for (1..$max) {
 }
 endpwent();
 
-is("@pw1", "@pw2");
+is("@pw1", "@pw2",
+    "getpwent() produced identical results in list and scalar contexts");
 
 close(PW);
diff --git a/gnu/usr.bin/perl/t/op/qr.t b/gnu/usr.bin/perl/t/op/qr.t
index 90535d059c2..ac017eb2083 100644
--- a/gnu/usr.bin/perl/t/op/qr.t
+++ b/gnu/usr.bin/perl/t/op/qr.t
@@ -2,9 +2,12 @@
 
 use strict;
 
-require './test.pl';
+BEGIN {
+    chdir 't';
+    require './test.pl';
+}
 
-plan(tests => 18);
+plan(tests => 32);
 
 sub r {
     return qr/Good/;
@@ -56,3 +59,54 @@ $$e = 'Fake!';
 is($$e, 'Fake!');
 object_ok($e, 'Stew');
 like("$e", qr/\Stew=SCALAR\(0x[0-9a-f]+\)\z/);
+
+# [perl #96230] qr// should not have the reuse-last-pattern magic
+"foo" =~ /foo/;
+like "bar",qr//,'[perl #96230] =~ qr// does not reuse last successful pat';
+"foo" =~ /foo/;
+$_ = "bar";
+$_ =~ s/${qr||}/baz/;
+is $_, "bazbar", '[perl #96230] s/$qr// does not reuse last pat';
+
+{
+    my $x = 1.1; $x = ${qr//};
+    pass 'no assertion failure when upgrading NV to regexp';
+}
+
+sub TIESCALAR{bless[]}
+sub STORE { is ref\pop, "REGEXP", "stored regexp" }
+tie my $t, "";
+$t = ${qr||};
+ok tied $t, 'tied var is still tied after regexp assignment';
+
+bless \my $t2;
+$t2 = ${qr||};
+is ref \$t2, 'main', 'regexp assignment is not maledictory';
+
+{
+    my $w;
+    local $SIG{__WARN__}=sub{$w=$_[0]};
+    $_ = 1.1;
+    $_ = ${qr//};
+    is 0+$_, 0, 'double upgraded to regexp';
+    like $w, 'numeric', 'produces non-numeric warning';
+    undef $w;
+    $_ = 1;
+    $_ = ${qr//};
+    is 0+$_, 0, 'int upgraded to regexp';
+    like $w, 'numeric', 'likewise produces non-numeric warning';
+}
+
+sub {
+    $_[0] = ${qr=crumpets=};
+    is ref\$_[0], 'REGEXP', 'PVLVs';
+    # Don’t use like() here, as we would no longer be testing a PVLV.
+    ok " crumpets " =~ $_[0], 'using a regexpvlv as regexp';
+    my $x = $_[0];
+    is ref\$x, 'REGEXP', 'copying a regexpvlv';
+    $_[0] = ${qr//};
+    my $str = "".qr//;
+    $_[0] .= " ";
+    is $_[0], "$str ", 'stringifying regexpvlv in place';
+}
+ ->((\my%hash)->{key});
diff --git a/gnu/usr.bin/perl/t/op/require_errors.t b/gnu/usr.bin/perl/t/op/require_errors.t
index 23df8b1676b..e3239486bec 100644
--- a/gnu/usr.bin/perl/t/op/require_errors.t
+++ b/gnu/usr.bin/perl/t/op/require_errors.t
@@ -3,20 +3,32 @@ use strict;
 use warnings;
 
 BEGIN {
+    chdir 't';
     require './test.pl';
 }
 
-plan(tests => 3);
+plan(tests => 11);
 
 my $nonfile = tempfile();
 
 @INC = qw(Perl Rules);
 
-eval {
-    require $nonfile;
-};
+# The tests for ' ' and '.h' never did fail, but previously the error reporting
+# code would read memory before the start of the SV's buffer
 
-like $@, qr/^Can't locate $nonfile in \@INC \(\@INC contains: @INC\) at/;
+for my $file ($nonfile, ' ') {
+    eval {
+	require $file;
+    };
+
+    like $@, qr/^Can't locate $file in \@INC \(\@INC contains: @INC\) at/,
+	"correct error message for require '$file'";
+}
+
+eval "require $nonfile";
+
+like $@, qr/^Can't locate $nonfile\.pm in \@INC \(you may need to install the $nonfile module\) \(\@INC contains: @INC\) at/,
+    "correct error message for require $nonfile";
 
 eval {
     require "$nonfile.ph";
@@ -24,11 +36,77 @@ eval {
 
 like $@, qr/^Can't locate $nonfile\.ph in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
 
-eval {
-    require "$nonfile.h";
-};
+for my $file ("$nonfile.h", ".h") {
+    eval {
+	require $file
+    };
+
+    like $@, qr/^Can't locate \Q$file\E in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
+	"correct error message for require '$file'";
+}
+
+for my $file ("$nonfile.ph", ".ph") {
+    eval {
+	require $file
+    };
+
+    like $@, qr/^Can't locate \Q$file\E in \@INC \(did you run h2ph\?\) \(\@INC contains: @INC\) at/,
+	"correct error message for require '$file'";
+}
+
+eval 'require <foom>';
+like $@, qr/^<> should be quotes at /, 'require <> error';
+
+my $module   = tempfile();
+my $mod_file = "$module.pm";
+
+open my $module_fh, ">", $mod_file or die $!;
+print { $module_fh } "print 1; 1;\n";
+close $module_fh;
+
+chmod 0333, $mod_file;
+
+SKIP: {
+    skip_if_miniperl("these modules may not be available to miniperl", 2);
+
+    push @INC, '../lib';
+    require Cwd;
+    require File::Spec::Functions;
+    if ($^O eq 'cygwin') {
+        require Win32;
+    }
+
+    # Going to try to switch away from root.  Might not work.
+    # (stolen from t/op/stat.t)
+    my $olduid = $>;
+    eval { $> = 1; };
+    skip "Can't test permissions meaningfully if you're superuser", 2
+        if ($^O eq 'cygwin' ? Win32::IsAdminUser() : $> == 0);
+
+    local @INC = ".";
+    eval "use $module";
+    like $@,
+        qr<^\QCan't locate $mod_file:>,
+        "special error message if the file exists but can't be opened";
+
+    SKIP: {
+        skip "Can't make the path absolute", 1
+            if !defined(Cwd::getcwd());
+
+        my $file = File::Spec::Functions::catfile(Cwd::getcwd(), $mod_file);
+        eval {
+            require($file);
+        };
+        like $@,
+            qr<^\QCan't locate $file:>,
+            "...even if we use a full path";
+    }
+
+    # switch uid back (may not be implemented)
+    eval { $> = $olduid; };
+}
 
-like $@, qr/^Can't locate $nonfile\.h in \@INC \(change \.h to \.ph maybe\?\) \(did you run h2ph\?\) \(\@INC contains: @INC\) at/;
+1 while unlink $mod_file;
 
 # I can't see how to test the EMFILE case
 # I can't see how to test the case of not displaying @INC in the message.
diff --git a/gnu/usr.bin/perl/t/op/reset.t b/gnu/usr.bin/perl/t/op/reset.t
index 3094979a678..291bc393ade 100644
--- a/gnu/usr.bin/perl/t/op/reset.t
+++ b/gnu/usr.bin/perl/t/op/reset.t
@@ -7,8 +7,7 @@ BEGIN {
 }
 use strict;
 
-# Currently only testing the reset of patterns.
-plan tests => 24;
+plan tests => 30;
 
 package aiieee;
 
@@ -62,6 +61,65 @@ CLINK::reset_ZZIP();
 is(CLINK::ZZIP("ZZIP"), 1, "match matches after reset");
 is(CLINK::ZZIP(""), 0, "mismatch doesn't match");
 
+sub match_foo{
+    "foo" =~ m?foo?;
+}
+match_foo();
+reset "";
+ok !match_foo(), 'reset "" leaves patterns alone [perl #97958]';
+
+$scratch::a = "foo";
+$scratch::a2 = "bar";
+$scratch::b   = "baz";
+package scratch { reset "a" }
+is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u'),
+   "u-u-baz",
+   'reset "char"';
+
+$scratch::a = "foo";
+$scratch::a2 = "bar";
+$scratch::b   = "baz";
+$scratch::c    = "sea";
+package scratch { reset "bc" }
+is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u',
+             $scratch::c//'u'),
+   "foo-bar-u-u",
+   'reset "chars"';
+
+$scratch::a = "foo";
+$scratch::a2 = "bar";
+$scratch::b   = "baz";
+$scratch::c    = "sea";
+package scratch { reset "a-b" }
+is join("-", $scratch::a//'u', $scratch::a2//'u', $scratch::b//'u',
+             $scratch::c//'u'),
+   "u-u-u-sea",
+   'reset "range"';
+
+{ no strict; ${"scratch::\0foo"} = "bar" }
+$scratch::a = "foo";
+package scratch { reset "\0a" }
+is join("-", $scratch::a//'u', do { no strict; ${"scratch::\0foo"} }//'u'),
+   "u-u",
+   'reset "\0char"';
+
+# This used to crash under threaded builds, because pmops were remembering
+# their stashes by name, rather than by pointer.
+fresh_perl_is( # it crashes more reliably with a smaller script
+  'package bar;
+   sub foo {
+     m??;
+     BEGIN { *baz:: = *bar::; *bar:: = *foo:: }
+     # The name "bar" no langer refers to the same package
+   }
+   undef &foo; # so freeing the op does not remove it from the stash’s list
+   $_ = "";
+   push @_, ($_) x 10000;  # and its memory is scribbled over
+   reset;  # so reset on the original package tries to reset an invalid op
+   print "ok\n";',
+  "ok\n", {},
+  "no crash if package is effectively renamed before op is freed");
+
 
 undef $/;
 my $prog = <DATA>;
diff --git a/gnu/usr.bin/perl/t/op/reverse.t b/gnu/usr.bin/perl/t/op/reverse.t
index 916724c0df7..0796614ffbf 100644
--- a/gnu/usr.bin/perl/t/op/reverse.t
+++ b/gnu/usr.bin/perl/t/op/reverse.t
@@ -8,46 +8,46 @@ BEGIN {
 
 plan tests => 26;
 
-is(reverse("abc"), "cba");
+is(reverse("abc"), "cba", 'simple reverse');
 
 $_ = "foobar";
-is(reverse(), "raboof");
+is(reverse(), "raboof", 'reverse of the default variable');
 
 {
     my @a = ("foo", "bar");
     my @b = reverse @a;
 
-    is($b[0], $a[1]);
-    is($b[1], $a[0]);
+    is($b[0], $a[1], 'array reversal moved second element to first');
+    is($b[1], $a[0], 'array reversal moved first element to second');
 }
 
 {
     my @a = (1, 2, 3, 4);
     @a = reverse @a;
-    is("@a", "4 3 2 1");
+    is("@a", "4 3 2 1", 'four element array reversed');
 
     delete $a[1];
     @a = reverse @a;
-    ok(!exists $a[2]);
-    is($a[0] . $a[1] . $a[3], '124');
+    ok(!exists $a[2], 'array reversed with deleted second element');
+    is($a[0] . $a[1] . $a[3], '124', 'remaining elements ok after delete and reverse');
 
     @a = (5, 6, 7, 8, 9);
     @a = reverse @a;
-    is("@a", "9 8 7 6 5");
+    is("@a", "9 8 7 6 5", 'five element array reversed');
 
     delete $a[3];
     @a = reverse @a;
-    ok(!exists $a[1]);
-    is($a[0] . $a[2] . $a[3] . $a[4], '5789');
+    ok(!exists $a[1], 'five element array reversed with deleted fourth element');
+    is($a[0] . $a[2] . $a[3] . $a[4], '5789', 'remaining elements ok after delete and reverse');
 
     delete $a[2];
     @a = reverse @a;
-    ok(!exists $a[2] && !exists $a[3]);
-    is($a[0] . $a[1] . $a[4], '985');
+    ok(!exists $a[2] && !exists $a[3], 'test position of two deleted elements after reversal');
+    is($a[0] . $a[1] . $a[4], '985', 'check value of remaining elements');
 
     my @empty;
     @empty = reverse @empty;
-    is("@empty", "");
+    is("@empty", "", 'reversed empty array is still empty');
 }
 
 use Tie::Array;
@@ -57,30 +57,30 @@ use Tie::Array;
 
     @a = (1, 2, 3, 4);
     @a = reverse @a;
-    is("@a", "4 3 2 1");
+    is("@a", "4 3 2 1", 'tie array reversal');
 
     delete $a[1];
     @a = reverse @a;
-    ok(!exists $a[2]);
-    is($a[0] . $a[1] . $a[3], '124');
+    ok(!exists $a[2], 'deleted element position ok after reversal of tie array');
+    is($a[0] . $a[1] . $a[3], '124', 'remaining elements ok after delete and reversal for tie array');
 
     @a = (5, 6, 7, 8, 9);
     @a = reverse @a;
-    is("@a", "9 8 7 6 5");
+    is("@a", "9 8 7 6 5", 'five element tie array reversal');
 
     delete $a[3];
     @a = reverse @a;
-    ok(!exists $a[1]);
-    is($a[0] . $a[2] . $a[3] . $a[4], '5789');
+    ok(!exists $a[1], 'deleted element position ok after tie array reversal');
+    is($a[0] . $a[2] . $a[3] . $a[4], '5789', 'remaining elements ok after tie array delete and reversal');
 
     delete $a[2];
     @a = reverse @a;
-    ok(!exists $a[2] && !exists $a[3]);
-    is($a[0] . $a[1] . $a[4], '985');
+    ok(!exists $a[2] && !exists $a[3], 'two deleted element positions ok after tie array reversal');
+    is($a[0] . $a[1] . $a[4], '985', 'remaining elements ok after two deletes and reversals');
 
     tie my @empty, "Tie::StdArray";
     @empty = reverse @empty;
-    is(scalar(@empty), 0);
+    is(scalar(@empty), 0, 'reversed tie array still empty after reversal');
 }
 
 {
@@ -89,17 +89,18 @@ use Tie::Array;
     my $a = "\x{263A}\x{263A}x\x{263A}y\x{263A}";
     my $b = scalar reverse($a);
     my $c = scalar reverse($b);
-    is($a, $c);
+    is($a, $c, 'Unicode string double reversal matches original');
 }
 
 {
     # Lexical $_.
+    no warnings 'experimental::lexical_topic';
     sub blurp { my $_ = shift; reverse }
 
-    is(blurp("foo"), "oof");
-    is(sub { my $_ = shift; reverse }->("bar"), "rab");
+    is(blurp("foo"), "oof", 'reversal of default variable in function');
+    is(sub { my $_ = shift; reverse }->("bar"), "rab", 'reversal of default variable in anonymous function');
     {
         local $_ = "XXX";
-        is(blurp("paz"), "zap");
+        is(blurp("paz"), "zap", 'reversal of default variable with local value set' );
     }
 }
diff --git a/gnu/usr.bin/perl/t/op/sigdispatch.t b/gnu/usr.bin/perl/t/op/sigdispatch.t
index 8161a7192dc..1ce047d9b45 100644
--- a/gnu/usr.bin/perl/t/op/sigdispatch.t
+++ b/gnu/usr.bin/perl/t/op/sigdispatch.t
@@ -9,7 +9,8 @@ BEGIN {
 use strict;
 use Config;
 
-plan tests => 26;
+plan tests => 29;
+$| = 1;
 
 watchdog(15);
 
@@ -147,3 +148,16 @@ like $@, qr/No such hook: __DIE__\\0whoops at/;
     $SIG{"KILL\0"} = sub { 1 };
     like $w, qr/No such signal: SIGKILL\\0 at/, 'Arbitrary signal lookup through %SIG is clean';
 }
+
+# [perl #45173]
+{
+    my $int_called;
+    local $SIG{INT} = sub { $int_called = 1; };
+    $@ = "died";
+    is($@, "died");
+    kill 'INT', $$;
+    # this is needed to ensure signal delivery on MSWin32
+    sleep(1);
+    is($int_called, 1);
+    is($@, "died");
+}
diff --git a/gnu/usr.bin/perl/t/op/sigsystem.t b/gnu/usr.bin/perl/t/op/sigsystem.t
index 197ecb28732..ddfebf969b2 100644
--- a/gnu/usr.bin/perl/t/op/sigsystem.t
+++ b/gnu/usr.bin/perl/t/op/sigsystem.t
@@ -17,6 +17,13 @@ SKIP: {
     require POSIX;
     require Time::HiRes;
 
+    my @pids;
+    $SIG{CHLD} = sub {
+	while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
+	    note "Reaped: $child";
+	    push @pids, $child;
+	}
+    };
     my $pid = fork // die "Can't fork: $!";
     unless ($pid) {
 	note("Child PID: $$");
@@ -26,14 +33,6 @@ SKIP: {
 
     test_system('without reaper');
 
-    my @pids;
-    $SIG{CHLD} = sub {
-	while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
-	    note "Reaped: $child";
-	    push @pids, $child;
-	}
-    };
-
     test_system('with reaper');
 
     note("Waiting briefly for SIGCHLD...");
diff --git a/gnu/usr.bin/perl/t/op/smartkve.t b/gnu/usr.bin/perl/t/op/smartkve.t
index ad56e6a9c4e..3cd5b492d05 100644
--- a/gnu/usr.bin/perl/t/op/smartkve.t
+++ b/gnu/usr.bin/perl/t/op/smartkve.t
@@ -14,12 +14,31 @@ plan 'no_plan';
 
 sub j { join(":",@_) }
 
+# NOTE
+#
+# Hash insertion is currently unstable, in that
+# %hash= %otherhash will not necessarily result in
+# the same internal ordering of the data in the hash.
+# For instance when keys collide the copy may not
+# match the inserted order. So we declare one hash
+# and then make all our copies from that, which should
+# mean all the copies have the same internal structure.
+#
+# And these days, even if all that weren't true, we now
+# per-hash randomize keys/values. So, we cant expect two
+# hashes with the same internal structure to return the
+# same thing at all. All we *can* expect is that keys()
+# and values() use the same ordering.
+our %base_hash;
+
 BEGIN { # in BEGIN for "use constant ..." later
+  # values match keys here so we can easily check that keys(%hash) == values(%hash)
+  %base_hash= (  pi => 'pi', e => 'e', i => 'i' );
   $array = [ qw(pi e i) ];
-  $values = [ 3.14, 2.72, -1 ];
-  $hash  = { pi => 3.14, e => 2.72, i => -1 } ;
+  $values = [ qw(pi e i) ];
+  $hash  = { %base_hash } ;
   $data = {
-    hash => { %$hash },
+    hash => { %base_hash },
     array => [ @$array ],
   };
 }
@@ -27,7 +46,7 @@ BEGIN { # in BEGIN for "use constant ..." later
 package Foo;
 sub new {
   my $self = {
-    hash => {%{$main::hash} },
+    hash => { %base_hash },
     array => [@{$main::array}]
   };
   bless $self, shift;
@@ -58,10 +77,10 @@ use overload '@{}' => sub { $main::array }, fallback => 1;
 
 package main;
 
-use constant CONST_HASH => { %$hash };
+use constant CONST_HASH => { %base_hash };
 use constant CONST_ARRAY => [ @$array ];
 
-my %a_hash = %$hash;
+my %a_hash = %base_hash;
 my @an_array = @$array;
 sub hash_sub { return \%a_hash; }
 sub array_sub { return \@an_array; }
@@ -106,16 +125,25 @@ is(keys $obj->array     ,3, 'Scalar: keys $obj->array');
 
 # Keys -- list
 
-$h_expect = j(keys %$hash);
+$h_expect = j(sort keys %base_hash);
 $a_expect = j(keys @$array);
 
-is(j(keys $hash)                ,$h_expect, 'List: keys $hash');
-is(j(keys $data->{hash})        ,$h_expect, 'List: keys $data->{hash}');
-is(j(keys CONST_HASH)           ,$h_expect, 'List: keys CONST_HASH');
-is(j(keys CONST_HASH())         ,$h_expect, 'List: keys CONST_HASH()');
-is(j(keys hash_sub)             ,$h_expect, 'List: keys hash_sub');
-is(j(keys hash_sub())           ,$h_expect, 'List: keys hash_sub()');
-is(j(keys $obj->hash)           ,$h_expect, 'List: keys $obj->hash');
+is(j(sort keys $hash)           ,$h_expect, 'List: sort keys $hash');
+is(j(sort keys $data->{hash})   ,$h_expect, 'List: sort keys $data->{hash}');
+is(j(sort keys CONST_HASH)      ,$h_expect, 'List: sort keys CONST_HASH');
+is(j(sort keys CONST_HASH())    ,$h_expect, 'List: sort keys CONST_HASH()');
+is(j(sort keys hash_sub)        ,$h_expect, 'List: sort keys hash_sub');
+is(j(sort keys hash_sub())      ,$h_expect, 'List: sort keys hash_sub()');
+is(j(sort keys $obj->hash)      ,$h_expect, 'List: sort keys $obj->hash');
+
+is(j(keys $hash)                ,j(values $hash),           'List: keys $hash == values $hash');
+is(j(keys $data->{hash})        ,j(values $data->{hash}),   'List: keys $data->{hash} == values $data->{hash}');
+is(j(keys CONST_HASH)           ,j(values CONST_HASH),      'List: keys CONST_HASH == values CONST_HASH');
+is(j(keys CONST_HASH())         ,j(values CONST_HASH()),    'List: keys CONST_HASH() == values CONST_HASH()');
+is(j(keys hash_sub)             ,j(values hash_sub),        'List: keys hash_sub == values hash_sub');
+is(j(keys hash_sub())           ,j(values hash_sub()),      'List: keys hash_sub() == values hash_sub()');
+is(j(keys $obj->hash)           ,j(values $obj->hash),      'List: keys $obj->hash == values obj->hash');
+
 is(j(keys $array)               ,$a_expect, 'List: keys $array');
 is(j(keys $data->{array})       ,$a_expect, 'List: keys $data->{array}');
 is(j(keys CONST_ARRAY)          ,$a_expect, 'List: keys CONST_ARRAY');
@@ -168,7 +196,7 @@ ok($@ =~ $errpat,
   'Errors: keys qr/foo/ throws error'
 );
 
-eval "keys $hash qw/fo bar/";
+eval q"keys $hash qw/fo bar/";
 ok($@ =~ qr/syntax error/,
   'Errors: keys $hash, @stuff throws error'
 ) or print "# Got: $@";
@@ -209,16 +237,25 @@ is(values $obj->array     ,3, 'Scalar: values $obj->array');
 
 # Values -- list
 
-$h_expect = j(values %$hash);
+$h_expect = j(sort values %base_hash);
 $a_expect = j(values @$array);
 
-is(j(values $hash)                ,$h_expect, 'List: values $hash');
-is(j(values $data->{hash})        ,$h_expect, 'List: values $data->{hash}');
-is(j(values CONST_HASH)           ,$h_expect, 'List: values CONST_HASH');
-is(j(values CONST_HASH())         ,$h_expect, 'List: values CONST_HASH()');
-is(j(values hash_sub)             ,$h_expect, 'List: values hash_sub');
-is(j(values hash_sub())           ,$h_expect, 'List: values hash_sub()');
-is(j(values $obj->hash)           ,$h_expect, 'List: values $obj->hash');
+is(j(sort values $hash)                ,$h_expect, 'List: sort values $hash');
+is(j(sort values $data->{hash})        ,$h_expect, 'List: sort values $data->{hash}');
+is(j(sort values CONST_HASH)           ,$h_expect, 'List: sort values CONST_HASH');
+is(j(sort values CONST_HASH())         ,$h_expect, 'List: sort values CONST_HASH()');
+is(j(sort values hash_sub)             ,$h_expect, 'List: sort values hash_sub');
+is(j(sort values hash_sub())           ,$h_expect, 'List: sort values hash_sub()');
+is(j(sort values $obj->hash)           ,$h_expect, 'List: sort values $obj->hash');
+
+is(j(values $hash)                ,j(keys $hash),           'List: values $hash == keys $hash');
+is(j(values $data->{hash})        ,j(keys $data->{hash}),   'List: values $data->{hash} == keys $data->{hash}');
+is(j(values CONST_HASH)           ,j(keys CONST_HASH),      'List: values CONST_HASH == keys CONST_HASH');
+is(j(values CONST_HASH())         ,j(keys CONST_HASH()),    'List: values CONST_HASH() == keys CONST_HASH()');
+is(j(values hash_sub)             ,j(keys hash_sub),        'List: values hash_sub == keys hash_sub');
+is(j(values hash_sub())           ,j(keys hash_sub()),      'List: values hash_sub() == keys hash_sub()');
+is(j(values $obj->hash)           ,j(keys $obj->hash),      'List: values $obj->hash == keys $obj->hash');
+
 is(j(values $array)               ,$a_expect, 'List: values $array');
 is(j(values $data->{array})       ,$a_expect, 'List: values $data->{array}');
 is(j(values CONST_ARRAY)          ,$a_expect, 'List: values CONST_ARRAY');
@@ -263,7 +300,7 @@ ok($@ =~ $errpat,
   'Errors: values qr/foo/ throws error'
 );
 
-eval "values $hash qw/fo bar/";
+eval q"values $hash qw/fo bar/";
 ok($@ =~ qr/syntax error/,
   'Errors: values $hash, @stuff throws error'
 ) or print "# Got: $@";
@@ -372,7 +409,7 @@ ok($@ =~ $errpat,
   'Errors: each qr/foo/ throws error'
 );
 
-eval "each $hash qw/foo bar/";
+eval q"each $hash qw/foo bar/";
 ok($@ =~ qr/syntax error/,
   'Errors: each $hash, @stuff throws error'
 ) or print "# Got: $@";
diff --git a/gnu/usr.bin/perl/t/op/smartmatch.t b/gnu/usr.bin/perl/t/op/smartmatch.t
index 79c9847fbf3..ed4b3ec88dc 100644
--- a/gnu/usr.bin/perl/t/op/smartmatch.t
+++ b/gnu/usr.bin/perl/t/op/smartmatch.t
@@ -8,6 +8,7 @@ BEGIN {
 use strict;
 use warnings;
 no warnings 'uninitialized';
+no warnings 'experimental::smartmatch';
 
 use Tie::Array;
 use Tie::Hash;
diff --git a/gnu/usr.bin/perl/t/op/splice.t b/gnu/usr.bin/perl/t/op/splice.t
index bc6fb402722..d462f0c1671 100644
--- a/gnu/usr.bin/perl/t/op/splice.t
+++ b/gnu/usr.bin/perl/t/op/splice.t
@@ -1,41 +1,47 @@
 #!./perl
 
-print "1..21\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+$|  = 1;
 
 @a = (1..10);
 
 sub j { join(":",@_) }
 
-print "not " unless j(splice(@a,@a,0,11,12)) eq "" && j(@a) eq j(1..12);
-print "ok 1\n";
+is( j(splice(@a,@a,0,11,12)), '', 'return value of splice when nothing is removed, only added');
+is( j(@a), j(1..12), '... added two elements');
 
-print "not " unless j(splice(@a,-1)) eq "12" && j(@a) eq j(1..11);
-print "ok 2\n";
+is( j(splice(@a,-1)), "12", 'remove last element, return value');
+is( j(@a), j(1..11), '... removed last element');
 
-print "not " unless j(splice(@a,0,1)) eq "1" && j(@a) eq j(2..11);
-print "ok 3\n";
+is( j(splice(@a,0,1)), "1", 'remove first element, return value');
+is( j(@a), j(2..11), '... first element removed');
 
-print "not " unless j(splice(@a,0,0,0,1)) eq "" && j(@a) eq j(0..11);
-print "ok 4\n";
+is( j(splice(@a,0,0,0,1)), "", 'emulate shift, return value is empty');
+is( j(@a), j(0..11), '... added two elements to beginning of the list');
 
-print "not " unless j(splice(@a,5,1,5)) eq "5" && j(@a) eq j(0..11);
-print "ok 5\n";
+is( j(splice(@a,5,1,5)), "5", 'remove and replace an element to the end of the list, return value is the element');
+is( j(@a), j(0..11), '... list remains the same');
 
-print "not " unless j(splice(@a, @a, 0, 12, 13)) eq "" && j(@a) eq j(0..13);
-print "ok 6\n";
+is( j(splice(@a, @a, 0, 12, 13)), "", 'push two elements onto the end of the list, return value is empty');
+is( j(@a), j(0..13), '... added two elements to the end of the list');
 
-print "not " unless j(splice(@a, -@a, @a, 1, 2, 3)) eq j(0..13) && j(@a) eq j(1..3);
-print "ok 7\n";
+is( j(splice(@a, -@a, @a, 1, 2, 3)), j(0..13), 'splice the whole list out, add 3 elements, return value is @a');
+is( j(@a), j(1..3), '... array only contains new elements');
 
-print "not " unless j(splice(@a, 1, -1, 7, 7)) eq "2" && j(@a) eq j(1,7,7,3);
-print "ok 8\n";
+is( j(splice(@a, 1, -1, 7, 7)), "2", 'replace middle element with two elements, negative offset, return value is the element' );
+is( j(@a), j(1,7,7,3), '... array 1,7,7,3');
 
-print "not " unless j(splice(@a,-3,-2,2)) eq j(7) && j(@a) eq j(1,2,7,3);
-print "ok 9\n";
+is( j(splice(@a,-3,-2,2)), j(7), 'replace first 7 with a 2, negative offset, negative length, return value is 7');
+is( j(@a), j(1,2,7,3), '... array has 1,2,7,3');
 
 # Bug 20000223.001 - no test for splice(@array).  Destructive test!
-print "not " unless j(splice(@a)) eq j(1,2,7,3) && j(@a) eq '';
-print "ok 10\n";
+is( j(splice(@a)), j(1,2,7,3), 'bare splice empties the array, return value is the array');
+is( j(@a),  '', 'array is empty');
 
 # Tests 11 and 12:
 # [ID 20010711.005] in Tie::Array, SPLICE ignores context, breaking SHIFT
@@ -44,56 +50,46 @@ my $foo;
 
 @a = ('red', 'green', 'blue');
 $foo = splice @a, 1, 2;
-print "not " unless $foo eq 'blue';
-print "ok 11\n";
+is( $foo, 'blue', 'remove a single element in scalar context');
 
 @a = ('red', 'green', 'blue');
 $foo = shift @a;
-print "not " unless $foo eq 'red';
-print "ok 12\n";
+is( $foo, 'red', 'do the same with shift');
 
 # Bug [perl #30568] - insertions of deleted elements
 @a = (1, 2, 3);
 splice( @a, 0, 3, $a[1], $a[0] );
-print "not " unless j(@a) eq j(2,1);
-print "ok 13\n";
+is( j(@a), j(2,1), 'splice and replace with indexes 1, 0');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3 ,$a[0], $a[1] );
-print "not " unless j(@a) eq j(1,2);
-print "ok 14\n";
+is( j(@a), j(1,2), 'splice and replace with indexes 0, 1');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3 ,$a[2], $a[1], $a[0] );
-print "not " unless j(@a) eq j(3,2,1);
-print "ok 15\n";
+is( j(@a), j(3,2,1), 'splice and replace with indexes 2, 1, 0');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3, $a[0], $a[1], $a[2], $a[0], $a[1], $a[2] );
-print "not " unless j(@a) eq j(1,2,3,1,2,3);
-print "ok 16\n";
+is( j(@a), j(1,2,3,1,2,3), 'splice and replace with a whole bunch');
 
 @a = (1, 2, 3);
 splice( @a, 1, 2, $a[2], $a[1] );
-print "not " unless j(@a) eq j(1,3,2);
-print "ok 17\n";
+is( j(@a), j(1,3,2), 'swap last two elements');
 
 @a = (1, 2, 3);
 splice( @a, 1, 2, $a[1], $a[1] );
-print "not " unless j(@a) eq j(1,2,2);
-print "ok 18\n";
+is( j(@a), j(1,2,2), 'duplicate middle element on the end');
 
 # splice should invoke get magic
 
-print "not " if Foo->isa('Bar');
-print "ok 19\n";
+ok( ! Foo->isa('Bar'), 'Foo is not a Bar');
 
 splice @Foo::ISA, 0, 0, 'Bar';
-
-print "not " if !Foo->isa('Bar');
-print "ok 20\n";
+ok( !oo->isa('Bar'), 'splice @ISA and make Foo a Bar');
 
 # Test undef first arg
 eval { splice( $new_arrayref, 0, 0, 1, 2, 3 ) };
-print "not " unless $@ && $@ =~ /Not an ARRAY/;
-print "ok 21\n";
+like($@, qr/Not an ARRAY/, 'undefined first argument to splice');
+
+done_testing;
diff --git a/gnu/usr.bin/perl/t/op/split_unicode.t b/gnu/usr.bin/perl/t/op/split_unicode.t
index 85ba4d3a5d2..887adcc11f7 100644
--- a/gnu/usr.bin/perl/t/op/split_unicode.t
+++ b/gnu/usr.bin/perl/t/op/split_unicode.t
@@ -3,7 +3,7 @@
 BEGIN {
     require './test.pl';
     skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec (used by charnames)");
-    plan(tests => 150);
+    plan(tests => 151);
 }
 
 {
@@ -61,4 +61,18 @@ BEGIN {
         ok(@r3 == 3 && join('-', @r3) eq "-:A:-:B", "$msg - /\\s+/ No.2");
 	is($c3, scalar(@r3), "$msg - /\\s+/ No.2 (count)");
     }
+
+    { # RT #114808
+        warning_is(
+            sub {
+                $p=chr(0x100);
+                for (".","ab\x{101}def") {
+                    @q = split /$p/
+                }
+            },
+            undef,
+            'no warnings when part of split cant match non-utf8'
+        );
+    }
+
 }
diff --git a/gnu/usr.bin/perl/t/op/srand.t b/gnu/usr.bin/perl/t/op/srand.t
index 3d49126268c..5321cde6568 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 => 9);
+plan(tests => 10);
 
 # Generate a load of random numbers.
 # int() avoids possible floating point error.
@@ -79,3 +79,12 @@ cmp_ok( $seed, '==', 0, "numeric 0 return value for srand(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/stash.t b/gnu/usr.bin/perl/t/op/stash.t
index 3c315255c60..fd5450e40bd 100644
--- a/gnu/usr.bin/perl/t/op/stash.t
+++ b/gnu/usr.bin/perl/t/op/stash.t
@@ -7,7 +7,7 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan( tests => 57 );
+plan( tests => 58 );
 
 # Used to segfault (bug #15479)
 fresh_perl_like(
@@ -63,6 +63,13 @@ package main;
 		  '',
 		  '',
 		  );
+    # Variant of the above which creates an object that persists until global
+    # destruction.
+    fresh_perl_is(
+		  'use Exporter; package A; sub a { // }; %::=""',
+		  '',
+		  '',
+		  );
 }
 
 # now tests in eval
@@ -280,11 +287,8 @@ fresh_perl_is(
      'ref() returns the same thing when an object’s stash is moved';
     ::like "$obj", qr "^rile=ARRAY\(0x[\da-f]+\)\z",
      'objects stringify the same way when their stashes are moved';
-    {
-	local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-	::is eval '__PACKAGE__', 'rile',
+    ::is eval '__PACKAGE__', 'rile',
 	 '__PACKAGE__ returns the same when the current stash is moved';
-    }
 
     # Now detach it completely from the symtab, making it effect-
     # ively anonymous
@@ -297,11 +301,8 @@ fresh_perl_is(
      'ref() returns the same thing when an object’s stash is detached';
     ::like "$obj", qr "^rile=ARRAY\(0x[\da-f]+\)\z",
      'objects stringify the same way when their stashes are detached';
-    {
-	local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-	::is eval '__PACKAGE__', 'rile',
+    ::is eval '__PACKAGE__', 'rile',
 	 '__PACKAGE__ returns the same when the current stash is detached';
-    }
 }
 
 # Setting the name during undef %stash:: should have no effect.
diff --git a/gnu/usr.bin/perl/t/op/state.t b/gnu/usr.bin/perl/t/op/state.t
index 65f368b0a15..ad51d8be672 100644
--- a/gnu/usr.bin/perl/t/op/state.t
+++ b/gnu/usr.bin/perl/t/op/state.t
@@ -9,7 +9,7 @@ BEGIN {
 
 use strict;
 
-plan tests => 131;
+plan tests => 132;
 
 # Before loading feature.pm, test it with CORE::
 ok eval 'CORE::state $x = 1;', 'CORE::state outside of feature.pm scope';
@@ -211,6 +211,7 @@ my $first  = $stones [0];
 my $First  = ucfirst $first;
 $_ = "bambam";
 foreach my $flint (@stones) {
+    no warnings 'experimental::lexical_topic';
     state $_ = $flint;
     is $_, $first, 'state $_';
     ok /$first/, '/.../ binds to $_';
@@ -311,6 +312,7 @@ foreach my $x (0 .. 4) {
 #
 my @spam = qw [spam ham bacon beans];
 foreach my $spam (@spam) {
+    no warnings 'experimental::smartmatch';
     given (state $spam = $spam) {
         when ($spam [0]) {ok 1, "given"}
         default          {ok 0, "given"}
@@ -404,6 +406,17 @@ foreach my $forbidden (<DATA>) {
 }
 
 
+# [perl #117095] state var initialisation getting skipped
+# the 'if 0' code below causes a call to op_free at compile-time,
+# which used to inadvertently mark the state var as initialised.
+
+{
+    state $f = 1;
+    foo($f) if 0; # this calls op_free on padmy($f)
+    ok(defined $f, 'state init not skipped');
+}
+
+
 __DATA__
 state ($a) = 1;
 (state $a) = 1;
diff --git a/gnu/usr.bin/perl/t/op/sub.t b/gnu/usr.bin/perl/t/op/sub.t
index b8e514dd88d..c4121dfda14 100644
--- a/gnu/usr.bin/perl/t/op/sub.t
+++ b/gnu/usr.bin/perl/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 14 );
+plan( tests => 16 );
 
 sub empty_sub {}
 
@@ -64,3 +64,24 @@ is(scalar(@test), 0, 'Didnt return anything');
     isnt \sub { ()=\@_; return shift }->($x), \$x,
       'result of shift is copied when explicitly returned';
 }
+
+fresh_perl_is
+  <<'end', "main::foo\n", {}, 'sub redefinition sets CvGV';
+*foo = \&baz;
+*bar = *foo;
+eval 'sub bar { print +(caller 0)[3], "\n" }';
+bar();
+end
+
+fresh_perl_is
+  <<'end', "main::foo\nok\n", {}, 'no double free redefining anon stub';
+my $sub = sub { 4 };
+*foo = $sub;
+*bar = *foo;
+undef &$sub;
+eval 'sub bar { print +(caller 0)[3], "\n" }';
+&$sub;
+undef *foo;
+undef *bar;
+print "ok\n";
+end
diff --git a/gnu/usr.bin/perl/t/op/sub_lval.t b/gnu/usr.bin/perl/t/op/sub_lval.t
index b2f56e3374a..9be3164bcdc 100644
--- a/gnu/usr.bin/perl/t/op/sub_lval.t
+++ b/gnu/usr.bin/perl/t/op/sub_lval.t
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>191;
+plan tests=>192;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -962,3 +962,8 @@ sub ucfr : lvalue {
     }
 }
 ucfr();
+
+# [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';
diff --git a/gnu/usr.bin/perl/t/op/svleak.pl b/gnu/usr.bin/perl/t/op/svleak.pl
new file mode 100644
index 00000000000..9e1352e9266
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/svleak.pl
@@ -0,0 +1 @@
+<<END
diff --git a/gnu/usr.bin/perl/t/op/svleak.t b/gnu/usr.bin/perl/t/op/svleak.t
index df10953b111..71bfbb734e5 100644
--- a/gnu/usr.bin/perl/t/op/svleak.t
+++ b/gnu/usr.bin/perl/t/op/svleak.t
@@ -13,7 +13,9 @@ BEGIN {
 	or skip_all("XS::APItest not available");
 }
 
-plan tests => 21;
+use Config;
+
+plan tests => 124;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -30,6 +32,15 @@ sub leak {
     cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, @rest);
 }
 
+# Like leak, but run a string eval instead.
+# The code is used instead of the test name
+# if the name is absent.
+sub eleak {
+    my ($n,$delta,$code,@rest) = @_;
+    leak $n, $delta, sub { eval $code },
+         @rest ? @rest : $code
+}
+
 # run some expression N times. The expr is concatenated N times and then
 # evaled, ensuring that that there are no scope exits between executions.
 # If the number of SVs at the end of expr N is greater than (N-1)*delta at
@@ -58,6 +69,53 @@ leak(5, 0, sub {},                 "basic check 1 of leak test infrastructure");
 leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test infrastructure");
 leak(5, 1, sub {push @a,1;},       "basic check 3 of leak test infrastructure");
 
+# Fatal warnings
+my $f = "use warnings FATAL =>";
+my $all = "$f 'all';";
+eleak(2, 0, "$f 'deprecated'; qq|\\c\{|", 'qq|\c{| with fatal warnings');
+eleak(2, 0, "$f 'syntax'; qq|\\c`|", 'qq|\c`| with fatal warnings');
+eleak(2, 0, "$all /\$\\ /", '/$\ / with fatal warnings');
+eleak(2, 0, "$all s//\\1/", 's//\1/ with fatal warnings');
+eleak(2, 0, "$all qq|\\i|", 'qq|\i| with fatal warnings');
+eleak(2, 0, "$f 'digit'; qq|\\o{9}|", 'qq|\o{9}| with fatal warnings');
+eleak(2, 0, "$f 'misc'; sub foo{} sub foo:lvalue",
+     'ignored :lvalue with fatal warnings');
+eleak(2, 0, "no warnings; use feature ':all'; $f 'misc';
+             my sub foo{} sub foo:lvalue",
+     'ignored mysub :lvalue with fatal warnings');
+eleak(2, 0, "no warnings; use feature ':all'; $all
+             my sub foo{} sub foo:lvalue{}",
+     'fatal mysub redef warning');
+eleak(2, 0, "$all sub foo{} sub foo{}", 'fatal sub redef warning');
+eleak(2, 0, "$all *x=sub {}",
+     'fatal sub redef warning with sub-to-glob assignment');
+eleak(2, 0, "$all *x=sub() {1}",
+     'fatal const sub redef warning with sub-to-glob assignment');
+eleak(2, 0, "$all XS::APItest::newCONSTSUB(\\%main::=>name=>0=>1)",
+     'newCONSTSUB sub redefinition with fatal warnings');
+eleak(2, 0, "$f 'misc'; my\$a,my\$a", 'double my with fatal warnings');
+eleak(2, 0, "$f 'misc'; our\$a,our\$a", 'double our with fatal warnings');
+eleak(2, 0, "$f 'closure';
+             sub foo { my \$x; format=\n\@\n\$x\n.\n} write; ",
+     'format closing over unavailable var with fatal warnings');
+eleak(2, 0, "$all /(?{})?/ ", '(?{})? with fatal warnings');
+eleak(2, 0, "$all /(?{})+/ ", '(?{})+ with fatal warnings');
+eleak(2, 0, "$all /[\\i]/ ", 'invalid charclass escape with fatal warns');
+eleak(2, 0, "$all /[:foo:]/ ", '/[:foo:]/ with fatal warnings');
+eleak(2, 0, "$all /[a-\\d]/ ", '[a-\d] char class with fatal warnings');
+eleak(2, 0, "$all v111111111111111111111111111111111111111111111111",
+     'vstring num overflow with fatal warnings');
+
+eleak(2, 0, 'sub{<*>}');
+# Use a random number of ops, so that the glob op does not reuse the same
+# address each time, giving us false passes.
+leak(2, 0, sub { eval '$x+'x(1 + rand() * 100) . '<*>'; },
+    'freeing partly iterated glob');
+
+eleak(2, 0, 'goto sub {}', 'goto &sub in eval');
+eleak(2, 0, '() = sort { goto sub {} } 1,2', 'goto &sub in sort');
+eleak(2, 0, '/(?{ goto sub {} })/', 'goto &sub in regexp');
+
 sub TIEARRAY	{ bless [], $_[0] }
 sub FETCH	{ $_[0]->[$_[1]] }
 sub STORE	{ $_[0]->[$_[1]] = $_[2] }
@@ -68,6 +126,19 @@ sub STORE	{ $_[0]->[$_[1]] = $_[2] }
     leak(5, 0, sub {local $a[0]}, "local \$tied[0]");
 }
 
+# Overloading
+require overload;
+eleak(2, 0, "BEGIN{overload::constant integer=>sub{}} 1,1,1,1,1,1,1,1,1,1",
+     '"too many errors" from constant overloading returning undef');
+# getting this one to leak was complicated; we have to unset LOCALIZE_HH:
+eleak(2, 0, 'BEGIN{overload::constant integer=>sub{}; $^H &= ~ 0x00020000}
+             1,1,1,1,1,1,1,1,1,1',
+     '"too many errors" from constant overloading with $^H sabotaged');
+eleak(2, 0, "BEGIN{overload::constant integer=>sub{}; undef %^H}
+             1,1,1,1,1,1,1,1,1,1",
+     '"too many errors" from constant overloading with %^H undefined');
+
+
 # [perl #74484]  repeated tries leaked SVs on the tmps stack
 
 leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak");
@@ -129,6 +200,9 @@ SKIP:
   ok(!$weak, "hash referenced weakened SV released");
 }
 
+# prototype() errors
+leak(2,0, sub { eval { prototype "CORE::fu" } }, 'prototype errors');
+
 # RT #72246: rcatline memory leak on bad $/
 
 leak(2, 0,
@@ -159,4 +233,220 @@ leak(2, 0,
     }, "named regexp captures");
 }
 
+eleak(2,0,'/[:]/');
+eleak(2,0,'/[\xdf]/i');
+eleak(2,0,'s![^/]!!');
+eleak(2,0,'/[pp]/');
+eleak(2,0,'/[[:ascii:]]/');
+eleak(2,0,'/[[.zog.]]/');
+eleak(2,0,'/[.zog.]/');
+eleak(2,0,'no warnings; /(?[])/');
+eleak(2,0,'no warnings; /(?[[a]+[b]])/');
+eleak(2,0,'no warnings; /(?[[a]-[b]])/');
+eleak(2,0,'no warnings; /(?[[a]&[b]])/');
+eleak(2,0,'no warnings; /(?[[a]|[b]])/');
+eleak(2,0,'no warnings; /(?[[a]^[b]])/');
+eleak(2,0,'no warnings; /(?[![a]])/');
+eleak(2,0,'no warnings; /(?[\p{Word}])/');
+eleak(2,0,'no warnings; /(?[[a]+)])/');
+eleak(2,0,'no warnings; /(?[\d\d)])/');
+
+# These can generate one ref count, but just  once.
+eleak(4,1,'chr(0x100) =~ /[[:punct:]]/');
+eleak(4,1,'chr(0x100) =~ /[[:^punct:]]/');
+eleak(4,1,'chr(0x100) =~ /[[:word:]]/');
+eleak(4,1,'chr(0x100) =~ /[[:^word:]]/');
+
+eleak(2,0,'chr(0x100) =~ /\P{Assigned}/');
+leak(2,0,sub { /(??{})/ }, '/(??{})/');
+
 leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
+
+
+# [perl #114356] run-time rexexp with unchanging pattern got
+# inflated refcounts
+eleak(2, 0, q{ my $x = "x"; "abc" =~ /$x/ for 1..5 }, '#114356');
+
+eleak(2, 0, 'sub', '"sub" with nothing following');
+eleak(2, 0, '+sub:a{}', 'anon subs with invalid attributes');
+eleak(2, 0, 'no warnings; sub a{1 1}', 'sub with syntax error');
+eleak(2, 0, 'no warnings; sub {1 1}', 'anon sub with syntax error');
+eleak(2, 0, 'no warnings; use feature ":all"; my sub a{1 1}',
+     'my sub with syntax error');
+
+# Reification (or lack thereof)
+leak(2, 0, sub { sub { local $_[0]; shift }->(1) },
+    'local $_[0] on surreal @_, followed by shift');
+leak(2, 0, sub { sub { local $_[0]; \@_ }->(1) },
+    'local $_[0] on surreal @_, followed by reification');
+
+# Syntax errors
+eleak(2, 0, '"${<<END}"
+                 ', 'unterminated here-doc in quotes in multiline eval');
+eleak(2, 0, '"${<<END
+               }"', 'unterminated here-doc in multiline quotes in eval');
+leak(2, 0, sub { eval { do './op/svleak.pl' } },
+        'unterminated here-doc in file');
+eleak(2, 0, 'tr/9-0//');
+eleak(2, 0, 'tr/a-z-0//');
+eleak(2, 0, 'no warnings; nonexistent_function 33838',
+        'bareword followed by number');
+eleak(2, 0, '//dd;'x20, '"too many errors" when parsing m// flags');
+eleak(2, 0, 's///dd;'x20, '"too many errors" when parsing s/// flags');
+eleak(2, 0, 'no warnings; 2 2;BEGIN{}',
+      'BEGIN block after syntax error');
+{
+    local %INC; # in case Errno is already loaded
+    eleak(2, 0, 'no warnings; 2@!{',
+                'implicit "use Errno" after syntax error');
+}
+eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something');
+eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
+eleak(2, 0, "+ + +;qq|\\N{a}|"x10,'qq"\N{a}" after errors');
+eleak(2, 0, "qq|\\N{%}|",      'qq"\N{%}" (invalid charname)');
+eleak(2, 0, "qq|\\N{au}|;",    'qq"\N{invalid}"');
+eleak(2, 0, "qq|\\c|;"x10,     '"too many errors" from qq"\c"');
+eleak(2, 0, "qq|\\o|;"x10,     '"too many errors" from qq"\o"');
+eleak(2, 0, "qq|\\x{|;"x10,    '"too many errors" from qq"\x{"');
+eleak(2, 0, "qq|\\N|;"x10,     '"too many errors" from qq"\N"');
+eleak(2, 0, "qq|\\N{|;"x10,    '"too many errors" from qq"\N{"');
+eleak(2, 0, "qq|\\N{U+GETG}|;"x10,'"too many errors" from qq"\N{U+JUNK}"');
+
+
+# [perl #114764] Attributes leak scalars
+leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak');
+
+eleak(2, 0, 'ref: 1', 'labels');
+
+# Tied hash iteration was leaking if the hash was freed before itera-
+# tion was over.
+package t {
+    sub TIEHASH { bless [] }
+    sub FIRSTKEY { 0 }
+}
+leak(2, 0, sub {
+    my $h = {};
+    tie %$h, t;
+    each %$h;
+    undef $h;
+}, 'tied hash iteration does not leak');
+
+package explosive_scalar {
+    sub TIESCALAR { my $self = shift; bless [undef, {@_}], $self  }
+    sub FETCH     { die 'FETCH' if $_[0][1]{FETCH}; $_[0][0] }
+    sub STORE     { die 'STORE' if $_[0][1]{STORE}; $_[0][0] = $_[1] }
+}
+tie my $die_on_fetch, 'explosive_scalar', FETCH => 1;
+
+# List assignment was leaking when assigning explosive scalars to
+# aggregates.
+leak(2, 0, sub {
+    eval {%a = ($die_on_fetch, 0)}; # key
+    eval {%a = (0, $die_on_fetch)}; # value
+    eval {%a = ($die_on_fetch, $die_on_fetch)}; # both
+    eval {%a = ($die_on_fetch)}; # key, odd elements
+}, 'hash assignment does not leak');
+leak(2, 0, sub {
+    eval {@a = ($die_on_fetch)};
+    eval {($die_on_fetch, $b) = ($b, $die_on_fetch)};
+    # restore
+    tie $die_on_fetch, 'explosive_scalar', FETCH => 1;
+}, 'array assignment does not leak');
+
+# [perl #107000]
+package hhtie {
+    sub TIEHASH { bless [] }
+    sub STORE    { $_[0][0]{$_[1]} = $_[2] }
+    sub FETCH    { die if $explosive; $_[0][0]{$_[1]} }
+    sub FIRSTKEY { keys %{$_[0][0]}; each %{$_[0][0]} }
+    sub NEXTKEY  { each %{$_[0][0]} }
+}
+leak(2, 0, sub {
+    eval q`
+    	BEGIN {
+	    $hhtie::explosive = 0;
+	    tie %^H, hhtie;
+	    $^H{foo} = bar;
+	    $hhtie::explosive = 1;
+    	}
+	{ 1; }
+    `;
+}, 'hint-hash copying does not leak');
+
+package explosive_array {
+    sub TIEARRAY  { bless [[], {}], $_[0]  }
+    sub FETCH     { die if $_[0]->[1]{FETCH}; $_[0]->[0][$_[1]]  }
+    sub FETCHSIZE { die if $_[0]->[1]{FETCHSIZE}; scalar @{ $_[0]->[0]  }  }
+    sub STORE     { die if $_[0]->[1]{STORE}; $_[0]->[0][$_[1]] = $_[2]  }
+    sub CLEAR     { die if $_[0]->[1]{CLEAR}; @{$_[0]->[0]} = ()  }
+    sub EXTEND    { die if $_[0]->[1]{EXTEND}; return  }
+    sub explode   { my $self = shift; $self->[1] = {@_} }
+}
+
+leak(2, 0, sub {
+    tie my @a, 'explosive_array';
+    tied(@a)->explode( STORE => 1 );
+    my $x = 0;
+    eval { @a = ($x)  };
+}, 'explosive array assignment does not leak');
+
+leak(2, 0, sub {
+    my ($a, $b);
+    eval { warn $die_on_fetch };
+}, 'explosive warn argument');
+
+leak(2, 0, sub {
+    my $foo = sub { return $die_on_fetch };
+    my $res = eval { $foo->() };
+    my @res = eval { $foo->() };
+}, 'function returning explosive does not leak');
+
+leak(2, 0, sub {
+    my $res = eval { {$die_on_fetch, 0} };
+    $res = eval { {0, $die_on_fetch} };
+}, 'building anon hash with explosives does not leak');
+
+leak(2, 0, sub {
+    my $res = eval { [$die_on_fetch] };
+}, 'building anon array with explosives does not leak');
+
+leak(2, 0, sub {
+    my @a;
+    eval { push @a, $die_on_fetch };
+}, 'pushing exploding scalar does not leak');
+
+leak(2, 0, sub {
+    eval { push @-, '' };
+}, 'pushing onto read-only array does not leak');
+
+
+# Run-time regexp code blocks
+{
+    use re 'eval';
+    my @tests = ('[(?{})]','(?{})');
+    for my $t (@tests) {
+	leak(2, 0, sub {
+	    / $t/;
+	}, "/ \$x/ where \$x is $t does not leak");
+	leak(2, 0, sub {
+	    /(?{})$t/;
+	}, "/(?{})\$x/ where \$x is $t does not leak");
+    }
+}
+
+
+{
+    use warnings FATAL => 'all';
+    leak(2, 0, sub {
+	no warnings 'once';
+	eval { printf uNopened 42 };
+    }, 'printfing to bad handle under fatal warnings does not leak');
+    open my $fh, ">", \my $buf;
+    leak(2, 0, sub {
+	eval { printf $fh chr 2455 };
+    }, 'wide fatal warning does not make printf leak');
+    close $fh or die $!;
+}
+
+
+leak(2,0,sub{eval{require untohunothu}}, 'requiring nonexistent module');
diff --git a/gnu/usr.bin/perl/t/op/switch.t b/gnu/usr.bin/perl/t/op/switch.t
index 420c6aecfa6..204a57a999e 100644
--- a/gnu/usr.bin/perl/t/op/switch.t
+++ b/gnu/usr.bin/perl/t/op/switch.t
@@ -8,6 +8,7 @@ BEGIN {
 
 use strict;
 use warnings;
+no warnings 'experimental::smartmatch';
 
 plan tests => 201;
 
@@ -52,9 +53,10 @@ given(my $x = "foo") {
 
 $_ = "outside";
 given("inside") { check_outside1() }
-sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
+sub check_outside1 { is($_, "inside", "\$_ is not lexically scoped") }
 
 {
+    no warnings 'experimental::lexical_topic';
     my $_ = "outside";
     given("inside") { check_outside2() }
     sub check_outside2 {
@@ -397,6 +399,7 @@ sub check_outside1 { is($_, "outside", "\$_ lexically scoped") }
 
 # Make sure it still works with a lexical $_:
 {
+    no warnings 'experimental::lexical_topic';
     my $_;
     my $test = "explicit comparison with lexical \$_";
     my $twenty_five = 25;
@@ -598,7 +601,7 @@ sub notfoo {"bar"}
 
 my $f = tie my $v, "FetchCounter";
 
-{   my $test_name = "Only one FETCH (in given)";
+{   my $test_name = "Multiple FETCHes in given, due to aliasing";
     my $ok;
     given($v = 23) {
     	when(undef) {}
@@ -609,7 +612,7 @@ my $f = tie my $v, "FetchCounter";
 	when(/24/) {$ok = 0}
     }
     is($ok, 1, "precheck: $test_name");
-    is($f->count(), 1, $test_name);
+    is($f->count(), 4, $test_name);
 }
 
 {   my $test_name = "Only one FETCH (numeric when)";
@@ -697,6 +700,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'experimental::lexical_topic';
     my $_;
     for (1, "two") {
 	when ("two") {
@@ -715,6 +719,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'experimental::lexical_topic';
     my $_;
     for $_ (1, "two") {
 	when ("two") {
@@ -733,6 +738,7 @@ my $f = tie my $v, "FetchCounter";
 
 {
     my $first = 1;
+    no warnings 'experimental::lexical_topic';
     for my $_ (1, "two") {
 	when ("two") {
 	    is($first, 0, "Lexical loop: second");
@@ -1366,6 +1372,8 @@ unreified_check(undef,"");
 
 {
     sub f1 {
+	no warnings 'experimental::lexical_topic';
+	my $_;
 	given(3) {
 	    return sub { $_ } # close over lexical $_
 	}
@@ -1378,6 +1386,7 @@ unreified_check(undef,"");
     sub DESTROY { $d++ };
 
     sub f2 {
+	no warnings 'experimental::lexical_topic';
 	my $_ = 5;
 	given(bless [7]) {
 	    ::is($_->[0], 7, "is [7]");
diff --git a/gnu/usr.bin/perl/t/op/tie_fetch_count.t b/gnu/usr.bin/perl/t/op/tie_fetch_count.t
index 8eae578042a..c3ed030cfd7 100644
--- a/gnu/usr.bin/perl/t/op/tie_fetch_count.t
+++ b/gnu/usr.bin/perl/t/op/tie_fetch_count.t
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 299);
+    plan (tests => 312);
 }
 
 use strict;
@@ -151,7 +151,10 @@ $dummy  = -e -e -e $var ; check_count '-e -e';
 $_ = "foo";
 $dummy  =  $var =~ m/ / ; check_count 'm//';
 $dummy  =  $var =~ s/ //; check_count 's///';
-$dummy  =  $var ~~    1 ; check_count '~~';
+{
+    no warnings 'experimental::smartmatch';
+    $dummy  =  $var ~~    1 ; check_count '~~';
+}
 $dummy  =  $var =~ y/ //; check_count 'y///';
            $var = \1;
 $dummy  =  $var =~y/ /-/; check_count '$ref =~ y///';
@@ -172,7 +175,7 @@ $dummy  = %$var3        ; check_count '%{}';
 $dummy  = keys $var3    ; check_count 'keys hashref';
 {
     no strict 'refs';
-    tie my $var4 => 'main', **;
+    tie my $var4 => 'main', *];
     $dummy  = *$var4        ; check_count '*{}';
 }
 
@@ -248,6 +251,35 @@ for ([chdir=>''],[chmod=>'0,'],[chown=>'0,0,'],[utime=>'0,0,'],
                             ; check_count 'select $tied_undef, ...';
 }
 
+chop(my $u = "\xff\x{100}");
+tie $var, "main", $u;
+$dummy  = pack "u", $var; check_count 'pack "u", $utf8';
+
+tie $var, "main", "\x{100}";
+pos$var = 0             ; check_count 'lvalue pos $utf8';
+$dummy=sprintf"%1s",$var; check_count 'sprintf "%1s", $utf8';
+$dummy=sprintf"%.1s",$var; check_count 'sprintf "%.1s", $utf8';
+$dummy  = substr$var,0,1; check_count 'substr $utf8';
+my $l   =\substr$var,0,1;
+$dummy  = $$l           ; check_count 'reading lvalue substr($utf8)';
+$$l     = 0             ; check_count 'setting lvalue substr($utf8)';
+tie $var, "main", "a";
+$$l     = "\x{100}"     ; check_count 'assigning $utf8 to lvalue substr';
+tie $var1, "main", "a";
+substr$var1,0,0,"\x{100}"; check_count '4-arg substr with utf8 replacement';
+
+{
+    local $SIG{__WARN__} = sub {};
+    $dummy  =  warn $var    ; check_count 'warn $tied';
+    tie $@, => 'main', 1;
+    $dummy  =  warn         ; check_count 'warn() with $@ tied (num)';
+    tie $@, => 'main', \1;
+    $dummy  =  warn         ; check_count 'warn() with $@ tied (ref)';
+    tie $@, => 'main', "foo\n";
+    $dummy  =  warn         ; check_count 'warn() with $@ tied (str)';
+    untie $@;
+}
+
 ###############################################
 #        Tests for  $foo binop $foo           #
 ###############################################
diff --git a/gnu/usr.bin/perl/t/op/tr.t b/gnu/usr.bin/perl/t/op/tr.t
index 61f570cab68..53530f2f046 100644
--- a/gnu/usr.bin/perl/t/op/tr.t
+++ b/gnu/usr.bin/perl/t/op/tr.t
@@ -8,7 +8,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 131;
+plan tests => 132;
 
 my $Is_EBCDIC = (ord('i') == 0x89 & ord('J') == 0xd1);
 
@@ -486,11 +486,11 @@ is($s, "AxBC", "utf8, DELETE");
 
 ($s) = keys %{{pie => 3}};
 SKIP: {
-    if (!eval { require B }) { skip "no B", 1 }
-    my $wasro = B::svref_2object(\$s)->FLAGS & &B::SVf_READONLY;
-    $wasro or local $TODO = "didn't have a COW";
+    if (!eval { require XS::APItest }) { skip "no XS::APItest", 2 }
+    my $wasro = XS::APItest::SvIsCOW($s);
+    ok $wasro, "have a COW";
     $s =~ tr/i//;
-    ok( B::svref_2object(\$s)->FLAGS & &B::SVf_READONLY,
+    ok( XS::APItest::SvIsCOW($s),
        "count-only tr doesn't deCOW COWs" );
 }
 
@@ -512,6 +512,7 @@ SKIP: {
 eval q{ $a ~= tr/a/b/; };
 ok 1;
 SKIP: {
+    no warnings "deprecated";
     skip "no encoding", 1 unless eval { require encoding; 1 };
     eval q{ use encoding "utf8"; $a ~= tr/a/b/; };
     ok 1;
diff --git a/gnu/usr.bin/perl/t/op/utf8cache.t b/gnu/usr.bin/perl/t/op/utf8cache.t
index 7ac0011a79c..65254b1b478 100755
--- a/gnu/usr.bin/perl/t/op/utf8cache.t
+++ b/gnu/usr.bin/perl/t/op/utf8cache.t
@@ -5,12 +5,14 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    skip_all_without_dynamic_extension('Devel::Peek');
 }
 
 use strict;
 
-plan(tests => 1);
+plan(tests => 15);
+
+SKIP: {
+skip_without_dynamic_extension("Devel::Peek");
 
 my $pid = open CHILD, '-|';
 die "kablam: $!\n" unless defined $pid;
@@ -35,3 +37,127 @@ my $utf8magic = qr{ ^ \s+ MAGIC \s = .* \n
                       \s+ MG_LEN \s = .* \n }xm;
 
 unlike($_, qr{ $utf8magic $utf8magic }x);
+
+} # SKIP
+
+# With bad caching, this code used to go quadratic and take 10s of minutes.
+# The 'test' in this case is simply that it doesn't hang.
+
+{
+    local ${^UTF8CACHE} = 1; # enable cache, disable debugging
+    my $x = "\x{100}" x 1000000;
+    while ($x =~ /./g) {
+	my $p = pos($x);
+    }
+    pass("quadratic pos");
+}
+
+# Get-magic can reallocate the PV.  Check that the cache is reset in
+# such cases.
+
+# Regexp vars
+"\x{100}" =~ /(.+)/;
+() = substr $1, 0, 1;
+"a\x{100}" =~ /(.+)/;
+is ord substr($1, 1, 1), 0x100, 'get-magic resets utf8cache on match vars';
+
+# Substr lvalues
+my $x = "a\x{100}";
+my $l = \substr $x, 0;
+() = substr $$l, 1, 1;
+substr $x, 0, 1, = "\x{100}";
+is ord substr($$l, 1, 1), 0x100, 'get-magic resets utf8cache on LVALUEs';
+
+# defelem magic
+my %h;
+sub {
+  $_[0] = "a\x{100}";
+  () = ord substr $_[0], 1, 1;
+  $h{k} = "\x{100}"x2;
+  is ord substr($_[0], 1, 1), 0x100,
+    'get-magic resets uf8cache on defelems';
+}->($h{k});
+
+
+# Overloading can also reallocate the PV.
+
+package UTF8Toggle {
+    use overload '""' => 'stringify', fallback => 1;
+
+    sub new {
+	my $class = shift;
+	my $value = shift;
+	my $state = shift||0;
+	return bless [$value, $state], $class;
+    }
+
+    sub stringify {
+	my $self = shift;
+	$self->[1] = ! $self->[1];
+	if ($self->[1]) {
+	    utf8::downgrade($self->[0]);
+	} else {
+	    utf8::upgrade($self->[0]);
+	}
+	$self->[0];
+    }
+}
+my $u = UTF8Toggle->new(" \x{c2}7 ");
+
+pos $u = 2;
+is pos $u, 2, 'pos on overloaded utf8 toggler';
+() = "$u"; # flip flag
+pos $u = 2;
+is pos $u, 2, 'pos on overloaded utf8 toggler (again)';
+
+() = ord ${\substr $u, 1};
+is ord ${\substr($u, 1)}, 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues';
+() = "$u"; # flip flag
+() = ord substr $u, 1;
+is ord substr($u, 1), 0xc2,
+    'utf8 cache + overloading does not confuse substr lvalues (again)';
+
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overloading does not confuse substr lvalue assignment';
+$u = UTF8Toggle->new(" \x{c2}7 ");
+() = "$u"; # flip flag
+() = ord ${\substr $u, 2};
+{ no warnings; ${\substr($u, 2, 1)} = 0; }
+is $u, " \x{c2}0 ",
+    'utf8 cache + overload does not confuse substr lv assignment (again)';
+
+
+# Typeglobs and references should not get a cache
+use utf8;
+
+#substr
+my $globref = \*αabcdefg_::_;
+() = substr($$globref, 2, 3);
+*_abcdefgα:: = \%αabcdefg_::;
+undef %αabcdefg_::;
+{ no strict; () = *{"_abcdefgα::_"} }
+is substr($$globref, 2, 3), "abc", 'no utf8 pos cache on globs';
+
+my $ref = bless [], "αabcd_";
+() = substr($ref, 1, 3);
+bless $ref, "_abcdα";
+is substr($ref, 1, 3), "abc", 'no utf8 pos cache on references';
+
+#length
+$globref = \*αabcdefg_::_;
+() = "$$globref";  # turn utf8 flag on
+() = length($$globref);
+*_abcdefgα:: = \%αabcdefg_::;
+undef %αabcdefg_::;
+{ no strict; () = *{"_abcdefgα::_"} }
+is length($$globref), length("$$globref"), 'no utf8 length cache on globs';
+
+$ref = bless [], "αabcd_";
+() = "$ref"; # turn utf8 flag on
+() = length $ref;
+bless $ref, "α";
+is length $ref, length "$ref", 'no utf8 length cache on references';
diff --git a/gnu/usr.bin/perl/t/op/utf8magic.t b/gnu/usr.bin/perl/t/op/utf8magic.t
index 3d942c0cea4..55e921d6ac8 100755
--- a/gnu/usr.bin/perl/t/op/utf8magic.t
+++ b/gnu/usr.bin/perl/t/op/utf8magic.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 4;
+plan tests => 6;
 
 use strict;
 
@@ -23,3 +23,16 @@ $str =~ /(.)/;
 ok !utf8::is_utf8($1), "is_utf8(bytes)";
 scalar "$1"; # invoke SvGETMAGIC
 ok !utf8::is_utf8($1), "is_utf8(bytes)";
+
+sub TIESCALAR { bless [pop] }
+sub FETCH     { $_[0][0] }
+sub STORE     { $::stored = pop }
+
+tie my $str2, "", "a";
+$str2 = "b";
+utf8::encode $str2;
+is $::stored, "a", 'utf8::encode respects get-magic on POK scalars';
+
+tie $str2, "", "\xc4\x80";
+utf8::decode $str2;
+is $::stored, "\x{100}", 'utf8::decode respects set-magic';
diff --git a/gnu/usr.bin/perl/t/op/ver.t b/gnu/usr.bin/perl/t/op/ver.t
index fa94d5ed783..5fca6267a58 100644
--- a/gnu/usr.bin/perl/t/op/ver.t
+++ b/gnu/usr.bin/perl/t/op/ver.t
@@ -11,7 +11,7 @@ $DOWARN = 1; # enable run-time warnings now
 
 use Config;
 
-plan( tests => 55 );
+plan( tests => 57 );
 
 eval 'use v5.5.640';
 is( $@, '', "use v5.5.640; $@");
@@ -270,6 +270,11 @@ ok( exists $h{chr(65).chr(66).chr(67)}, "v-stringness is engaged for X.Y.Z" );
     is $|, 1, 'clobbering vstrings does not clobber all magic';
 }
 
+$a = v102; $a =~ s/f/f/;
+is ref \$a, 'SCALAR',
+  's/// flattens vstrings even when the subst results in the same value';
+$a = v102; $a =~ y/f/g/;
+is ref \$a, 'SCALAR', 'y/// flattens vstrings';
 
 # The following tests whether v-strings are correctly
 # interpreted by the tokeniser when it's in a XTERMORDORDOR
diff --git a/gnu/usr.bin/perl/t/op/warn.t b/gnu/usr.bin/perl/t/op/warn.t
index 4a927e2311b..71de5e2cca0 100644
--- a/gnu/usr.bin/perl/t/op/warn.t
+++ b/gnu/usr.bin/perl/t/op/warn.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan 22;
+plan 30;
 
 my @warnings;
 my $wa = []; my $ea = [];
@@ -148,4 +148,48 @@ fresh_perl_like(
  'warn stringifies in the absence of $SIG{__WARN__}'
 );
 
+use Tie::Scalar;
+tie $@, "Tie::StdScalar";
+
+$@ = "foo\n";
+@warnings = ();
+warn;
+is @warnings, 1;
+like $warnings[0], qr/^foo\n\t\.\.\.caught at warn\.t /,
+    '...caught is appended to tied $@';
+
+$@ = \$_;
+@warnings = ();
+{
+  local *{ref(tied $@) . "::STORE"} = sub {};
+  undef $@;
+}
+warn;
+is @warnings, 1;
+is $warnings[0], \$_, '!SvOK tied $@ that returns ref is used';
+
+untie $@;
+
+@warnings = ();
+{
+  package o;
+  use overload '""' => sub { "" };
+}
+tie $t, Tie::StdScalar;
+$t = bless [], o;
+{
+  local *{ref(tied $t) . "::STORE"} = sub {};
+  undef $t;
+}
+warn $t;
+is @warnings, 1;
+object_ok $warnings[0], 'o',
+  'warn $tie_returning_object_that_stringifes_emptily';
+
+@warnings = ();
+eval "#line 42 Cholmondeley\n \$\@ = '3'; warn";
+eval "#line 42 Cholmondeley\n \$\@ = 3; warn";
+is @warnings, 2;
+is $warnings[1], $warnings[0], 'warn treats $@=3 and $@="3" the same way';
+
 1;
diff --git a/gnu/usr.bin/perl/t/op/while.t b/gnu/usr.bin/perl/t/op/while.t
new file mode 100644
index 00000000000..5d2af711a5d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/op/while.t
@@ -0,0 +1,215 @@
+#!./perl
+
+BEGIN {
+    chdir 't';
+    require "test.pl";
+}
+
+plan(25);
+
+my $tmpfile = tempfile();
+open (tmp,'>', $tmpfile) || die "Can't create Cmd_while.tmp.";
+print tmp "tvi925\n";
+print tmp "tvi920\n";
+print tmp "vt100\n";
+print tmp "Amiga\n";
+print tmp "paper\n";
+close tmp or die "Could not close: $!";
+
+# test "last" command
+
+open(fh, $tmpfile) || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    last if /vt100/;
+}
+ok(!eof && /vt100/);
+
+# test "next" command
+
+$bad = '';
+open(fh, $tmpfile) || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    next if /vt100/;
+    $bad = 1 if /vt100/;
+}
+ok(eof && !/vt100/ && !$bad);
+
+# test "redo" command
+
+$bad = '';
+open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
+while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+}
+ok(eof && !$bad);
+
+# now do the same with a label and a continue block
+
+# test "last" command
+
+$badcont = '';
+open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
+line: while (<fh>) {
+    if (/vt100/) {last line;}
+} continue {
+    $badcont = 1 if /vt100/;
+}
+ok(!eof && /vt100/);
+ok(!$badcont);
+
+# test "next" command
+
+$bad = '';
+$badcont = 1;
+open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
+entry: while (<fh>) {
+    next entry if /vt100/;
+    $bad = 1 if /vt100/;
+} continue {
+    $badcont = '' if /vt100/;
+}
+ok(eof && !/vt100/ && !$bad);
+ok(!$badcont);
+
+# test "redo" command
+
+$bad = '';
+$badcont = '';
+open(fh,$tmpfile) || die "Can't open Cmd_while.tmp.";
+loop: while (<fh>) {
+    if (s/vt100/VT100/g) {
+	s/VT100/Vt100/g;
+	redo loop;
+    }
+    $bad = 1 if /vt100/;
+    $bad = 1 if /VT100/;
+} continue {
+    $badcont = 1 if /vt100/;
+}
+ok(eof && !$bad);
+ok(!$badcont);
+
+close(fh) || die "Can't close Cmd_while.tmp.";
+
+$i = 9;
+{
+    $i++;
+}
+is($i, 10);
+
+# Check curpm is reset when jumping out of a scope
+$i = 0;
+'abc' =~ /b/;
+WHILE:
+while (1) {
+  $i++;
+  is($` . $& . $', "abc");
+  {                             # Localize changes to $` and friends
+    'end' =~ /end/;
+    redo WHILE if $i == 1;
+    next WHILE if $i == 2;
+    # 3 do a normal loop
+    last WHILE if $i == 4;
+  }
+}
+is($` . $& . $', "abc");
+
+# check that scope cleanup happens right when there's a continue block
+{
+    my $var = 16;
+    my (@got_var, @got_i);
+    while (my $i = ++$var) {
+	next if $i == 17;
+	last if $i > 17;
+	my $i = 0;
+    }
+    continue {
+        ($got_var, $got_i) = ($var, $i);
+    }
+    is($got_var, 17);
+    is($got_i, 17);
+}
+
+{
+    my $got_l;
+    local $l = 18;
+    {
+        local $l = 0
+    }
+    continue {
+        $got_l = $l;
+    }
+    is($got_l, 18);
+}
+
+{
+    my $got_l;
+    local $l = 19;
+    my $x = 0;
+    while (!$x++) {
+        local $l = 0
+    }
+    continue {
+        $got_l = $l;
+    }
+    is($got_l, $l);
+}
+
+{
+    my $ok = 1;
+    $i = 20;
+    while (1) {
+	my $x;
+	$ok = 0 if defined $x;
+	if ($i == 21) {
+	    next;
+	}
+	last;
+    }
+    continue {
+        ++$i;
+    }
+    ok($ok);
+}
+
+sub save_context { $_[0] = wantarray; $_[1] }
+
+{
+    my $context = -1;
+    my $p = sub {
+        my $x = 1;
+        while ($x--) {
+            save_context($context, "foo");
+        }
+    };
+    is(scalar($p->()), 0);
+    is($context, undef, "last statement in while block has 'void' context");
+}
+
+{
+    my $context = -1;
+    my $p = sub {
+        my $x = 1;
+        {
+            save_context($context, "foo");
+        }
+    };
+    is(scalar($p->()), "foo");
+    is($context, "", "last statement in block has 'scalar' context");
+}
+
+{
+    # test scope is cleaned
+    my $i = 0;
+    my @a;
+    while ($i++ < 2) {
+        my $x;
+        push @a, \$x;
+    }
+    ok($a[0] ne $a[1]);
+}
diff --git a/gnu/usr.bin/perl/t/opbasic/arith.t b/gnu/usr.bin/perl/t/opbasic/arith.t
new file mode 100644
index 00000000000..d85a9ba2142
--- /dev/null
+++ b/gnu/usr.bin/perl/t/opbasic/arith.t
@@ -0,0 +1,458 @@
+#!./perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# This file has been placed in t/opbasic to indicate that it should not use
+# functions imported from t/test.pl or Test::More, as those programs/libraries
+# use operators which are what is being tested in this file.
+
+print "1..167\n";
+
+sub try ($$$) {
+   print +($_[1] ? "ok" : "not ok"), " $_[0] - $_[2]\n";
+}
+sub tryeq ($$$$) {
+  if ($_[1] == $_[2]) {
+    print "ok $_[0]";
+  } else {
+    print "not ok $_[0] # $_[1] != $_[2]";
+  }
+  print " - $_[3]\n";
+}
+sub tryeq_sloppy ($$$$) {
+  if ($_[1] == $_[2]) {
+    print "ok $_[0]";
+  } else {
+    my $error = abs (($_[1] - $_[2]) / $_[1]);
+    if ($error < 1e-9) {
+      print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O";
+    } else {
+      print "not ok $_[0] # $_[1] != $_[2]";
+    }
+  }
+  print " - $_[3]\n";
+}
+
+my $T = 1;
+tryeq $T++,  13 %  4, 1, 'modulo: positive positive';
+tryeq $T++, -13 %  4, 3, 'modulo: negative positive';
+tryeq $T++,  13 % -4, -3, 'modulo: positive negative';
+tryeq $T++, -13 % -4, -1, 'modulo: negative negative';
+
+# Give abs() a good work-out before using it in anger
+tryeq $T++, abs(0), 0, 'abs(): 0 0';
+tryeq $T++, abs(1), 1, 'abs(): 1 1';
+tryeq $T++, abs(-1), 1, 'abs(): -1 1';
+tryeq $T++, abs(2147483647), 2147483647, 'abs(): 2**31-1: pos pos';
+tryeq $T++, abs(-2147483647), 2147483647, 'abs(): 2**31-1: neg pos';
+tryeq $T++, abs(4294967295), 4294967295, 'abs(): 2**32-1: pos pos';
+tryeq $T++, abs(-4294967295), 4294967295, 'abs(): 2**32-1: neg pos';
+tryeq $T++, abs(9223372036854775807), 9223372036854775807,
+    'abs(): 2**63-1: pos pos';
+tryeq $T++, abs(-9223372036854775807), 9223372036854775807,
+    'abs(): 2**63-1: neg pos';
+# Assume no change whatever; no slop needed
+tryeq $T++, abs(1e50), 1e50, 'abs(): 1e50: pos pos';
+# Assume only sign bit flipped
+tryeq $T++, abs(-1e50), 1e50, 'abs(): 1e50: neg pos';
+
+my $limit = 1e6;
+
+# Division (and modulo) of floating point numbers
+# seem to be rather sloppy in Cray.
+$limit = 1e8 if $^O eq 'unicos';
+
+try $T++, abs( 13e21 %  4e21 -  1e21) < $limit, 'abs() for floating point';
+try $T++, abs(-13e21 %  4e21 -  3e21) < $limit, 'abs() for floating point';
+try $T++, abs( 13e21 % -4e21 - -3e21) < $limit, 'abs() for floating point';
+try $T++, abs(-13e21 % -4e21 - -1e21) < $limit, 'abs() for floating point';
+
+tryeq $T++, 4063328477 % 65535, 27407, 'UV behaves properly: modulo';
+tryeq $T++, 4063328477 % 4063328476, 1, 'UV behaves properly: modulo';
+tryeq $T++, 4063328477 % 2031664238, 1, 'UV behaves properly: modulo';
+tryeq $T++, 2031664238 % 4063328477, 2031664238,
+    'UV behaves properly: modulo';
+
+tryeq $T++, 2147483647 + 0, 2147483647,
+    'trigger wrapping on 32 bit IVs and UVs';
+
+tryeq $T++, 2147483647 + 1, 2147483648, 'IV + IV promotes to UV';
+tryeq $T++, 2147483640 + 10, 2147483650, 'IV + IV promotes to UV';
+tryeq $T++, 2147483647 + 2147483647, 4294967294, 'IV + IV promotes to UV';
+tryeq $T++, 2147483647 + 2147483649, 4294967296, 'IV + UV promotes to NV';
+tryeq $T++, 4294967294 + 2, 4294967296, 'UV + IV promotes to NV';
+tryeq $T++, 4294967295 + 4294967295, 8589934590, 'UV + UV promotes to NV';
+
+tryeq $T++, 2147483648 + -1, 2147483647, 'UV + IV promotes to IV';
+tryeq $T++, 2147483650 + -10, 2147483640, 'UV + IV promotes to IV';
+tryeq $T++, -1 + 2147483648, 2147483647, 'IV + UV promotes to IV';
+tryeq $T++, -10 + 4294967294, 4294967284, 'IV + UV promotes to IV';
+tryeq $T++, -2147483648 + -2147483648, -4294967296, 'IV + IV promotes to NV';
+tryeq $T++, -2147483640 + -10, -2147483650, 'IV + IV promotes to NV';
+
+# Hmm. Do not forget the simple stuff
+# addition
+tryeq $T++, 1 + 1, 2, 'addition of 2 positive integers';
+tryeq $T++, 4 + -2, 2, 'addition of positive and negative integer';
+tryeq $T++, -10 + 100, 90, 'addition of negative and positive integer';
+tryeq $T++, -7 + -9, -16, 'addition of 2 negative integers';
+tryeq $T++, -63 + +2, -61, 'addition of signed negative and positive integers';
+tryeq $T++, 4 + -1, 3, 'addition of positive and negative integer';
+tryeq $T++, -1 + 1, 0, 'addition which sums to 0';
+tryeq $T++, +29 + -29, 0, 'addition which sums to 0';
+tryeq $T++, -1 + 4, 3, 'addition of signed negative and positive integers';
+tryeq $T++, +4 + -17, -13, 'addition of signed positive and negative integers';
+
+# subtraction
+tryeq $T++, 3 - 1, 2, 'subtraction of two positive integers';
+tryeq $T++, 3 - 15, -12,
+    'subtraction of two positive integers: minuend smaller';
+tryeq $T++, 3 - -7, 10, 'subtraction of positive and negative integer';
+tryeq $T++, -156 - 5, -161, 'subtraction of negative and positive integer';
+tryeq $T++, -156 - -5, -151, 'subtraction of two negative integers';
+tryeq $T++, -5 - -12, 7,
+    'subtraction of two negative integers: minuend smaller';
+tryeq $T++, -3 - -3, 0, 'subtraction of two negative integers with result of 0';
+tryeq $T++, 15 - 15, 0, 'subtraction of two positive integers with result of 0';
+tryeq $T++, 2147483647 - 0, 2147483647, 'subtraction from large integer';
+tryeq $T++, 2147483648 - 0, 2147483648, 'subtraction from large integer';
+tryeq $T++, -2147483648 - 0, -2147483648,
+    'subtraction from large negative integer';
+tryeq $T++, 0 - -2147483647, 2147483647,
+    'subtraction of large negative integer from 0';
+tryeq $T++, -1 - -2147483648, 2147483647,
+    'subtraction of large negative integer from negative integer';
+tryeq $T++, 2 - -2147483648, 2147483650,
+    'subtraction of large negative integer from positive integer';
+tryeq $T++, 4294967294 - 3, 4294967291, 'subtraction from large integer';
+tryeq $T++, -2147483648 - -1, -2147483647,
+    'subtraction from large negative integer';
+tryeq $T++, 2147483647 - -1, 2147483648, 'IV - IV promote to UV';
+tryeq $T++, 2147483647 - -2147483648, 4294967295, 'IV - IV promote to UV';
+tryeq $T++, 4294967294 - -3, 4294967297, 'UV - IV promote to NV';
+tryeq $T++, -2147483648 - +1, -2147483649, 'IV - IV promote to NV';
+tryeq $T++, 2147483648 - 2147483650, -2, 'UV - UV promote to IV';
+tryeq $T++, 2000000000 - 4000000000, -2000000000, 'IV - UV promote to IV';
+
+# No warnings should appear;
+my $a;
+$a += 1;
+tryeq $T++, $a, 1, '+= with positive';
+undef $a;
+$a += -1;
+tryeq $T++, $a, -1, '+= with negative';
+undef $a;
+$a += 4294967290;
+tryeq $T++, $a, 4294967290, '+= with positive';
+undef $a;
+$a += -4294967290;
+tryeq $T++, $a, -4294967290, '+= with negative';
+undef $a;
+$a += 4294967297;
+tryeq $T++, $a, 4294967297, '+= with positive';
+undef $a;
+$a += -4294967297;
+tryeq $T++, $a, -4294967297, '+= with negative';
+
+my $s;
+$s -= 1;
+tryeq $T++, $s, -1, '-= with positive';
+undef $s;
+$s -= -1;
+tryeq $T++, $s, +1, '-= with negative';
+undef $s;
+$s -= -4294967290;
+tryeq $T++, $s, +4294967290, '-= with negative';
+undef $s;
+$s -= 4294967290;
+tryeq $T++, $s, -4294967290, '-= with negative';
+undef $s;
+$s -= 4294967297;
+tryeq $T++, $s, -4294967297, '-= with positive';
+undef $s;
+$s -= -4294967297;
+tryeq $T++, $s, +4294967297, '-= with positive';
+
+# multiplication
+tryeq $T++, 1 * 3, 3, 'multiplication of two positive integers';
+tryeq $T++, -2 * 3, -6, 'multiplication of negative and positive integer';
+tryeq $T++, 3 * -3, -9, 'multiplication of positive and negative integer';
+tryeq $T++, -4 * -3, 12, 'multiplication of two negative integers';
+
+# check with 0xFFFF and 0xFFFF
+tryeq $T++, 65535 * 65535, 4294836225,
+    'multiplication: 0xFFFF and 0xFFFF: pos pos';
+tryeq $T++, 65535 * -65535, -4294836225,
+    'multiplication: 0xFFFF and 0xFFFF: pos neg';
+tryeq $T++, -65535 * 65535, -4294836225,
+    'multiplication: 0xFFFF and 0xFFFF: pos neg';
+tryeq $T++, -65535 * -65535, 4294836225,
+    'multiplication: 0xFFFF and 0xFFFF: neg neg';
+
+# check with 0xFFFF and 0x10001
+tryeq $T++, 65535 * 65537, 4294967295,
+    'multiplication: 0xFFFF and 0x10001: pos pos';
+tryeq $T++, 65535 * -65537, -4294967295,
+    'multiplication: 0xFFFF and 0x10001: pos neg';
+tryeq $T++, -65535 * 65537, -4294967295,
+    'multiplication: 0xFFFF and 0x10001: neg pos';
+tryeq $T++, -65535 * -65537, 4294967295,
+    'multiplication: 0xFFFF and 0x10001: neg neg';
+
+# check with 0x10001 and 0xFFFF
+tryeq $T++, 65537 * 65535, 4294967295,
+    'multiplication: 0x10001 and 0xFFFF: pos pos';
+tryeq $T++, 65537 * -65535, -4294967295,
+    'multiplication: 0x10001 and 0xFFFF: pos neg';
+tryeq $T++, -65537 * 65535, -4294967295,
+    'multiplication: 0x10001 and 0xFFFF: neg pos';
+tryeq $T++, -65537 * -65535, 4294967295,
+    'multiplication: 0x10001 and 0xFFFF: neg neg';
+
+# These should all be dones as NVs
+tryeq $T++, 65537 * 65537, 4295098369, 'multiplication: NV: pos pos';
+tryeq $T++, 65537 * -65537, -4295098369, 'multiplication: NV: pos neg';
+tryeq $T++, -65537 * 65537, -4295098369, 'multiplication: NV: neg pos';
+tryeq $T++, -65537 * -65537, 4295098369, 'multiplication: NV: neg neg';
+
+# will overflow an IV (in 32-bit)
+tryeq $T++, 46340 * 46342, 0x80001218,
+    'multiplication: overflow an IV in 32-bit: pos pos';
+tryeq $T++, 46340 * -46342, -0x80001218,
+    'multiplication: overflow an IV in 32-bit: pos neg';
+tryeq $T++, -46340 * 46342, -0x80001218,
+    'multiplication: overflow an IV in 32-bit: neg pos';
+tryeq $T++, -46340 * -46342, 0x80001218,
+    'multiplication: overflow an IV in 32-bit: neg neg';
+
+tryeq $T++, 46342 * 46340, 0x80001218,
+    'multiplication: overflow an IV in 32-bit: pos pos';
+tryeq $T++, 46342 * -46340, -0x80001218,
+    'multiplication: overflow an IV in 32-bit: pos neg';
+tryeq $T++, -46342 * 46340, -0x80001218,
+    'multiplication: overflow an IV in 32-bit: neg pos';
+tryeq $T++, -46342 * -46340, 0x80001218,
+    'multiplication: overflow an IV in 32-bit: neg neg';
+
+# will overflow a positive IV (in 32-bit)
+tryeq $T++, 65536 * 32768, 0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: pos pos';
+tryeq $T++, 65536 * -32768, -0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: pos neg';
+tryeq $T++, -65536 * 32768, -0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: neg pos';
+tryeq $T++, -65536 * -32768, 0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: neg neg';
+
+tryeq $T++, 32768 * 65536, 0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: pos pos';
+tryeq $T++, 32768 * -65536, -0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: pos neg';
+tryeq $T++, -32768 * 65536, -0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: neg pos';
+tryeq $T++, -32768 * -65536, 0x80000000,
+    'multiplication: overflow a positive IV in 32-bit: neg neg';
+
+# 2147483647 is prime. bah.
+
+tryeq $T++, 46339 * 46341, 0x7ffea80f,
+    'multiplication: hex product: pos pos';
+tryeq $T++, 46339 * -46341, -0x7ffea80f,
+    'multiplication: hex product: pos neg';
+tryeq $T++, -46339 * 46341, -0x7ffea80f,
+    'multiplication: hex product: neg pos';
+tryeq $T++, -46339 * -46341, 0x7ffea80f,
+    'multiplication: hex product: neg neg';
+
+# leading space should be ignored
+
+tryeq $T++, 1 + " 1", 2, 'ignore leading space: addition';
+tryeq $T++, 3 + " -1", 2, 'ignore leading space: subtraction';
+tryeq $T++, 1.2, " 1.2", 'floating point and string equivalent: positive';
+tryeq $T++, -1.2, " -1.2", 'floating point and string equivalent: negative';
+
+# division
+tryeq $T++, 28/14, 2, 'division of two positive integers';
+tryeq $T++, 28/-7, -4, 'division of positive integer by negative';
+tryeq $T++, -28/4, -7, 'division of negative integer by positive';
+tryeq $T++, -28/-2, 14, 'division of negative integer by negative';
+
+tryeq $T++, 0x80000000/1, 0x80000000,
+    'division of positive hex by positive integer';
+tryeq $T++, 0x80000000/-1, -0x80000000,
+    'division of positive hex by negative integer';
+tryeq $T++, -0x80000000/1, -0x80000000,
+    'division of negative hex by negative integer';
+tryeq $T++, -0x80000000/-1, 0x80000000,
+    'division of negative hex by positive integer';
+
+# The example for sloppy divide, rigged to avoid the peephole optimiser.
+tryeq_sloppy $T++, "20." / "5.", 4, 'division of floating point without fractional part';
+
+tryeq $T++, 2.5 / 2, 1.25,
+    'division of positive floating point by positive integer';
+tryeq $T++, 3.5 / -2, -1.75,
+    'division of positive floating point by negative integer';
+tryeq $T++, -4.5 / 2, -2.25,
+    'division of negative floating point by positive integer';
+tryeq $T++, -5.5 / -2, 2.75,
+    'division of negative floating point by negative integer';
+
+# Bluuurg if your floating point can not accurately cope with powers of 2
+# [I suspect this is parsing string->float problems, not actual arith]
+tryeq_sloppy $T++, 18446744073709551616/1, 18446744073709551616,
+    'division of very large number by 1'; # Bluuurg
+tryeq_sloppy $T++, 18446744073709551616/2, 9223372036854775808,
+    'division of very large number by 2';
+tryeq_sloppy $T++, 18446744073709551616/4294967296, 4294967296,
+    'division of two very large numbers';
+tryeq_sloppy $T++, 18446744073709551616/9223372036854775808, 2,
+    'division of two very large numbers';
+
+{
+  # The peephole optimiser is wrong to think that it can substitute intops
+  # in place of regular ops, because i_multiply can overflow.
+  # Bug reported by "Sisyphus" <kalinabears@hdc.com.au>
+  my $n = 1127;
+
+  my $float = ($n % 1000) * 167772160.0;
+  tryeq_sloppy $T++, $float, 21307064320, 'integer times floating point';
+
+  # On a 32 bit machine, if the i_multiply op is used, you will probably get
+  # -167772160. It is actually undefined behaviour, so anything may happen.
+  my $int = ($n % 1000) * 167772160;
+  tryeq $T++, $int, 21307064320, 'integer times integer';
+
+  my $float2 = ($n % 1000 + 0.0) * 167772160;
+  tryeq $T++, $float2, 21307064320, 'floating point times integer';
+
+  my $int2 = ($n % 1000 + 0) * 167772160;
+  tryeq $T++, $int2, 21307064320, 'integer plus zero times integer';
+
+  # zero, but in a way that ought to be able to defeat any future optimizer:
+  my $zero = $$ - $$;
+  my $int3 = ($n % 1000 + $zero) * 167772160;
+  tryeq $T++, $int3, 21307064320, 'defeat any future optimizer';
+
+  my $t = time;
+  my $t1000 = time() * 1000;
+  try $T++, abs($t1000 -1000 * $t) <= 2000, 'absolute value';
+}
+
+{
+  # 64 bit variants
+  my $n = 1127;
+
+  my $float = ($n % 1000) * 720575940379279360.0;
+  tryeq_sloppy $T++, $float, 9.15131444281685e+19,
+    '64 bit: integer times floating point';
+
+  my $int = ($n % 1000) * 720575940379279360;
+  tryeq_sloppy $T++, $int, 9.15131444281685e+19,
+    '64 bit: integer times integer';
+
+  my $float2 = ($n % 1000 + 0.0) * 720575940379279360;
+  tryeq_sloppy $T++, $float2, 9.15131444281685e+19,
+    '64 bit: floating point times integer';
+
+  my $int2 = ($n % 1000 + 0) * 720575940379279360;
+  tryeq_sloppy $T++, $int2, 9.15131444281685e+19,
+    '64 bit: integer plus zero times integer';
+
+  # zero, but in a way that ought to be able to defeat any future optimizer:
+  my $zero = $$ - $$;
+  my $int3 = ($n % 1000 + $zero) * 720575940379279360;
+  tryeq_sloppy $T++, $int3, 9.15131444281685e+19,
+    '64 bit: defeat any future optimizer';
+}
+
+# [perl #109542] $1 and "$1" should be treated the same way
+"976562500000000" =~ /(\d+)/;
+$a = ($1 * 1024);
+$b = ("$1" * 1024);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" * something\n';
+$a = (1024 * $1);
+$b = (1024 * "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something * \$1 vs "\$1"\n';
+$a = ($1 + 102400000000000);
+$b = ("$1" + 102400000000000);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" + something\n';
+$a = (102400000000000 + $1);
+$b = (102400000000000 + "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something + \$1 vs "\$1"\n';
+$a = ($1 - 10240000000000000);
+$b = ("$1" - 10240000000000000);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" - something\n';
+$a = (10240000000000000 - $1);
+$b = (10240000000000000 - "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something - \$1 vs "\$1"\n';
+"976562500" =~ /(\d+)/;
+$a = ($1 ** 2);
+$b = ("$1" ** 2);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" ** something\n';
+"32" =~ /(\d+)/;
+$a = (3 ** $1);
+$b = (3 ** "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something ** \$1 vs "\$1"\n';
+"97656250000000000" =~ /(\d+)/;
+$a = ($1 / 10);
+$b = ("$1" / 10);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" / something\n';
+"10" =~ /(\d+)/;
+$a = (97656250000000000 / $1);
+$b = (97656250000000000 / "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something / \$1 vs "\$1"\n';
+"97656250000000000" =~ /(\d+)/;
+$a = ($1 <=> 97656250000000001);
+$b = ("$1" <=> 97656250000000001);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" <=> something\n';
+$a = (97656250000000001 <=> $1);
+$b = (97656250000000001 <=> "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something <=> \$1 vs "\$1"\n';
+"97656250000000001" =~ /(\d+)/;
+$a = ($1 % 97656250000000002);
+$b = ("$1" % 97656250000000002);
+print "not "x($a ne $b), "ok ", $T++, qq ' - \$1 vs "\$1" % something\n';
+$a = (97656250000000000 % $1);
+$b = (97656250000000000 % "$1");
+print "not "x($a ne $b), "ok ", $T++, qq ' - something % \$1 vs "\$1"\n';
+
+my $vms_no_ieee;
+if ($^O eq 'VMS') {
+  use vars '%Config';
+  eval {require Config; import Config};
+  $vms_no_ieee = 1 unless defined($Config{useieee});
+}
+
+if ($^O eq 'vos') {
+  print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n";
+}
+elsif ($vms_no_ieee) {
+ print $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n"
+}
+elsif ($^O eq 'ultrix') {
+  print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n";
+}
+else {
+  # The computation of $v should overflow and produce "infinity"
+  # on any system whose max exponent is less than 10**1506.
+  # The exact string used to represent infinity varies by OS,
+  # so we don't test for it; all we care is that we don't die.
+  #
+  # Perl considers it to be an error if SIGFPE is raised.
+  # Chances are the interpreter will die, since it doesn't set
+  # up a handler for SIGFPE.  That's why this test is last; to
+  # minimize the number of test failures.  --PG
+
+  my $n = 5000;
+  my $v = 2;
+  while (--$n)
+  {
+    $v *= 2;
+  }
+  print "ok ", $T++, " - infinity\n";
+}
+
diff --git a/gnu/usr.bin/perl/t/opbasic/cmp.t b/gnu/usr.bin/perl/t/opbasic/cmp.t
new file mode 100644
index 00000000000..43e434590a6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/opbasic/cmp.t
@@ -0,0 +1,322 @@
+#!./perl
+
+BEGIN {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+}
+
+# This file has been placed in t/opbasic to indicate that it should not use
+# functions imported from t/test.pl or Test::More, as those programs/libraries
+# use operators which are what is being tested in this file.
+
+# 2s complement assumption. Will not break test, just makes the internals of
+# the SVs less interesting if were not on 2s complement system.
+my $uv_max = ~0;
+my $uv_maxm1 = ~0 ^ 1;
+my $uv_big = $uv_max;
+$uv_big = ($uv_big - 20000) | 1;
+my ($iv0, $iv1, $ivm1, $iv_min, $iv_max, $iv_big, $iv_small);
+$iv_max = $uv_max; # Do copy, *then* divide
+$iv_max /= 2;
+$iv_min = $iv_max;
+{
+  use integer;
+  $iv0 = 2 - 2;
+  $iv1 = 3 - 2;
+  $ivm1 = 2 - 3;
+  $iv_max -= 1;
+  $iv_min += 0;
+  $iv_big = $iv_max - 3;
+  $iv_small = $iv_min + 2;
+}
+my $uv_bigi = $iv_big;
+$uv_bigi |= 0x0;
+
+my @array = qw(perl rules);
+
+my @raw, @upgraded, @utf8;
+foreach ("\x{1F4A9}", chr(163), 'N') {
+    push @raw, $_;
+    my $temp = $_ . chr 256;
+    chop $temp;
+    push @upgraded, $temp;
+    my $utf8 = $_;
+    next if utf8::upgrade($utf8) == length $_;
+    utf8::encode($utf8);
+    push @utf8, $utf8;
+}
+
+# Seems one needs to perform the maths on 'Inf' to get the NV correctly primed.
+@FOO = ('s', 'N/A', 'a', 'NaN', -1, undef, 0, 1, 3.14, 1e37, 0.632120558, -.5,
+	'Inf'+1, '-Inf'-1, 0x0, 0x1, 0x5, 0xFFFFFFFF, $uv_max, $uv_maxm1,
+	$uv_big, $uv_bigi, $iv0, $iv1, $ivm1, $iv_min, $iv_max, $iv_big,
+	$iv_small, \$array[0], \$array[0], \$array[1], \$^X, @raw, @upgraded,
+	@utf8);
+
+$expect = 7 * ($#FOO+2) * ($#FOO+1) + 6 * @raw + 6 * @utf8;
+print "1..$expect\n";
+
+my $bad_NaN = 0;
+
+{
+    # gcc -ffast-math option may stop NaNs working correctly
+    use Config;
+    my $ccflags = $Config{ccflags} // '';
+    $bad_NaN = 1 if $ccflags =~ /-ffast-math\b/;
+}
+
+sub nok ($$$$$$$$) {
+  my ($test, $left, $threeway, $right, $result, $i, $j, $boolean) = @_;
+  $result = defined $result ? "'$result'" : 'undef';
+  if ($bad_NaN && ($left eq 'NaN' || $right eq 'NaN')) {
+    print "ok $test # skipping failed NaN test under -ffast-math\n";
+  }
+  else {
+    print "not ok $test # ($left $threeway $right) gives: $result \$i=$i \$j=$j, $boolean disagrees\n";
+  }
+}
+
+my $ok = 0;
+for my $i (0..$#FOO) {
+    for my $j ($i..$#FOO) {
+	$ok++;
+	# Comparison routines may convert these internally, which would change
+	# what is used to determine the comparison on later runs. Hence copy
+	my ($i1, $i2, $i3, $i4, $i5, $i6, $i7, $i8, $i9, $i10,
+	    $i11, $i12, $i13, $i14, $i15, $i16, $i17) =
+	  ($FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i],
+	   $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i],
+	   $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i], $FOO[$i]);
+	my ($j1, $j2, $j3, $j4, $j5, $j6, $j7, $j8, $j9, $j10,
+	    $j11, $j12, $j13, $j14, $j15, $j16, $j17) =
+	  ($FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j],
+	   $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j],
+	   $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j], $FOO[$j]);
+	my $cmp = $i1 <=> $j1;
+	if (!defined($cmp) ? !($i2 < $j2)
+	    : ($cmp == -1 && $i2 < $j2 ||
+	       $cmp == 0  && !($i2 < $j2) ||
+	       $cmp == 1  && !($i2 < $j2)))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<');
+	}
+	$ok++;
+	if (!defined($cmp) ? !($i4 == $j4)
+	    : ($cmp == -1 && !($i4 == $j4) ||
+	       $cmp == 0  && $i4 == $j4 ||
+	       $cmp == 1  && !($i4 == $j4)))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '==');
+	}
+	$ok++;
+	if (!defined($cmp) ? !($i5 > $j5)
+	    : ($cmp == -1 && !($i5 > $j5) ||
+	       $cmp == 0  && !($i5 > $j5) ||
+	       $cmp == 1  && ($i5 > $j5)))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>');
+	}
+	$ok++;
+	if (!defined($cmp) ? !($i6 >= $j6)
+	    : ($cmp == -1 && !($i6 >= $j6) ||
+	       $cmp == 0  && $i6 >= $j6 ||
+	       $cmp == 1  && $i6 >= $j6))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '>=');
+	}
+	$ok++;
+	# OK, so the docs are wrong it seems. NaN != NaN
+	if (!defined($cmp) ? ($i7 != $j7)
+	    : ($cmp == -1 && $i7 != $j7 ||
+	       $cmp == 0  && !($i7 != $j7) ||
+	       $cmp == 1  && $i7 != $j7))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '!=');
+	}
+	$ok++;
+	if (!defined($cmp) ? !($i8 <= $j8)
+	    : ($cmp == -1 && $i8 <= $j8 ||
+	       $cmp == 0  && $i8 <= $j8 ||
+	       $cmp == 1  && !($i8 <= $j8)))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<=');
+	}
+	$ok++;
+        my $pmc =  $j16 <=> $i16; # cmp it in reverse
+        # Should give -ve of other answer, or undef for NaNs
+        # a + -a should be zero. not zero is truth. which avoids using ==
+	if (defined($cmp) ? !($cmp + $pmc) : !defined $pmc)
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, '<=>', $j3, $cmp, $i, $j, '<=> transposed');
+	}
+
+
+	# String comparisons
+	$ok++;
+	$cmp = $i9 cmp $j9;
+	if ($cmp == -1 && $i10 lt $j10 ||
+	    $cmp == 0  && !($i10 lt $j10) ||
+	    $cmp == 1  && !($i10 lt $j10))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'lt');
+	}
+	$ok++;
+	if ($cmp == -1 && !($i11 eq $j11) ||
+	    $cmp == 0  && ($i11 eq $j11) ||
+	    $cmp == 1  && !($i11 eq $j11))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'eq');
+	}
+	$ok++;
+	if ($cmp == -1 && !($i12 gt $j12) ||
+	    $cmp == 0  && !($i12 gt $j12) ||
+	    $cmp == 1  && ($i12 gt $j12))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'gt');
+	}
+	$ok++;
+	if ($cmp == -1 && $i13 le $j13 ||
+	    $cmp == 0  && ($i13 le $j13) ||
+	    $cmp == 1  && !($i13 le $j13))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'le');
+	}
+	$ok++;
+	if ($cmp == -1 && ($i14 ne $j14) ||
+	    $cmp == 0  && !($i14 ne $j14) ||
+	    $cmp == 1  && ($i14 ne $j14))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'ne');
+	}
+	$ok++;
+	if ($cmp == -1 && !($i15 ge $j15) ||
+	    $cmp == 0  && ($i15 ge $j15) ||
+	    $cmp == 1  && ($i15 ge $j15))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'ge');
+	}
+	$ok++;
+        $pmc =  $j17 cmp $i17; # cmp it in reverse
+        # Should give -ve of other answer
+        # a + -a should be zero. not zero is truth. which avoids using ==
+	if (!($cmp + $pmc))
+	{
+	    print "ok $ok\n";
+	}
+	else {
+	    nok ($ok, $i3, 'cmp', $j3, $cmp, $i, $j, 'cmp transposed');
+	}
+    }
+}
+
+# We know the answers for these. We can rely on the consistency checks above
+# to test the other string comparisons.
+
+while (my ($i, $v) = each @raw) {
+    # Copy, to avoid any inadvertent conversion
+    my ($raw, $cooked, $not);
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = $raw eq $cooked ? '' : 'not ';
+    printf "%sok %d # eq, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = $raw ne $cooked ? 'not ' : '';
+    printf "%sok %d # ne, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = (($raw cmp $cooked) == 0) ? '' : 'not ';
+    printf "%sok %d # cmp, chr %d\n", $not, ++$ok, ord $raw;
+
+    # And now, transposed.
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = $cooked eq $raw ? '' : 'not ';
+    printf "%sok %d # eq, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = $cooked ne $raw ? 'not ' : '';
+    printf "%sok %d # ne, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $v;
+    $cooked = $upgraded[$i];
+    $not = (($cooked cmp $raw) == 0) ? '' : 'not ';
+    printf "%sok %d # cmp, chr %d\n", $not, ++$ok, ord $raw;
+}
+
+while (my ($i, $v) = each @utf8) {
+    # Copy, to avoid any inadvertent conversion
+    my ($raw, $cooked, $not);
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = $raw eq $cooked ? 'not ' : '';
+    printf "%sok %d # eq vs octets, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = $raw ne $cooked ? '' : 'not ';
+    printf "%sok %d # ne vs octets, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = (($raw cmp $cooked) == 0) ? 'not ' : '';
+    printf "%sok %d # cmp vs octects, chr %d\n", $not, ++$ok, ord $raw;
+
+    # And now, transposed.
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = $cooked eq $raw ? 'not ' : '';
+    printf "%sok %d # eq vs octets, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = $cooked ne $raw? '' : 'not ';
+    printf "%sok %d # ne vs octets, chr %d\n", $not, ++$ok, ord $raw;
+
+    $raw = $raw[$i];
+    $cooked = $v;
+    $not = (($cooked cmp $raw) == 0) ? 'not ' : '';
+    printf "%sok %d # cmp vs octects, chr %d\n", $not, ++$ok, ord $raw;
+}
diff --git a/gnu/usr.bin/perl/t/opbasic/concat.t b/gnu/usr.bin/perl/t/opbasic/concat.t
new file mode 100644
index 00000000000..f020992ac8a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/opbasic/concat.t
@@ -0,0 +1,165 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# ok() functions from other sources (e.g., t/test.pl) may use concatenation,
+# but that is what is being tested in this file.  Hence, we place this file
+# in the directory where do not use t/test.pl, and we write an ok() function
+# specially written to avoid any concatenation.
+
+my $test = 1;
+sub ok {
+    my($ok, $name) = @_;
+
+    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name;
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+    $test++;
+    return $ok;
+}
+
+print "1..30\n";
+
+($a, $b, $c) = qw(foo bar);
+
+ok("$a"     eq "foo",    "verifying assign");
+ok("$a$b"   eq "foobar", "basic concatenation");
+ok("$c$a$c" eq "foo",    "concatenate undef, fore and aft");
+
+# Okay, so that wasn't very challenging.  Let's go Unicode.
+
+{
+    # bug id 20000819.004 
+
+    $_ = $dx = "\x{10f2}";
+    s/($dx)/$dx$1/;
+    {
+        ok($_ eq  "$dx$dx","bug id 20000819.004, back");
+    }
+
+    $_ = $dx = "\x{10f2}";
+    s/($dx)/$1$dx/;
+    {
+        ok($_ eq  "$dx$dx","bug id 20000819.004, front");
+    }
+
+    $dx = "\x{10f2}";
+    $_  = "\x{10f2}\x{10f2}";
+    s/($dx)($dx)/$1$2/;
+    {
+        ok($_ eq  "$dx$dx","bug id 20000819.004, front and back");
+    }
+}
+
+{
+    # bug id 20000901.092
+    # test that undef left and right of utf8 results in a valid string
+
+    my $a;
+    $a .= "\x{1ff}";
+    ok($a eq  "\x{1ff}", "bug id 20000901.092, undef left");
+    $a .= undef;
+    ok($a eq  "\x{1ff}", "bug id 20000901.092, undef right");
+}
+
+{
+    # ID 20001020.006
+
+    "x" =~ /(.)/; # unset $2
+
+    # Without the fix this 5.7.0 would croak:
+    # Modification of a read-only value attempted at ...
+    eval {"$2\x{1234}"};
+    ok(!$@, "bug id 20001020.006, left");
+
+    # For symmetry with the above.
+    eval {"\x{1234}$2"};
+    ok(!$@, "bug id 20001020.006, right");
+
+    *pi = \undef;
+    # This bug existed earlier than the $2 bug, but is fixed with the same
+    # patch. Without the fix this 5.7.0 would also croak:
+    # Modification of a read-only value attempted at ...
+    eval{"$pi\x{1234}"};
+    ok(!$@, "bug id 20001020.006, constant left");
+
+    # For symmetry with the above.
+    eval{"\x{1234}$pi"};
+    ok(!$@, "bug id 20001020.006, constant right");
+}
+
+sub beq { use bytes; $_[0] eq $_[1]; }
+
+{
+    # concat should not upgrade its arguments.
+    my($l, $r, $c);
+
+    ($l, $r, $c) = ("\x{101}", "\x{fe}", "\x{101}\x{fe}");
+    ok(beq($l.$r, $c), "concat utf8 and byte");
+    ok(beq($l, "\x{101}"), "right not changed after concat u+b");
+    ok(beq($r, "\x{fe}"), "left not changed after concat u+b");
+
+    ($l, $r, $c) = ("\x{fe}", "\x{101}", "\x{fe}\x{101}");
+    ok(beq($l.$r, $c), "concat byte and utf8");
+    ok(beq($l, "\x{fe}"), "right not changed after concat b+u");
+    ok(beq($r, "\x{101}"), "left not changed after concat b+u");
+}
+
+{
+    my $a; ($a .= 5) . 6;
+    ok($a == 5, '($a .= 5) . 6 - present since 5.000');
+}
+
+{
+    # [perl #24508] optree construction bug
+    sub strfoo { "x" }
+    my ($x, $y);
+    $y = ($x = '' . strfoo()) . "y";
+    ok( "$x,$y" eq "x,xy", 'figures out correct target' );
+}
+
+{
+    # [perl #26905] "use bytes" doesn't apply byte semantics to concatenation
+
+    my $p = "\xB6"; # PILCROW SIGN (ASCII/EBCDIC), 2bytes in UTF-X
+    my $u = "\x{100}";
+    my $b = pack 'a*', "\x{100}";
+    my $pu = "\xB6\x{100}";
+    my $up = "\x{100}\xB6";
+    my $x1 = $p;
+    my $y1 = $u;
+
+    use bytes;
+    ok(beq($p.$u, $p.$b), "perl #26905, left eq bytes");
+    ok(beq($u.$p, $b.$p), "perl #26905, right eq bytes");
+    ok(!beq($p.$u, $pu),  "perl #26905, left ne unicode");
+    ok(!beq($u.$p, $up),  "perl #26905, right ne unicode");
+
+    $x1 .= $u;
+    $x2 = $p . $u;
+    $y1 .= $p;
+    $y2 = $u . $p;
+
+    no bytes;
+    ok(beq($x1, $x2), "perl #26905, left,  .= vs = . in bytes");
+    ok(beq($y1, $y2), "perl #26905, right, .= vs = . in bytes");
+    ok(($x1 eq $x2),  "perl #26905, left,  .= vs = . in chars");
+    ok(($y1 eq $y2),  "perl #26905, right, .= vs = . in chars");
+}
+
+{
+    # Concatenation needs to preserve UTF8ness of left oper.
+    my $x = eval"qr/\x{fff}/";
+    ok( ord chop($x .= "\303\277") == 191, "UTF8ness preserved" );
+}
+
+{
+    my $x;
+    $x = "a" . "b";
+    $x .= "-append-";
+    ok($x eq "ab-append-", "Appending to something initialized using constant folding");
+}
diff --git a/gnu/usr.bin/perl/t/opbasic/magic_phase.t b/gnu/usr.bin/perl/t/opbasic/magic_phase.t
new file mode 100644
index 00000000000..d7217058575
--- /dev/null
+++ b/gnu/usr.bin/perl/t/opbasic/magic_phase.t
@@ -0,0 +1,49 @@
+#!./perl
+
+use strict;
+use warnings;
+
+# Test ${^GLOBAL_PHASE}
+#
+# Test::More, t/test.pl, etc., assert plans in END, which happens before global
+# destruction. We do not want to use those programs/libraries here, so we
+# place this file in directory t/opbasic.
+
+BEGIN { print "1..7\n" }
+
+sub ok ($$) {
+    print "not " if !$_[0];
+    print "ok";
+    print " - $_[1]" if defined $_[1];
+    print "\n";
+}
+
+BEGIN {
+    ok ${^GLOBAL_PHASE} eq 'START', 'START';
+}
+
+CHECK {
+    ok ${^GLOBAL_PHASE} eq 'CHECK', 'CHECK';
+}
+
+INIT {
+    ok ${^GLOBAL_PHASE} eq 'INIT', 'INIT';
+}
+
+ok ${^GLOBAL_PHASE} eq 'RUN', 'RUN';
+
+sub Moo::DESTROY {
+    ok ${^GLOBAL_PHASE} eq 'RUN', 'DESTROY is run-time too, usually';
+}
+
+my $tiger = bless {}, Moo::;
+
+sub Kooh::DESTROY {
+    ok ${^GLOBAL_PHASE} eq 'DESTRUCT', 'DESTRUCT';
+}
+
+our $affe = bless {}, Kooh::;
+
+END {
+    ok ${^GLOBAL_PHASE} eq 'END', 'END';
+}
diff --git a/gnu/usr.bin/perl/t/opbasic/qq.t b/gnu/usr.bin/perl/t/opbasic/qq.t
new file mode 100644
index 00000000000..8dac6ec1778
--- /dev/null
+++ b/gnu/usr.bin/perl/t/opbasic/qq.t
@@ -0,0 +1,76 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+# This file uses a specially crafted is() function rather than that found in
+# t/test.pl or Test::More.  Hence, we place this file in directory t/opbasic.
+
+print q(1..28
+);
+
+# This is() function is written to avoid ""
+my $test = 1;
+sub is {
+    my($left, $right) = @_;
+
+    if ($left eq $right) {
+      printf 'ok %d
+', $test++;
+      return 1;
+    }
+    foreach ($left, $right) {
+      # Comment out these regexps to map non-printables to ord if the perl under
+      # test is so broken that it is not helping
+      s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge;
+      $_ = sprintf q('%s'), $_;
+      s/^''\.//;
+      s/\.''$//;
+    }
+    printf q(not ok %d - got %s expected %s
+), $test++, $left, $right;
+
+    printf q(# Failed test at line %d
+), (caller)[2];
+
+    return 0;
+}
+
+is ("\x53", chr 83);
+is ("\x4EE", chr (78) . 'E');
+is ("\x4i", chr (4) . 'i');	# This will warn
+is ("\xh", chr (0) . 'h');	# This will warn
+is ("\xx", chr (0) . 'x');	# This will warn
+is ("\xx9", chr (0) . 'x9');	# This will warn. \x9 is tab in EBCDIC too?
+is ("\x9_E", chr (9) . '_E');	# This will warn
+
+is ("\x{4E}", chr 78);
+is ("\x{6_9}", chr 105);
+is ("\x{_6_3}", chr 99);
+is ("\x{_6B}", chr 107);
+
+is ("\x{9__0}", chr 9);		# multiple underscores not allowed.
+is ("\x{77_}", chr 119);	# trailing underscore warns.
+is ("\x{6FQ}z", chr (111) . 'z');
+
+is ("\x{0x4E}", chr 0);
+is ("\x{x4E}", chr 0);
+
+is ("\x{0065}", chr 101);
+is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
+    chr 114);
+is ("\x{0_06_5}", chr 101);
+is ("\x{1234}", chr 4660);
+is ("\x{10FFFD}", chr 1114109);
+is ("\400", chr 0x100);
+is ("\600", chr 0x180);
+is ("\777", chr 0x1FF);
+is ("a\o{120}b", "a" . chr(0x50) . "b");
+is ("a\o{400}b", "a" . chr(0x100) . "b");
+is ("a\o{1000}b", "a" . chr(0x200) . "b");
+
+# This caused a memory fault
+no warnings "utf8";
+is ("abc", eval qq[qq\x{8000_0000}abc\x{8000_0000}])
diff --git a/gnu/usr.bin/perl/t/porting/args_assert.t b/gnu/usr.bin/perl/t/porting/args_assert.t
index e1a2fa5d8e5..27e9bf27fd9 100755
--- a/gnu/usr.bin/perl/t/porting/args_assert.t
+++ b/gnu/usr.bin/perl/t/porting/args_assert.t
@@ -39,6 +39,8 @@ if (!@ARGV) {
 	# *.c or */*.c
 	push @ARGV, $prefix . $1 if m!^((?:[^/]+/)?[^/]+\.c)\t!;
     }
+    push @ARGV, $prefix . 'inline.h'; # Special case this '.h' which acts like
+                                      # a '.c'
 }
 
 while (<>) {
diff --git a/gnu/usr.bin/perl/t/porting/authors.t b/gnu/usr.bin/perl/t/porting/authors.t
index 9b9ba7c80d1..bc69e3a2a15 100644
--- a/gnu/usr.bin/perl/t/porting/authors.t
+++ b/gnu/usr.bin/perl/t/porting/authors.t
@@ -4,7 +4,7 @@
 BEGIN {
     @INC = '..' if -f '../TestInit.pm';
 }
-use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
+use TestInit qw(T); # T is chdir to the top level
 use strict;
 
 require 't/test.pl';
diff --git a/gnu/usr.bin/perl/t/porting/checkcase.t b/gnu/usr.bin/perl/t/porting/checkcase.t
index 4ae44ca0ee1..3c05e22760f 100755
--- a/gnu/usr.bin/perl/t/porting/checkcase.t
+++ b/gnu/usr.bin/perl/t/porting/checkcase.t
@@ -1,6 +1,11 @@
 #!/usr/bin/perl
-# Finds the files that have the same name, case insensitively,
-# in the current directory and its subdirectories
+# Finds the files that have the same name, case insensitively in the build tree
+
+BEGIN {
+    @INC = '..' if -f '../TestInit.pm';
+    require './test.pl';
+}
+use TestInit qw(T); # T is chdir to the top level
 
 use warnings;
 use strict;
@@ -9,29 +14,31 @@ use File::Find;
 my %files;
 my $test_count = 0;
 
-find(sub {
-        # We only care about directories to the extent they
-        # result in an actual file collision, so skip dirs
-        return if -d $File::Find::name;
+find({no_chdir => 1, wanted => sub {
+	   my $name = $File::Find::name;
+	   # Assumes that the path separator is exactly one character.
+	   $name =~ s/^\..//;
 
-        my $name = $File::Find::name;
-        # Assumes that the path separator is exactly one character.
-        $name =~ s/^\.\..//;
+	   # Special exemption for Makefile, makefile
+	   return if $name =~ m!\A(?:x2p/)?[Mm]akefile\z!;
 
-        # Special exemption for Makefile, makefile
-        return if $name =~ m!\A(?:x2p/)?[Mm]akefile\z!;
+	   if ($name eq '.git') {
+	       # Don't scan the .git directory, as its contents are outside
+	       # our control. In particular, as fetch doesn't default to
+	       # --prune, # someone pushing a branch upstream with a name
+	       # which case-conflicts with a previously deleted branch will
+	       # cause action-at-a-distance failures, because locally
+	       # .git/logs/refs/remotes will contain both.
+	       ++$File::Find::prune;
+	       return;
+	   }
 
-        push @{$files{lc $name}}, $name;
-    }, '..');
+	   push @{$files{lc $name}}, $name;
+	 }}, '.');
 
 foreach (sort values %files) {
-    if (@$_ > 1) {
-        print "not ok ".++$test_count. " - ". join(", ", @$_), "\n";
-        print STDERR "# $_\n" foreach @$_;
-    } else {
-        print "ok ".++$test_count. " - ". join(", ", @$_), "\n";
-    }
+    is( @$_, 1, join(", ", @$_) ) or
+        do{ note($_) foreach @$_; };
 }
 
-print "1..".$test_count."\n";
-# vim: ts=4 sts=4 sw=4 et:
+done_testing();
diff --git a/gnu/usr.bin/perl/t/porting/cmp_version.t b/gnu/usr.bin/perl/t/porting/cmp_version.t
index 6204c576120..e7627e4b3d7 100644
--- a/gnu/usr.bin/perl/t/porting/cmp_version.t
+++ b/gnu/usr.bin/perl/t/porting/cmp_version.t
@@ -12,6 +12,7 @@ use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
 use strict;
 
 require 't/test.pl';
-find_git_or_skip('all');
+my $source = find_git_or_skip('all');
+chdir $source or die "Can't chdir to $source: $!";
 
 system "$^X Porting/cmpVERSION.pl --exclude --tap";
diff --git a/gnu/usr.bin/perl/t/porting/customized.dat b/gnu/usr.bin/perl/t/porting/customized.dat
index f9620442ee4..bdb8eb21306 100644
--- a/gnu/usr.bin/perl/t/porting/customized.dat
+++ b/gnu/usr.bin/perl/t/porting/customized.dat
@@ -1,13 +1,16 @@
+Text::Balanced cpan/Text-Balanced/t/01_compile.t 1598cf491a48fa546260a2ec41142abe84da533d
+Text::Balanced cpan/Text-Balanced/t/02_extbrk.t 6ba1b64a4604e822dc2260b8ffcea6b406339ee8
+Text::Balanced cpan/Text-Balanced/t/03_extcbk.t 3307c980af28963414cab799c427b359ef3b8657
+Text::Balanced cpan/Text-Balanced/t/04_extdel.t be993c5c295b125b4be0ed55f866a249599f5835
+Text::Balanced cpan/Text-Balanced/t/05_extmul.t 4d1bc60add35ac203873f5371d8c6fcc9c8b6d80
+Text::Balanced cpan/Text-Balanced/t/06_extqlk.t 81a5804d392013393a338325b197cea52c4c44e0
+Text::Balanced cpan/Text-Balanced/t/07_exttag.t 5a209ed156387d4614d3003292e5fc412b8541e5
+Text::Balanced cpan/Text-Balanced/t/08_extvar.t 0776ef2cbdad5b1fbefb300541d079212cc24d92
+Text::Balanced cpan/Text-Balanced/t/09_gentag.t 42361b5dfb3bb728bce20f4fb0d92ccfb27c2ba7
 Module::Build cpan/Module-Build/lib/Module/Build/ConfigData.pm 2f3f07fd889077ebd51791ad6e195d9164b4baf3
-Test::Harness cpan/Test-Harness/t/source.t 61738913dac9ba6c4504756d355c23c25c47d31e
-Test::Harness cpan/Test-Harness/t/testargs.t 79c91b2ea73f7cbfb9bae45dec4a62db74cb8dbf
-Module::Pluggable cpan/Module-Pluggable/Makefile.PL 72062c1a01ed7c62d16c55122c163b2d89f0d739
-autodie cpan/autodie/t/open.t cb493da4305f591ca0344d09e8a840a3147c5579
-libnet cpan/libnet/Makefile.PL 5554b71464b45f5cc002e55f2464f7ff4abd05b6
-podlators cpan/podlators/scripts/pod2man.PL 8fb484dc560adb00889f504760ca0a4defa9dc40
-podlators cpan/podlators/scripts/pod2text.PL 53ccba9264368c3f9acd2a36d1d354797d2a88f6
-podlators pod/perlpodstyle.pod 4f1ba65eddc5576267954b948556e16a9686c411
+Test::Harness cpan/Test-Harness/t/source.t 884890970fb850874213159df263ba483bac62e9
 CPANPLUS cpan/CPANPLUS/Makefile.PL 5d533f6722af6aae73204755beb8d6c008fc0d4a
-Text-Tabs+Wrap cpan/Text-Tabs/t/fill.t a960d2c4f66b7e30557b5479e0da2da1bf7a7f45
-Text-Tabs+Wrap cpan/Text-Tabs/t/tabs.t 63a67b3a319c858d7e66306b8a653de1951153dc
-Sys::Syslog cpan/Sys-Syslog/t/syslog.t 647571fc90918883b871ff7e005ed7ab8a223784
+libnet cpan/libnet/Makefile.PL 5554b71464b45f5cc002e55f2464f7ff4abd05b6
+podlators cpan/podlators/scripts/pod2man.PL f81acf53f3ff46cdcc5ebdd661c5d13eb35d20d6
+podlators cpan/podlators/scripts/pod2text.PL b4693fcfe4a0a1b38a215cfb8985a65d5d025d69
+Module::Pluggable cpan/Module-Pluggable/Makefile.PL 72062c1a01ed7c62d16c55122c163b2d89f0d739
diff --git a/gnu/usr.bin/perl/t/porting/customized.t b/gnu/usr.bin/perl/t/porting/customized.t
index 76053bcc07d..631c1bcfb82 100644
--- a/gnu/usr.bin/perl/t/porting/customized.t
+++ b/gnu/usr.bin/perl/t/porting/customized.t
@@ -10,7 +10,8 @@ BEGIN {
         # XXX that should be fixed
 
     chdir '..' unless -d 't';
-    @INC = qw(lib Porting);
+    @INC = qw(lib Porting t);
+    require 'test.pl';
 }
 
 use strict;
@@ -99,21 +100,16 @@ foreach my $module ( keys %Modules ) {
       next;
     }
     my $should_be = $customised{ $module }->{ $file };
-    if ( $id ne $should_be ) {
-       print  "not ok ".++$TestCounter." - SHA for $file does not match stashed SHA\n";
-    }
-    else {
-       print  "ok ".++$TestCounter." - SHA for $file matched\n";
-    }
+    is( $id, $should_be, "SHA for $file matches stashed SHA" );
   }
 }
 
 if ( $regen ) {
-  print "ok ".++$TestCounter." - regenerated data file\n";
+  pass( "regenerated data file" );
   close $data_fh;
 }
 
-print "1..".$TestCounter."\n";
+done_testing();
 
 =pod
 
diff --git a/gnu/usr.bin/perl/t/porting/diag.t b/gnu/usr.bin/perl/t/porting/diag.t
index 58bed957a65..bcf853e5c98 100755
--- a/gnu/usr.bin/perl/t/porting/diag.t
+++ b/gnu/usr.bin/perl/t/porting/diag.t
@@ -2,8 +2,10 @@
 use warnings;
 use strict;
 
-chdir 't';
-require './test.pl';
+BEGIN {
+  chdir 't';
+  require './test.pl';
+}
 
 plan('no_plan');
 
@@ -49,21 +51,28 @@ while (<$func_fh>) {
 
 close $func_fh;
 
+my $regcomp_re = "(?<routine>(?:ckWARN(?:\\d+)?reg\\w*|vWARN\\d+))";
 my $function_re = join '|', @functions;
-my $source_msg_re = '(?<routine>\bDIE\b|$function_re)';
+my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?\b';
+my $source_msg_re =
+   "(?<routine>\\bDIE\\b|$function_re|$regcomp_fail_re)";
 my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"';
 my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s*
     \(aTHX_ \s*
     (?:packWARN\d*\((?<category>.*?)\),)? \s*
     $text_re /x;
 my $bad_version_re = qr{BADVERSION\([^"]*$text_re};
+   $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/;
+my $regcomp_call_re = qr/$regcomp_re.*?$text_re/;
 
 my %entries;
 
 # Get the ignores that are compiled into this file
+my $reading_categorical_exceptions;
 while (<DATA>) {
   chomp;
-  $entries{$_}{todo}=1;
+  $entries{$_}{$reading_categorical_exceptions ? 'cattodo' : 'todo'}=1;
+  /__CATEGORIES__/ and ++$reading_categorical_exceptions;
 }
 
 my $pod = "pod/perldiag.pod";
@@ -71,14 +80,27 @@ my $cur_entry;
 open my $diagfh, "<", $pod
   or die "Can't open $pod: $!";
 
-my $category_re = qr/ [a-z0-9_]+?/;      # Note: requires an initial space
+my $category_re = qr/ [a-z0-9_:]+?/;    # Note: requires an initial space
 my $severity_re = qr/ . (?: \| . )* /x; # A severity is a single char, but can
                                         # be of the form 'S|P|W'
+my @same_descr;
 while (<$diagfh>) {
   if (m/^=item (.*)/) {
     $cur_entry = $1;
 
-    if (exists $entries{$cur_entry}) {
+    # Allow multi-line headers
+    while (<$diagfh>) {
+      if (/^\s*$/) {
+        last;
+      }
+
+      $cur_entry .= $_;
+    }
+
+    $cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's
+    $cur_entry =~ s/\s+\z//;
+
+    if (exists $entries{$cur_entry} && $entries{$cur_entry}{todo}) {
         TODO: {
             local $::TODO = "Remove the TODO entry \"$cur_entry\" from DATA as it is already in $pod near line $.";
             ok($cur_entry);
@@ -88,7 +110,6 @@ while (<$diagfh>) {
     # overwrites one in DATA.
     $entries{$cur_entry}{todo} = 0;
     $entries{$cur_entry}{line_number} = $.;
-    next;
   }
 
   next if ! defined $cur_entry;
@@ -97,10 +118,16 @@ while (<$diagfh>) {
     if (/^ \( ( $severity_re )
 
         # Can have multiple categories separated by commas
-        (?: ( $category_re ) (?: , $category_re)* )? \) /x)
+        ( $category_re (?: , $category_re)* )? \) /x)
     {
       $entries{$cur_entry}{severity} = $1;
-      $entries{$cur_entry}{category} = $2;
+      $entries{$cur_entry}{category} =
+        $2 && join ", ", sort split " ", $2 =~ y/,//dr;
+
+      # Record it also for other messages sharing the same description
+      @$_{qw<severity category>} =
+        @{$entries{$cur_entry}}{qw<severity category>}
+       for @same_descr;
     }
     elsif (! $entries{$cur_entry}{first_line} && $_ =~ /\S/) {
 
@@ -108,6 +135,12 @@ while (<$diagfh>) {
       # that can later examine it to determine if that is ok or not
       $entries{$cur_entry}{first_line} = $_;
     }
+    if (/\S/) {
+      @same_descr = ();
+    }
+    else {
+      push @same_descr, $entries{$cur_entry};
+    }
   }
 }
 
@@ -158,19 +191,17 @@ my $specialformats =
  join '|', sort { length $b cmp length $a } keys %specialformats;
 my $specialformats_re = qr/%$format_modifiers"\s*($specialformats)(\s*")?/;
 
-# Recursively descend looking for source files.
-my @todo = sort <*>;
-while (@todo) {
-  my $todo = shift @todo;
-  next if $todo ~~ ['t', 'lib', 'ext', 'dist', 'cpan'];
-  # opmini.c is just a copy of op.c, so there's no need to check again.
-  next if $todo eq 'opmini.c';
-  if (-d $todo) {
-    unshift @todo, sort glob "$todo/*";
-  } elsif ($todo =~ m/\.[ch]$/) {
-    check_file($todo);
-  }
+open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!";
+while (my $file = <$fh>) {
+    chomp $file;
+    $file =~ s/\s+.*//;
+    next unless $file =~ /\.(?:c|cpp|h|xs|y)\z/ or $file =~ /^perly\./;
+    # OS/2 extensions have never been migrated to ext/, hence the special case:
+    next if $file =~ m!\A(?:ext|dist|cpan|lib|t|os2/OS2)/!
+            && $file !~ m!\Aext/DynaLoader/!;
+    check_file($file);
 }
+close $fh or die $!;
 
 # Standardize messages with variants into the form that appears
 # in perldiag.pod -- useful for things without a diag_listed_as annotation
@@ -210,16 +241,15 @@ sub check_file {
       $sub = $_;
     }
     next if $sub =~ m/^XS/;
-    if (m</\* diag_listed_as: (.*) \*/>) {
+    if (m</\*\s*diag_listed_as: (.*?)\s*\*/>) {
       $listed_as = $1;
       $listed_as_line = $.+1;
     }
     next if /^#/;
-    next if /^ +/;
 
     my $multiline = 0;
     # Loop to accumulate the message text all on one line.
-    if (m/$source_msg_re(?:_nocontext)?\s*\(/) {
+    if (m/(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) {
       while (not m/\);$/) {
         my $nextline = <$codefh>;
         # Means we fell off the end of the file.  Not terribly surprising;
@@ -250,24 +280,55 @@ sub check_file {
     # The %"foo" thing needs to happen *before* this regex.
     # diag($_);
     # DIE is just return Perl_die
-    my ($name, $category);
+    my ($name, $category, $routine);
     if (/$source_msg_call_re/) {
-      ($name, $category) = ($+{'text'}, $+{'category'});
+      ($name, $category, $routine) = ($+{'text'}, $+{'category'}, $+{'routine'});
+      # Sometimes the regexp will pick up too much for the category
+      # e.g., WARN_UNINITIALIZED), PL_warn_uninit_sv ... up to the next )
+      $category && $category =~ s/\).*//s;
     }
     elsif (/$bad_version_re/) {
       ($name, $category) = ($+{'text'}, undef);
     }
+    elsif (/$regcomp_fail_re/) {
+      #  FAIL("foo") -> "foo in regex m/%s/"
+      # vFAIL("foo") -> "foo in regex; marked by <-- HERE in m/%s/"
+      ($name, $category) = ($+{'text'}, undef);
+      $name .=
+        " in regex" . ("; marked by <-- HERE in" x /vFAIL/) . " m/%s/";
+    }
+    elsif (/$regcomp_call_re/) {
+      # vWARN/ckWARNreg("foo") -> "foo in regex; marked by <-- HERE in m/%s/
+      ($name, $category, $routine) = ($+{'text'}, undef, $+{'routine'});
+      $name .= " in regex; marked by <-- HERE in m/%s/";
+      $category = 'WARN_REGEXP';
+      if ($routine =~ /dep/) {
+        $category .= ',WARN_DEPRECATED';
+      }
+    }
     else {
       next;
     }
 
-    my $severity = {croak => [qw/P F/],
-                      die   => [qw/P F/],
-                      warn  => [qw/W D S/],
-                     }->{$+{'routine'}||'die'};
-    my @categories;
+    # Try to guess what the severity should be.  In the case of
+    # Perl_ck_warner and other _ck_ functions, we can tell whether it is
+    # a severe/default warning or no by the _d suffix.  In the case of
+    # other warn functions we cannot tell, because Perl_warner may be pre-
+    # ceded by if(ckWARN) or if(ckWARN_d).
+    my $severity = !$routine                   ? '[PFX]'
+                 :  $routine =~ /warn.*_d\z/   ? '[DS]'
+                 :  $routine =~ /ck_warn/      ?  'W'
+                 :  $routine =~ /warn/         ? '[WDS]'
+                 :  $routine =~ /ckWARN.*dep/  ?  'D'
+                 :  $routine =~ /ckWARN\d*reg/ ?  'W'
+                 :  $routine =~ /vWARN\d/      ? '[WDS]'
+                 :                             '[PFX]';
+    my $categories;
     if (defined $category) {
-      @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category;
+      $category =~ s/__/::/g;
+      $categories =
+        join ", ",
+              sort map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category;
     }
     if ($listed_as and $listed_as_line == $. - $multiline) {
       $name = $listed_as;
@@ -298,25 +359,39 @@ sub check_file {
     # inside an #if 0 block.
     next if $name eq 'SKIPME';
 
-    check_message(standardize($name),$codefn);
+    next if $name=~/\[TESTING\]/; # ignore these as they are works in progress
+
+    check_message(standardize($name),$codefn,$severity,$categories);
   }
 }
 
 sub check_message {
-    my($name,$codefn,$partial) = @_;
+    my($name,$codefn,$severity,$categories,$partial) = @_;
     my $key = $name =~ y/\n/ /r;
     my $ret;
 
+    # Try to reduce printf() formats to simplest forms
+    # Really this should be matching %s, etc like diagnostics.pm does
+
+    # Kill flags
+    $key =~ s/%[#0\-+]/%/g;
+
+    # Kill width
+    $key =~ s/\%(\d+|\*)/%/g;
+
+    # Kill precision
+    $key =~ s/\%\.(\d+|\*)/%/g;
+
     if (exists $entries{$key}) {
       $ret = 1;
       if ( $entries{$key}{seen}++ ) {
         # no need to repeat entries we've tested
-      } elsif ($entries{$name}{todo}) {
+      } elsif ($entries{$key}{todo}) {
         TODO: {
           no warnings 'once';
           local $::TODO = 'in DATA';
           # There is no listing, but it is in the list of exceptions.  TODO FAIL.
-          fail($name);
+          fail($key);
           diag(
             "    Message '$name'\n    from $codefn line $. is not listed in $pod\n".
             "    (but it wasn't documented in 5.10 either, so marking it TODO)."
@@ -325,6 +400,25 @@ sub check_message {
       } else {
         # We found an actual valid entry in perldiag.pod for this error.
         pass($key);
+
+        # Now check the category and severity
+
+        # Cache our severity qr thingies
+        use 5.01;
+        state %qrs;
+        my $qr = $qrs{$severity} ||= qr/$severity/;
+
+        return $ret
+          if $entries{$key}{cattodo};
+
+        like $entries{$key}{severity}, $qr,
+          $severity =~ /\[/
+            ? "severity is one of $severity for $key"
+            : "severity is $severity for $key";
+
+        is $entries{$key}{category}, $categories,
+           ($categories ? "categories are [$categories]" : "no category")
+             . " for $key";
       }
       # Later, should start checking that the severity is correct, too.
     } elsif ($partial) {
@@ -333,7 +427,8 @@ sub check_message {
       my $ok;
       if ($name =~ /\n/) {
         $ok = 1;
-        check_message($_,$codefn,1) or $ok = 0, last for split /\n/, $name;
+        check_message($_,$codefn,$severity,$categories,1) or $ok = 0, last
+          for split /\n/, $name;
       }
       if ($ok) {
         # noop
@@ -364,19 +459,28 @@ sub check_message {
 # PLEASE DO NOT ADD TO THIS LIST.  Instead, write an entry in
 # pod/perldiag.pod for your new (warning|error).
 
+# Entries after __CATEGORIES__ are those that are in perldiag but fail the
+# severity/category test.
+
 # Also FIXME this test, as the first entry in TODO *is* covered by the
 # description: Malformed UTF-8 character (%s)
 __DATA__
 Malformed UTF-8 character (unexpected non-continuation byte 0x%x, immediately after start byte 0x%x)
 
-%s (%d) does not match %s (%d),
-%s (%d) smaller than %s (%d),
+'%c' allowed only after types %s in %s
 bad top format reference
+Cannot apply "%s" in non-PerlIO perl
+Can't %s big-endian %ss on this
+Can't call mro_isa_changed_in() on anonymous symbol table
+Can't call mro_method_changed_in() on anonymous symbol table
 Can't coerce readonly %s to string
 Can't coerce readonly %s to string in %s
+Can't find string terminator %c%s%c anywhere before EOF
 Can't fix broken locale name "%s"
 Can't get short module name from a handle
 Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)
+Can't pipe "%s": %s
+Can't spawn: %s
 Can't spawn "%s": %s
 Can't %s script `%s' with ARGV[0] being `%s'
 Can't %s "%s": %s
@@ -384,28 +488,43 @@ Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
 Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use
 \%c better written as $%c
 Character(s) in '%c' format wrapped in %s
+chown not implemented!
+clear %s
 Code missing after '/' in pack
 Code missing after '/' in unpack
-Corrupted regexp opcode %d > %d
 '%c' outside of string in pack
 Debug leaking scalars child failed%s with errno %d: %s
+'/' does not take a repeat count in %s
+Don't know how to get file name
 Don't know how to handle magic of type \%o
 -Dp not implemented on this platform
 Error reading "%s": %s
+execl not implemented!
+EVAL without pos change exceeded limit in regex
 Filehandle opened only for %sput
 Filehandle %s opened only for %sput
 Filehandle STD%s reopened as %s only for input
+filter_del can only delete in reverse order (currently)
 YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!
+fork() not implemented!
+free %s
 Free to wrong pool %p not %p
 get %s %p %p %p
+gethostent not implemented!
+getpwnam returned invalid UIC %o for user "%s"
 glob failed (can't start child: %s)
 glob failed (child exited with status %d%s)
 Goto undefined subroutine
 Goto undefined subroutine &%s
+Got signal %d
+()-group starts with a count in %s
+Illegal binary digit '%c' ignored
 Illegal character %sin prototype for %s : %s
-Integer overflow in version %d
+Illegal hexadecimal digit '%c' ignored
+Illegal octal digit '%c' ignored
+Infinite recursion in regex
 internal %<num>p might conflict with future printf extensions
-invalid control request: '\%o'
+Invalid argument to sv_cat_decode
 Invalid range "%c-%c" in transliteration operator
 Invalid separator character %c%c%c in PerlIO layer specification %s
 Invalid TOKEN object ignored
@@ -413,24 +532,46 @@ Invalid type '%c' in pack
 Invalid type '%c' in %s
 Invalid type '%c' in unpack
 Invalid type ',' in %s
+ioctlsocket not implemented!
 'j' not supported on this platform
 'J' not supported on this platform
+killpg not implemented!
+length() used on %s (did you mean "scalar(%s)"?)
+length() used on %hash (did you mean "scalar(keys %hash)"?)
+length() used on @array (did you mean "scalar(@array)"?)
+List form of pipe open not implemented
+Malformed integer in [] in %s
 Malformed UTF-8 character (fatal)
 Missing (suid) fd script name
 More than one argument to open
 More than one argument to open(,':%s')
 mprotect for %p %u failed with %d
 mprotect RW for %p %u failed with %d
+No %s allowed while running setgid
+No %s allowed with (suid) fdscript
+No such class field "%s"
 Not an XSUB reference
 Operator or semicolon missing before %c%s
+Pattern subroutine nesting without pos change exceeded limit in regex
 Perl %s required--this is only %s, stopped
+PerlApp::TextQuery: no arguments, please
+POSIX syntax [%c %c] is reserved for future extensions in regex; marked by <-- HERE in m/%s/
 ptr wrong %p != %p fl=%x nl=%p e=%p for %d
 Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
+Regexp modifier "%c" may appear a maximum of twice in regex; marked by <-- HERE in m/%s/
+Regexp modifier "%c" may not appear twice in regex; marked by <-- HERE in m/%s/
+Regexp modifiers "%c" and "%c" are mutually exclusive in regex; marked by <-- HERE in m/%s/
+Regexp *+ operand could be empty in regex; marked by <-- HERE in m/%s/
+Repeated format line will never terminate (~~ and @#)
 Reversed %c= operator
-Runaway prototype
 %s(%f) failed
-%sCompilation failed in regexp
 %sCompilation failed in require
+Sequence (?%c...) not implemented in regex; marked by <-- HERE in m/%s/
+Sequence (%s...) not recognized in regex; marked by <-- HERE in m/%s/
+Sequence %s... not terminated in regex; marked by <-- HERE in m/%s/
+Sequence (?%c... not terminated in regex; marked by <-- HERE in m/%s/
+Sequence (?(%c... not terminated in regex; marked by <-- HERE in m/%s/
+Sequence (?R) not terminated in regex m/%s/
 set %s %p %p %p
 %s free() ignored (RMAGIC, PERL_CORE)
 %s has too many errors.
@@ -438,15 +579,20 @@ SIG%s handler "%s" not defined.
 %s in %s
 Size magic not implemented
 %s number > %s non-portable
-%s object version %s does not match %s %s
 %srealloc() %signored
-%s has too many errors.
+%s in regex m/%s/
 %s on %s %s
-%s on %s %s %s
+socketpair not implemented!
 Starting Full Screen process with flag=%d, mytype=%d
 Starting PM process with flag=%d, mytype=%d
+sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%f U_V is 0x%x, IV_MAX is 0x%x
 SWASHNEW didn't return an HV ref
+switching effective gid is not implemented
+switching effective uid is not implemented
+System V IPC is not implemented on this machine
 -T and -B not implemented on filehandles
+Terminating on signal SIG%s(%d)
+The crypt() function is not implemented on NetWare
 The flock() function is not implemented on NetWare
 The rewinddir() function is not implemented on NetWare
 The seekdir() function is not implemented on NetWare
@@ -454,22 +600,49 @@ The telldir() function is not implemented on NetWare
 Too deeply nested ()-groups in %s
 Too many args on %s line of "%s"
 U0 mode on a byte string
-Undefined top format called
+unable to find VMSPIPE.COM for i/o piping
+Unknown Unicode option value %d
+Unrecognized character %s; marked by <-- HERE after %s<-- HERE near column %d
 Unstable directory path, current directory changed unexpectedly
 Unterminated compressed integer in unpack
+Unterminated \g... pattern in regex; marked by <-- HERE in m/%s/
 Usage: CODE(0x%x)(%s)
 Usage: %s(%s)
 Usage: %s::%s(%s)
+Usage: File::Copy::rmscopy(from,to[,date_flag])
+Usage: VMS::Filespec::candelete(spec)
+Usage: VMS::Filespec::fileify(spec)
+Usage: VMS::Filespec::pathify(spec)
+Usage: VMS::Filespec::rmsexpand(spec[,defspec])
+Usage: VMS::Filespec::unixify(spec)
+Usage: VMS::Filespec::unixpath(spec)
 Usage: VMS::Filespec::unixrealpath(spec)
+Usage: VMS::Filespec::vmsify(spec)
+Usage: VMS::Filespec::vmspath(spec)
 Usage: VMS::Filespec::vmsrealpath(spec)
 Use of inherited AUTOLOAD for non-method %s::%s() is deprecated
 utf8 "\x%X" does not map to Unicode
 Value of logical "%s" too long. Truncating to %i bytes
-value of node is %d in Offset macro
-Variable "%c%s" is not imported
+waitpid: process %x is not a child of process %x
 Wide character
 Wide character in $/
-Wide character in print
+Within []-length '*' not allowed in %s
 Within []-length '%c' not allowed in %s
 Wrong syntax (suid) fd script name "%s"
+'X' outside of string in %s
 'X' outside of string in unpack
+
+__CATEGORIES__
+Code point 0x%X is not Unicode, all \p{} matches fail; all \P{} matches succeed
+Code point 0x%X is not Unicode, may not be portable
+Illegal character \%o (carriage return)
+Missing argument in %s
+Unicode non-character U+%X is illegal for open interchange
+Operation "%s" returns its argument for non-Unicode code point 0x%X
+Operation "%s" returns its argument for UTF-16 surrogate U+%X
+Unicode surrogate U+%X is illegal in UTF-8
+UTF-16 surrogate U+%X
+False [] range "%s" in regex; marked by <-- HERE in m/%s/
+\N{} in character class restricted to one character in regex; marked by <-- HERE in m/%s/
+Zero length \N{} in regex; marked by <-- HERE in m/%s/
+Expecting '(?flags:(?[...' in regex; marked by <-- HERE in m/%s/
diff --git a/gnu/usr.bin/perl/t/porting/exec-bit.t b/gnu/usr.bin/perl/t/porting/exec-bit.t
index 718c81dabcf..1deb376c379 100644
--- a/gnu/usr.bin/perl/t/porting/exec-bit.t
+++ b/gnu/usr.bin/perl/t/porting/exec-bit.t
@@ -5,6 +5,16 @@ use strict;
 # This test checks that anything with an executable bit is
 # identified in Porting/exec-bit.txt to makerel will set
 # the exe bit in the release tarball
+# and that anything with an executable bit also has a shebang
+
+sub has_shebang {
+  my $fname = shift;
+  open my $fh, '<', $fname or die "Can't open '$fname': $!";
+  my $line = <$fh>;
+  close $fh;
+
+  return $line =~ /^\#!\s*([A-Za-z0-9_\-\/\.])+\s?/ ? 1 : 0;
+}
 
 require './test.pl';
 if ( $^O eq "MSWin32" ) {
@@ -22,9 +32,6 @@ if ( $^O eq "vos" ) {
 plan('no_plan');
 
 use ExtUtils::Manifest qw(maniread);
-use File::Basename;
-use File::Find;
-use File::Spec::Functions;
 
 # Copied from Porting/makerel - these will get +x in the tarball
 # XXX refactor? -- dagolden, 2010-07-23
@@ -43,6 +50,8 @@ my @manifest = sort keys %{ maniread("../MANIFEST") };
 for my $f ( map { "../$_" } @manifest ) {
   next unless -x $f;
 
+  ok( has_shebang($f), "File $f has shebang" );
+
   ok( $exe_list{$f}, "tarball will chmod +x $f" )
     or diag( "Remove the exec bit or add '$f' to Porting/exec-bit.txt" );
 
@@ -51,4 +60,3 @@ for my $f ( map { "../$_" } @manifest ) {
 
 ok( ! %exe_list, "Everything in Porting/exec-bit.txt has +x in repo" )
   or diag( "Files missing exec bit:\n  " . join("\n  ", sort keys %exe_list) . "\n");
-
diff --git a/gnu/usr.bin/perl/t/porting/extrefs.t b/gnu/usr.bin/perl/t/porting/extrefs.t
new file mode 100644
index 00000000000..9d4a1d3d143
--- /dev/null
+++ b/gnu/usr.bin/perl/t/porting/extrefs.t
@@ -0,0 +1,128 @@
+#!./perl -w
+
+# What does this test?
+# Test that changes to perl header files don't cause external
+# references by simplying #including them.  This breaks library probe
+# code on CPAN, and can break cflags.SH.
+#
+# Why do we test this?
+# See https://rt.perl.org/rt3/Ticket/Display.html?id=116989
+#
+# It's broken - how do I fix it?
+# You added an initializer or static function to a header file that
+# references some symbol you didn't define, you need to remove it.
+
+BEGIN {
+  require "./test.pl";
+  unshift @INC, ".." if -f "../TestInit.pm";
+}
+
+use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
+use strict;
+use warnings;
+use Config;
+use File::Path 'rmtree';
+use Cwd;
+
+plan(tests => 1);
+
+my $VERBOSE = grep {$_ eq '-v'} @ARGV;
+
+ok(try_compile_and_link(<<'CODE'));
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+  return 0;
+}
+CODE
+
+
+# from Time::HiRes's Makefile.PL with minor modifications
+sub try_compile_and_link {
+    my ($c, %args) = @_;
+
+    my $ld_exeext = ($^O eq 'cygwin' || $^O eq 'MSWin32' ||
+                 $^O eq 'os2' && $Config{ldflags} =~ /-Zexe\b/) ? '.exe' :
+                (($^O eq 'vos') ? $Config{exe_ext} : '');
+
+    my ($ok) = 0;
+    my $tempdir = tempfile();
+    my $cwd = getcwd();
+    mkdir $tempdir;
+    chdir $tempdir;
+    my ($tmp) = "temp";
+
+    my $obj_ext = $Config{obj_ext} || ".o";
+
+    if (open(my $tmpc, ">$tmp.c")) {
+	print $tmpc $c;
+	unless (close($tmpc)) {
+	    chdir($cwd);
+	    rmtree($tempdir);
+	    warn "Failing closing code file: $!\n" if $VERBOSE;
+	    return 0;
+	}
+
+	my $COREincdir = File::Spec->catdir(File::Spec->updir);
+
+	my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir"
+	 . ' -DPERL_NO_INLINE_FUNCTIONS';
+
+	if ($^O eq "MSWin32") {
+	    $ccflags .= " -I../win32 -I../win32/include";
+	}
+
+	my $libs = '';
+
+	# Include libs to be sure of linking against bufferoverflowU.lib for
+	# the SDK2003 compiler on Windows. See win32/Makefile for more details.
+	if ($^O eq "MSWin32" && $Config{cc} =~ /\bcl\b/i) {
+	    $libs = " /link $Config{'libs'}";
+	}
+
+	my $null = File::Spec->devnull;
+
+	my $errornull = $VERBOSE ? '' : ">$null 2>$null";
+
+	# Darwin g++ 4.2.1 is fussy and demands a space.
+	# FreeBSD g++ 4.2.1 does not.
+	# We do not know the reaction of either to the presence of brown M&Ms.
+	my $out_opt = "-o ";
+	if ($^O eq "MSWin32" && $Config{cc} =~ /\bcl\b/i) {
+	    $out_opt = "/Fe";
+	}
+
+	my $tmp_exe = "$tmp$ld_exeext";
+
+        my $cccmd = "$Config{'cc'} $out_opt$tmp_exe $ccflags $tmp.c $libs $errornull";
+
+	if ($^O eq 'VMS') {
+            $cccmd = "$Config{'cc'} /include=($COREincdir) $tmp.c";
+        }
+
+       if ($^O eq 'VMS') {
+	    open( my $cmdfile, ">$tmp.com" );
+	    print $cmdfile "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n";
+	    print $cmdfile "\$ $cccmd\n";
+	    print $cmdfile "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate
+	    close $cmdfile;
+	    system("\@ $tmp.com");
+	    $ok = $?==0;
+	    chdir($cwd);
+	    rmtree($tempdir);
+        }
+        else
+        {
+	    printf "cccmd = $cccmd\n" if $VERBOSE;
+	    my $res = system($cccmd);
+	    $ok = defined($res) && $res == 0 && -s $tmp_exe && -x _;
+
+	    chdir($cwd);
+	    rmtree($tempdir);
+        }
+    }
+
+    return $ok;
+}
diff --git a/gnu/usr.bin/perl/t/porting/filenames.t b/gnu/usr.bin/perl/t/porting/filenames.t
index 268dd1c8c51..b65ab8e2c9e 100644
--- a/gnu/usr.bin/perl/t/porting/filenames.t
+++ b/gnu/usr.bin/perl/t/porting/filenames.t
@@ -27,12 +27,11 @@ BEGIN {
 }
 
 use strict;
-use File::Spec;
 use File::Basename;
 require './test.pl';
 
 
-my $manifest = File::Spec->catfile(File::Spec->updir(), 'MANIFEST');
+my $manifest = '../MANIFEST';
 
 open my $m, '<', $manifest or die "Can't open '$manifest': $!";
 my @files;
@@ -46,59 +45,38 @@ close $m or die $!;
 
 plan(scalar @files);
 
-for my $file (@files) {
-    validate_file_name($file);
-}
-exit 0;
-
-
-sub validate_file_name {
-    my $path = shift;
-    my $filename = basename $path;
-
-    note("testing $path");
-
-    my @path_components = split('/',$path);
-    pop @path_components; # throw away the filename
+PATHNAME: for my $pathname (@files) {
+    my @path_components = split('/',$pathname);
+    my $filename = pop @path_components;
     for my $component (@path_components) {
-	if ($component =~ /\./) {
-	    fail("no directory components containing '.'");
-	    return;
-	}
-	if (length $component > 32) {
-	    fail("no directory with a name over 32 characters (VOS requirement)");
-	    return;
-	}
+        if ($component =~ /\./) {
+            fail("$pathname has directory components containing '.'");
+            next PATHNAME;
+        }
+        if (length $component > 32) {
+            fail("$pathname has a name over 32 characters (VOS requirement)");
+            next PATHNAME;
+        }
     }
 
 
     if ($filename =~ /^\-/) {
-	fail("filename does not start with -");
-	return;
+        fail("$pathname starts with -");
+            next PATHNAME;
     }
 
     my($before, $after) = split /\./, $filename;
     if (length $before > 39) {
-	fail("filename has 39 or fewer characters before the dot");
-	return;
-    }
-    if ($after) {
-	if (length $after > 39) {
-	    fail("filename has 39 or fewer characters after the dot");
-	    return;
-	}
-    }
-
-    if ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
-	fail("filename has a reserved name");
-	return;
-    }
-
-    if ($filename =~ /\s|\(|\&/) {
-	fail("filename has a reserved character");
-	return;
+        fail("$pathname has more than 39 characters before the dot");
+    } elsif ($after && length $after > 39) {
+        fail("$pathname has more than 39 characters after the dot");
+    } elsif ($filename =~ /^(?:CON|PRN|AUX|NUL|COM[1-9]|LPT[1-9])\./i) {
+        fail("$pathname has a reserved name");
+    } elsif ($filename =~ /\s|\(|\&/) {
+        fail("$pathname has a reserved character");
+    } else {
+        pass("$pathname ok");
     }
-    pass("filename ok");
 }
 
 # EOF
diff --git a/gnu/usr.bin/perl/t/porting/globvar.t b/gnu/usr.bin/perl/t/porting/globvar.t
index 795673b49a7..fd169c74420 100644
--- a/gnu/usr.bin/perl/t/porting/globvar.t
+++ b/gnu/usr.bin/perl/t/porting/globvar.t
@@ -18,6 +18,9 @@ my %skip = map { ("PL_$_", 1) }
 	  watchaddr watchok warn_uninit_sv
      );
 
+$skip{PL_hash_rand_bits}= $skip{PL_hash_rand_bits_enabled}= 1; # we can be compiled without these, so skip testing them
+
+
 my $trial = "nm globals$Config{_o} 2>&1";
 my $yes = `$trial`;
 
@@ -57,13 +60,17 @@ foreach my $file (map {$_ . $Config{_o}} qw(globals regcomp)) {
     close $fh or die "Problem running nm $file";
 }
 
-fail("Attempting to export '$_' which is never defined")
-    foreach sort keys %exported;
+foreach (sort keys %exported) {
+ SKIP: {
+    skip("We dont't export '$_' (Perl not built with this enabled?)",1) if $skip{$_};
+    fail("Attempting to export '$_' which is never defined");
+ }
+}
 
 foreach (sort keys %unexported) {
  SKIP: {
-	skip("We don't export $_", 1) if $skip{$_};
-	fail("$_ is defined, but we do not export it");
+        skip("We don't export '$_'", 1) if $skip{$_};
+        fail("'$_' is defined, but we do not export it");
     }
 }
 
diff --git a/gnu/usr.bin/perl/t/porting/known_pod_issues.dat b/gnu/usr.bin/perl/t/porting/known_pod_issues.dat
index d08d202fd71..53e5797210c 100644
--- a/gnu/usr.bin/perl/t/porting/known_pod_issues.dat
+++ b/gnu/usr.bin/perl/t/porting/known_pod_issues.dat
@@ -18,10 +18,14 @@ Apache::MP3
 Array::Base
 Attribute::Constant
 basename(1)
+Benchmark::Perl::Formance
 ByteLoader
 bzip2(1)
+Carp::Always
 Carp::Assert
+Carp::Clan
 chcp(1)
+Class::Accessor
 Class::C3
 Class::ISA
 Class::PseudoHash
@@ -36,7 +40,9 @@ Date::Pcalc
 DateTime
 DB_File(3)
 DBIx::Profile
+Devel::Callsite
 Devel::DProf
+Devel::DTrace::Provider
 Devel::NYTProf
 Devel::PPPort
 Devel::SawAmpersand
@@ -57,6 +63,7 @@ getpriority(2)
 HTTP::Lite
 inetd(8)
 IPC::Run
+IPC::Signal
 kill(3)
 langinfo(3)
 Lingua::KO::Hangul::Util
@@ -76,17 +83,21 @@ Module::CPANTS::Analyse
 Module::Find
 Module::Info
 Module::Starter
+Moo
+Moose
 MRO::Compat
 nl_langinfo(3)
 Number::Format
+Object::InsideOut
+Object::Tiny
 open(2)
 OS2::Proc
 OS2::WinObject
 PadWalker
 passwd(1)
 perl(1)
-Perl::Unsafe::Signals
 Perl4::CoreLibs
+Perl::Unsafe::Signals
 perlbug(1)
 PerlIO::locale
 PerlIO::Util
@@ -94,6 +105,8 @@ PerlIO::via::Base64
 PerlIO::via::StripHTML
 perllexwarn(1)
 perlthanks
+pod/perldiag.pod        Verbatim line length including indents exceeds 79 by        1
+pod/perlrun.pod        Verbatim line length including indents exceeds 79 by        3
 POD2::FR
 POD2::IT
 pod2ipf(1)
@@ -108,7 +121,9 @@ pstruct
 ptar(1)
 ptargrep(1)
 pwd_mkdb(8)
+Readonly
 recvmsg(3)
+Role::Tiny
 s2p
 Scalar::Readonly
 Semi::Semicolons
@@ -143,6 +158,7 @@ Unicode::Regex::Set
 Unicode::Semantics
 Unicode::Unihan
 unzip(1)
+Version::Requirements
 wait(2)
 waitpid(3)
 wget(1)
@@ -150,29 +166,19 @@ Win32::Locale
 YAML
 YAML::Syck
 YAML::Tiny
-dist/bignum/lib/bigint.pm	Apparent broken link	1
-dist/bignum/lib/bignum.pm	Apparent broken link	1
-dist/bignum/lib/bigrat.pm	Apparent broken link	1
-dist/carp/lib/carp.pm	Apparent broken link	2
-dist/constant/lib/constant.pm	Apparent broken link	2
 dist/cwd/lib/file/spec/vms.pm	Verbatim line length including indents exceeds 79 by	1
 dist/cwd/lib/file/spec/win32.pm	Verbatim line length including indents exceeds 79 by	1
 dist/data-dumper/dumper.pm	? Should you be using L<...> instead of	1
 dist/extutils-parsexs/lib/perlxs.pod	Verbatim line length including indents exceeds 79 by	1
 dist/extutils-parsexs/lib/perlxstut.pod	Verbatim line length including indents exceeds 79 by	10
 dist/filter-simple/lib/filter/simple.pm	Verbatim paragraph in NAME section	1
-dist/locale-maketext/lib/locale/maketext.pod	No items in =over / =back list	1
 dist/locale-maketext/lib/locale/maketext/tpj13.pod	No items in =over / =back list	3
-dist/math-bigint/lib/math/bigfloat.pm	Apparent broken link	1
-dist/math-bigint/lib/math/bigint.pm	Apparent broken link	1
 dist/math-bigint/lib/math/bigint.pm	Verbatim line length including indents exceeds 79 by	77
-dist/math-bigint/lib/math/bigint/calcemu.pm	Apparent broken link	1
 dist/math-bigint/lib/math/bigint/calcemu.pm	empty section in previous paragraph	3
-dist/math-bigrat/lib/math/bigrat.pm	Apparent broken link	3
-dist/math-bigrat/lib/math/bigrat.pm	Apparent internal link is missing its forward slash	1
 dist/math-bigrat/lib/math/bigrat.pm	Verbatim line length including indents exceeds 79 by	7
-dist/module-corelist/blib/script/corelist	Verbatim line length including indents exceeds 79 by	1
+dist/math-bigrat/lib/math/bigrat.pm	unresolved internal link	1
 dist/module-corelist/lib/module/corelist.pod	Verbatim line length including indents exceeds 79 by	4
+dist/module-corelist/lib/module/corelist/utils.pm	Verbatim line length including indents exceeds 79 by	2
 dist/net-ping/lib/net/ping.pm	Verbatim line length including indents exceeds 79 by	2
 dist/safe/safe.pm	Verbatim line length including indents exceeds 79 by	1
 dist/safe/safe.pm	empty section in previous paragraph	1
@@ -181,7 +187,6 @@ dist/storable/storable.pm	Verbatim line length including indents exceeds 79 by	4
 dist/thread-queue/lib/thread/queue.pm	Verbatim line length including indents exceeds 79 by	4
 dist/threads/lib/threads.pm	Verbatim line length including indents exceeds 79 by	3
 dist/tie-file/lib/tie/file.pm	Verbatim line length including indents exceeds 79 by	3
-dist/tie-file/lib/tie/file.pm	unresolved internal link	1
 ext/b/b/concise.pm	Verbatim line length including indents exceeds 79 by	1
 ext/devel-peek/peek.pm	? Should you be using L<...> instead of	2
 ext/devel-peek/peek.pm	Verbatim line length including indents exceeds 79 by	2
@@ -189,28 +194,24 @@ ext/dynaloader/dynaloader.pm	Verbatim line length including indents exceeds 79 b
 ext/file-glob/glob.pm	Verbatim line length including indents exceeds 79 by	15
 ext/hash-util-fieldhash/lib/hash/util/fieldhash.pm	Verbatim line length including indents exceeds 79 by	2
 ext/i18n-langinfo/langinfo.pm	Verbatim line length including indents exceeds 79 by	1
-ext/opcode/opcode.pm	Verbatim line length including indents exceeds 79 by	10
 ext/pod-html/bin/pod2html	Pod NAME already used	1
 ext/pod-html/testdir/perlpodspec-copy.pod	Verbatim line length including indents exceeds 79 by	8
 ext/pod-html/testdir/perlvar-copy.pod	? Should you be using L<...> instead of	3
-ext/pod-html/testdir/perlvar-copy.pod	Apparent broken link	2
 ext/pod-html/testdir/perlvar-copy.pod	Verbatim line length including indents exceeds 79 by	6
-ext/posix/lib/posix.pod	Verbatim line length including indents exceeds 79 by	29
-ext/re/re.pm	Verbatim line length including indents exceeds 79 by	6
+ext/posix/lib/posix.pod	Verbatim line length including indents exceeds 79 by	13
 ext/vms-dclsym/dclsym.pm	? Should you be using L<...> instead of	1
 ext/vms-dclsym/dclsym.pm	Verbatim line length including indents exceeds 79 by	1
 ext/vms-stdio/stdio.pm	Verbatim line length including indents exceeds 79 by	1
 ext/xs-apitest/apitest.pm	Verbatim line length including indents exceeds 79 by	1
 install	? Should you be using F<...> or maybe L<...> instead of	1
-install	Verbatim line length including indents exceeds 79 by	11
 installhtml	Verbatim line length including indents exceeds 79 by	3
 os2/os2/os2-extattr/extattr.pm	? Should you be using F<...> or maybe L<...> instead of	1
 os2/os2/os2-process/process.pm	Verbatim line length including indents exceeds 79 by	27
 os2/os2/os2-rexx/dll/dll.pm	Verbatim line length including indents exceeds 79 by	2
 os2/os2/os2-rexx/rexx.pm	Verbatim line length including indents exceeds 79 by	1
-pod/perl.pod	Verbatim line length including indents exceeds 79 by	9
+pod/perl.pod	Verbatim line length including indents exceeds 79 by	8
 pod/perlaix.pod	Verbatim line length including indents exceeds 79 by	11
-pod/perlapi.pod	? Should you be using L<...> instead of	85
+pod/perlapi.pod	? Should you be using L<...> instead of	76
 pod/perlapi.pod	Verbatim line length including indents exceeds 79 by	6
 pod/perlapi.pod	unresolved internal link	3
 pod/perlapio.pod	Verbatim line length including indents exceeds 79 by	5
@@ -220,48 +221,38 @@ pod/perlce.pod	Verbatim line length including indents exceeds 79 by	2
 pod/perlclib.pod	Verbatim line length including indents exceeds 79 by	3
 pod/perlcygwin.pod	Verbatim line length including indents exceeds 79 by	25
 pod/perldbmfilter.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perldebguts.pod	Verbatim line length including indents exceeds 79 by	68
+pod/perldebguts.pod	Verbatim line length including indents exceeds 79 by	34
 pod/perldebtut.pod	Verbatim line length including indents exceeds 79 by	22
 pod/perldebug.pod	Verbatim line length including indents exceeds 79 by	3
 pod/perldiag.pod	=item type mismatch	1
-pod/perldiag.pod	Apparent broken link	1
+pod/perldiag.pod	Verbatim line length including indents exceeds 79 by	1
 pod/perldsc.pod	Verbatim line length including indents exceeds 79 by	4
-pod/perldtrace.pod	Verbatim line length including indents exceeds 79 by	22
-pod/perlebcdic.pod	Verbatim line length including indents exceeds 79 by	273
+pod/perldtrace.pod	Verbatim line length including indents exceeds 79 by	26
+pod/perlebcdic.pod	Verbatim line length including indents exceeds 79 by	13
 pod/perlembed.pod	Verbatim line length including indents exceeds 79 by	27
 pod/perlfunc.pod	There is more than one target	1
-pod/perlfunc.pod	Verbatim line length including indents exceeds 79 by	167
-pod/perlgit.pod	Verbatim line length including indents exceeds 79 by	11
+pod/perlgit.pod	Verbatim line length including indents exceeds 79 by	12
 pod/perlgpl.pod	Verbatim line length including indents exceeds 79 by	50
 pod/perlguts.pod	? Should you be using F<...> or maybe L<...> instead of	2
 pod/perlguts.pod	? Should you be using L<...> instead of	1
 pod/perlhack.pod	? Should you be using L<...> instead of	1
-pod/perlhack.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlhacktips.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlhist.pod	Verbatim line length including indents exceeds 79 by	2
-pod/perlhpux.pod	Verbatim line length including indents exceeds 79 by	3
+pod/perlhist.pod	Verbatim line length including indents exceeds 79 by	1
+pod/perlhpux.pod	Verbatim line length including indents exceeds 79 by	5
 pod/perlhurd.pod	Verbatim line length including indents exceeds 79 by	2
 pod/perlintern.pod	? Should you be using L<...> instead of	5
 pod/perlinterp.pod	? Should you be using L<...> instead of	1
-pod/perlinterp.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlintro.pod	Verbatim line length including indents exceeds 79 by	11
 pod/perliol.pod	Verbatim line length including indents exceeds 79 by	8
-pod/perlipc.pod	Apparent broken link	1
 pod/perlipc.pod	Verbatim line length including indents exceeds 79 by	19
 pod/perlirix.pod	Verbatim line length including indents exceeds 79 by	4
 pod/perllol.pod	Verbatim line length including indents exceeds 79 by	4
-pod/perlmacosx.pod	Verbatim line length including indents exceeds 79 by	3
+pod/perlmacosx.pod	Verbatim line length including indents exceeds 79 by	4
 pod/perlmod.pod	Verbatim line length including indents exceeds 79 by	2
 pod/perlmodlib.pod	Verbatim line length including indents exceeds 79 by	3
 pod/perlmodstyle.pod	Verbatim line length including indents exceeds 79 by	2
-pod/perlmpeix.pod	Verbatim line length including indents exceeds 79 by	2
 pod/perlmroapi.pod	? Should you be using L<...> instead of	1
 pod/perlnetware.pod	Verbatim line length including indents exceeds 79 by	4
 pod/perlnewmod.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlobj.pod	Apparent broken link	1
 pod/perlootut.pod	? Should you be using F<...> or maybe L<...> instead of	1
-pod/perlootut.pod	Apparent internal link is missing its forward slash	16
-pod/perlop.pod	Verbatim line length including indents exceeds 79 by	29
 pod/perlos2.pod	? Should you be using L<...> instead of	2
 pod/perlos2.pod	Verbatim line length including indents exceeds 79 by	22
 pod/perlos390.pod	Verbatim line length including indents exceeds 79 by	11
@@ -269,14 +260,10 @@ pod/perlpacktut.pod	Verbatim line length including indents exceeds 79 by	6
 pod/perlperf.pod	Verbatim line length including indents exceeds 79 by	154
 pod/perlpodspec.pod	Verbatim line length including indents exceeds 79 by	9
 pod/perlpodstyle.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlreapi.pod	Verbatim line length including indents exceeds 79 by	17
-pod/perlrebackslash.pod	Verbatim line length including indents exceeds 79 by	1
 pod/perlref.pod	Verbatim line length including indents exceeds 79 by	1
-pod/perlreguts.pod	Verbatim line length including indents exceeds 79 by	17
 pod/perlrequick.pod	Verbatim line length including indents exceeds 79 by	3
 pod/perlretut.pod	Verbatim line length including indents exceeds 79 by	13
-pod/perlrun.pod	Verbatim line length including indents exceeds 79 by	2
-pod/perlsec.pod	Verbatim line length including indents exceeds 79 by	1
+pod/perlrun.pod	Verbatim line length including indents exceeds 79 by	3
 pod/perlsolaris.pod	Verbatim line length including indents exceeds 79 by	14
 pod/perlsource.pod	? Should you be using F<...> or maybe L<...> instead of	1
 pod/perlsub.pod	? Should you be using F<...> or maybe L<...> instead of	3
@@ -285,7 +272,6 @@ pod/perlsymbian.pod	Verbatim line length including indents exceeds 79 by	20
 pod/perlthrtut.pod	Verbatim line length including indents exceeds 79 by	5
 pod/perltie.pod	Verbatim line length including indents exceeds 79 by	13
 pod/perltrap.pod	? Should you be using F<...> or maybe L<...> instead of	1
-pod/perltrap.pod	Verbatim line length including indents exceeds 79 by	15
 pod/perltru64.pod	? Should you be using F<...> or maybe L<...> instead of	1
 pod/perltru64.pod	Verbatim line length including indents exceeds 79 by	4
 pod/perlunifaq.pod	empty section in previous paragraph	1
@@ -300,11 +286,9 @@ porting/how_to_write_a_perldelta.pod	Verbatim line length including indents exce
 porting/pumpkin.pod	Verbatim line length including indents exceeds 79 by	9
 porting/release_managers_guide.pod	Verbatim line length including indents exceeds 79 by	7
 porting/release_schedule.pod	There is no NAME	1
-porting/todo.pod	Apparent broken link	1
 porting/todo.pod	Verbatim line length including indents exceeds 79 by	7
 symbian/perlutil.pod	Verbatim line length including indents exceeds 79 by	4
 utils/c2ph	Verbatim line length including indents exceeds 79 by	44
-utils/libnetcfg	Apparent broken link	1
 utils/pod2html	Pod NAME already used	1
 vms/ext/filespec.pm	Verbatim line length including indents exceeds 79 by	1
 x2p/a2p.pod	empty section in previous paragraph	2
@@ -312,9 +296,6 @@ lib/benchmark.pm	Verbatim line length including indents exceeds 79 by	4
 lib/class/struct.pm	Verbatim line length including indents exceeds 79 by	7
 lib/config.pod	? Should you be using L<...> instead of	-1
 lib/config.pod	nested commands F<...F<...>...>	3
-lib/cpan/debug.pm	There is no NAME	1
-lib/cpan/handleconfig.pm	=head2 without preceding higher level	1
-lib/cpan/handleconfig.pm	There is no NAME	1
 lib/db.pm	Verbatim line length including indents exceeds 79 by	2
 lib/dbm_filter.pm	Verbatim line length including indents exceeds 79 by	1
 lib/dbm_filter/compress.pm	Verbatim line length including indents exceeds 79 by	1
@@ -324,7 +305,6 @@ lib/dbm_filter/null.pm	Verbatim line length including indents exceeds 79 by	1
 lib/dbm_filter/utf8.pm	Verbatim line length including indents exceeds 79 by	1
 lib/deprecate.pm	Verbatim line length including indents exceeds 79 by	2
 lib/english.pm	Verbatim line length including indents exceeds 79 by	1
-lib/exporter.pm	Verbatim line length including indents exceeds 79 by	2
 lib/extutils/embed.pm	Verbatim line length including indents exceeds 79 by	2
 lib/extutils/xssymset.pm	Verbatim line length including indents exceeds 79 by	1
 lib/file/basename.pm	Verbatim line length including indents exceeds 79 by	2
diff --git a/gnu/usr.bin/perl/t/porting/maintainers.t b/gnu/usr.bin/perl/t/porting/maintainers.t
index f5edaa86938..3744081cd93 100755
--- a/gnu/usr.bin/perl/t/porting/maintainers.t
+++ b/gnu/usr.bin/perl/t/porting/maintainers.t
@@ -11,6 +11,7 @@ BEGIN {
 
     chdir '..' unless -d 't';
     @INC = qw(lib Porting);
+    require './t/test.pl';
 }
 
 use strict;
@@ -18,8 +19,7 @@ use warnings;
 use Maintainers qw(show_results process_options finish_tap_output);
 
 if ($^O eq 'VMS') {
-    print "1..0 # Skip: home-grown glob doesn't handle fancy patterns\n";
-    exit 0;
+    skip_all "home-grown glob doesn't handle fancy patterns";
 }
 
 {
diff --git a/gnu/usr.bin/perl/t/porting/manifest.t b/gnu/usr.bin/perl/t/porting/manifest.t
index 068540c983c..ea4fe832d79 100755
--- a/gnu/usr.bin/perl/t/porting/manifest.t
+++ b/gnu/usr.bin/perl/t/porting/manifest.t
@@ -5,7 +5,7 @@
 BEGIN {
     @INC = '..' if -f '../TestInit.pm';
 }
-use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
+use TestInit qw(T); # T is chdir to the top level
 
 require 't/test.pl';
 
diff --git a/gnu/usr.bin/perl/t/porting/pending-author.t b/gnu/usr.bin/perl/t/porting/pending-author.t
index 6bc392b35c6..0cb40545294 100644
--- a/gnu/usr.bin/perl/t/porting/pending-author.t
+++ b/gnu/usr.bin/perl/t/porting/pending-author.t
@@ -23,7 +23,7 @@
 BEGIN {
     @INC = '..' if -f '../TestInit.pm';
 }
-use TestInit qw(T A); # T is chdir to the top level, A makes paths absolute
+use TestInit qw(T); # T is chdir to the top level
 use strict;
 
 require 't/test.pl';
@@ -43,9 +43,7 @@ sub get {
     my $key = shift;
     my $value = `git config --get user.$key`;
     unless (defined $value && $value =~ /\S/) {
-	plan(1);
-	like($value, qr/\S/, "git config --get user.$key returned a value");
-	exit 1;
+	skip_all("git config --get user.$key returned nought");
     }
     chomp $value;
     return $value;
diff --git a/gnu/usr.bin/perl/t/porting/podcheck.t b/gnu/usr.bin/perl/t/porting/podcheck.t
index def6615338a..9864af621c3 100755
--- a/gnu/usr.bin/perl/t/porting/podcheck.t
+++ b/gnu/usr.bin/perl/t/porting/podcheck.t
@@ -399,6 +399,8 @@ my $non_pods = qr/ (?: \.
                            | $lib_ext # object libraries
                            | $lib_so  # shared libraries
                            | $dl_ext  # dynamic libraries
+                           | gif      # GIF images (example files from CGI.pm)
+                           | eg       # examples from libnet
                        )
                        $
                     ) | ~$ | \ \(Autosaved\)\.txt$ # Other editor droppings
@@ -456,7 +458,8 @@ sub suppressed {
 
     sub plan {
         my %plan = @_;
-        $planned = $plan{tests};
+        $planned = $plan{tests} + 1;    # +1 for final test that files haven't
+                                        # been removed
         print "1..$planned\n";
         return;
     }
@@ -470,7 +473,7 @@ sub suppressed {
         $current_test++;
         print "not " unless $success;
         print "ok $current_test - $message\n";
-        return;
+        return $success;
     }
 
     sub skip {
@@ -1034,6 +1037,27 @@ package My::Pod::Checker {      # Extend Pod::Checker
         delete $problems{$self->get_filename};
         return;
     }
+
+    sub parse_from_file {
+        # This overrides the super class method so that if an open fails on a
+        # transitory file, it doesn't croak.  It returns 1 if it did find the
+        # file, 0 if it didn't
+
+        my $self = shift;
+        my $filename = shift;
+        # ignores 2nd param, which is output file.  Always uses undef
+
+        if (open my $in_fh, '<:bytes', $filename) {
+            $self->SUPER::parse_from_filehandle($in_fh, undef);
+            close $in_fh;
+            return 1;
+        }
+
+        # If couldn't open file, perhaps it was transitory, and hence not an error
+        return 0 unless -e $filename;
+
+        die "Can't open '$filename': $!\n";
+    }
 }
 
 package Tie_Array_to_FH {  # So printing actually goes to an array
@@ -1227,7 +1251,8 @@ sub my_safer_print {    # print, with error checking for outputting to db
     }
 }
 
-sub extract_pod {   # Extracts just the pod from a file
+sub extract_pod {   # Extracts just the pod from a file; returns undef if file
+                    # doesn't exist
     my $filename = shift;
 
     my @pod;
@@ -1235,30 +1260,33 @@ sub extract_pod {   # Extracts just the pod from a file
     # Arrange for the output of Pod::Parser to be collected in an array we can
     # look at instead of being printed
     tie *ALREADY_FH, 'Tie_Array_to_FH', \@pod;
-    open my $in_fh, '<:bytes', $filename
+    if (open my $in_fh, '<:bytes', $filename) {
+        my $parser = Pod::Parser->new();
+        $parser->parse_from_filehandle($in_fh, *ALREADY_FH);
+        close $in_fh;
 
-        # The file should already have been opened once to get here, so if
-        # fails, just die.  It's possible that a transitory file containing a
-        # pod would get here, but not bothering to add code for that very
-        # unlikely event.
-        or die "Can't open '$filename': $!\n";
-
-    my $parser = Pod::Parser->new();
-    $parser->parse_from_filehandle($in_fh, *ALREADY_FH);
-    close $in_fh;
+        return join "", @pod
+    }
 
-    return join "", @pod
+    # The file should already have been opened once to get here, so if that
+    # fails, something is wrong.  It's possible that a transitory file
+    # containing a pod would get here, so if the file no longer exists just
+    # return undef.
+    return unless -e $filename;
+    die "Can't open '$filename': $!\n";
 }
 
 my $digest = Digest->new($digest_type);
 
+# This is used as a callback from File::Find::find(), which always constructs
+# pathnames using Unix separators
 sub is_pod_file {
     # If $_ is a pod file, add it to the lists and do other prep work.
 
     if (-d) {
         # Don't look at files in directories that are for tests, nor those
         # beginning with a dot
-        if ($_ eq 't' || $_ =~ /^\../) {
+        if (m!/t\z! || m!/\.!) {
             $File::Find::prune = 1;
         }
         return;
@@ -1268,8 +1296,9 @@ sub is_pod_file {
                                # check if 0 length
     return unless -f || -l;    # Weird file types won't be pods
 
-    if ($_ =~ /^\./           # No hidden Unix files
-        || $_ =~ $non_pods) {
+    my ($leaf) = m!([^/]+)\z!;
+    if (m!/\.!                 # No hidden Unix files
+        || $leaf =~ $non_pods) {
         note("Not considering $_") if DEBUG;
         return;
     }
@@ -1277,8 +1306,7 @@ sub is_pod_file {
     my $filename = $File::Find::name;
 
     # $filename is relative, like './path'.  Strip that initial part away.
-    # Assumes that the path separator is exactly one character.
-    $filename =~ s/^\..//;
+    $filename =~ s!^\./!! or die 'Unexpected pathname "$filename"';
 
     return if $excluded_files{canonicalize($filename)};
 
@@ -1393,7 +1421,7 @@ else { # No input files -- go find all the possibilities.
     chdir File::Spec->updir;
 
     # And look in this directory and all its subdirectories
-    find( \&is_pod_file, '.');
+    find( {wanted => \&is_pod_file, no_chdir => 1}, '.');
 
     # Add ourselves to the test
     push @files, "t/porting/podcheck.t";
@@ -1448,6 +1476,7 @@ plan (tests => scalar @files) if ! $regen;
             @files;
 
 # Now go through all the files and parse them
+FILE:
 foreach my $filename (@files) {
     my $parsed = 0;
     note("parsing $filename") if DEBUG;
@@ -1464,8 +1493,12 @@ foreach my $filename (@files) {
     # We have set the name in the checker object if there is a possibility
     # that no further parsing is necessary, but otherwise do the parsing now.
     if (! $checker->name) {
+        if (! $checker->parse_from_file($filename, undef)) {
+            $checker->set_skip("$filename is transitory");
+            next FILE;
+        }
         $parsed = 1;
-        $checker->parse_from_file($filename, undef);
+
     }
 
     if ($checker->num_errors() < 0) {   # Returns negative if not a pod
@@ -1484,7 +1517,12 @@ foreach my $filename (@files) {
         }
         else {
             my $digest = Digest->new($digest_type);
-            $digest->add(extract_pod($filename));
+            my $contents = extract_pod($filename);
+
+            # If the return is undef, it means that $filename was a transitory
+            # file; skip it.
+            next FILE unless defined $contents;
+            $digest->add($contents);
             $id = $digest->digest;
         }
 
@@ -1510,7 +1548,28 @@ foreach my $filename (@files) {
             # reason, but the pods they contain are identical.  Extract the
             # pods and do the comparisons on just those.
             if (! $same && $name) {
-                $same = extract_pod($prior_filename) eq extract_pod($filename);
+                my $contents = extract_pod($filename);
+
+                # If return is <undef>, it means that $filename no longer
+                # exists.  This means it was a transitory file, and should not
+                # be tested.
+                next FILE unless defined $contents;
+
+                my $prior_contents = extract_pod($prior_filename);
+
+                # If return is <undef>, it means that $prior_filename no
+                # longer exists.  This means it was a transitory file, and
+                # should not have been tested, but we already did process it.
+                # What we should do now is to back-out its records, and
+                # process $filename in its stead.  But backing out is not so
+                # simple, and so I'm (khw) skipping that unless and until
+                # experience shows that it is needed.  We do go process
+                # $filename, and there are potential false positive conflicts
+                # with the transitory $prior_contents, and rerunning the test
+                # should cause it to succeed.
+                goto process_this_pod unless defined $prior_contents;
+
+                $same = $prior_contents eq $contents;
             }
 
             if ($same) {
@@ -1544,9 +1603,11 @@ foreach my $filename (@files) {
 
             # In any event, don't process this pod that has the same name as
             # another.
-            next;
+            next FILE;
         }
 
+    process_this_pod:
+
         # A unique pod.
         $id_to_checker{$id} = $checker;
 
@@ -1557,8 +1618,10 @@ foreach my $filename (@files) {
             if ($filename =~ /^cpan/) {
                 $checker->set_skip("CPAN is upstream for $filename");
             }
-            elsif ($filename =~ /perl\d+delta/ && ! $do_deltas) {
-                $checker->set_skip("$filename is a stable perldelta");
+            elsif ($filename =~ /perl\d+delta/) {
+                if (! $do_deltas) {
+                    $checker->set_skip("$filename is a stable perldelta");
+                }
             }
             elsif ($filename =~ /perltoc/) {
                 $checker->set_skip("$filename dependent on component pods");
@@ -1578,7 +1641,7 @@ foreach my $filename (@files) {
             $checker->poderror( { -msg => $no_name,
                                   -line => '???'
                                 });
-            next;
+            next FILE;
         }
 
         # For skipped files, just get its NAME
@@ -1587,14 +1650,17 @@ foreach my $filename (@files) {
         {
             $checker->node($name) if $name;
         }
-        else {
-            $checker->parse_from_file($filename, undef) if ! $parsed;
+        elsif (! $parsed) {
+            if (! $checker->parse_from_file($filename, undef)) {
+                $checker->set_skip("$filename is transitory");
+                next FILE;
+            }
         }
 
         # Go through everything in the file that could be an anchor that
         # could be a link target.  Count how many there are of the same name.
         foreach my $node ($checker->linkable_nodes) {
-            next if ! $node;        # Can be empty is like '=item *'
+            next FILE if ! $node;        # Can be empty is like '=item *'
             if (exists $nodes{$name}{$node}) {
                 $nodes{$name}{$node}++;
             }
@@ -1738,9 +1804,10 @@ foreach my $filename (@files) {
                 # subtract back this number we previously added in.
                 $total_known -= $problem_count;
 
-                $diagnostic .= $indent . $message;
+                $diagnostic .= $indent . qq{"$message"};
                 if ($problem_count > 2) {
-                    $diagnostic .= "  ($problem_count occurrences)";
+                    $diagnostic .= "  ($problem_count occurrences,"
+			. " expected $known_problems{$canonical}{$message})";
                 }
                 foreach my $problem (@{$problems{$filename}{$message}}) {
                     $diagnostic .= " " if $problem_count == 1;
@@ -1776,9 +1843,21 @@ foreach my $filename (@files) {
             note(join "", @diagnostics,
             "See end of this test output for your options on silencing this");
         }
+
+        delete $known_problems{$canonical};
     }
 }
 
+if (! $regen
+    && ! ok (keys %known_problems == 0, "The known problems data base includes no references to non-existent files"))
+{
+    note("The following files were not found: "
+         . join ", ", keys %known_problems);
+    note("They will automatically be removed from the db the next time");
+    note("  cd t; ./perl -I../lib porting/podcheck.t --regen");
+    note("is run");
+}
+
 my $how_to = <<EOF;
    run this test script by hand, using the following formula (on
    Un*x-like machines):
diff --git a/gnu/usr.bin/perl/t/porting/regen.t b/gnu/usr.bin/perl/t/porting/regen.t
index 8595fb05f2f..e127eb0d460 100644
--- a/gnu/usr.bin/perl/t/porting/regen.t
+++ b/gnu/usr.bin/perl/t/porting/regen.t
@@ -16,11 +16,11 @@ if ( $^O eq "VMS" ) {
   skip_all( "- regen.pl needs porting." );
 }
 
-my $in_regen_pl = 22; # I can't see a clean way to calculate this automatically.
+my $in_regen_pl = 23; # I can't see a clean way to calculate this automatically.
 my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h uconfig.h);
-my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl);
+my @progs = qw(regen/regcharclass.pl regen/mk_PL_charclass.pl);
 
-plan (tests => $in_regen_pl + @files + @progs);
+plan (tests => $in_regen_pl + @files + @progs + 2);
 
 OUTER: foreach my $file (@files) {
     open my $fh, '<', $file or die "Can't open $file: $!";
@@ -47,3 +47,7 @@ OUTER: foreach my $file (@files) {
 foreach (@progs, 'regen.pl') {
   system "$^X $_ --tap";
 }
+
+foreach ( '-y', '-j' ) {
+  system "$^X Porting/makemeta --tap $_";
+}
diff --git a/gnu/usr.bin/perl/t/porting/test_bootstrap.t b/gnu/usr.bin/perl/t/porting/test_bootstrap.t
index d07e659dad6..654eaac9990 100755
--- a/gnu/usr.bin/perl/t/porting/test_bootstrap.t
+++ b/gnu/usr.bin/perl/t/porting/test_bootstrap.t
@@ -7,7 +7,10 @@ use strict;
 
 # This regression tests ensures that the rules aren't accidentally overlooked.
 
-require './test.pl';
+BEGIN {
+    chdir 't';
+    require './test.pl';
+}
 
 plan('no_plan');
 
@@ -46,7 +49,17 @@ while (my $file = <$fh>) {
 	unless $file eq 'comp/require.t'
 }
 
-# There are regression tests using test.pl that don't want PL_sawampersand set
+# There are regression tests using test.pl that don't want PL_sawampersand
+# set.  Or at least that was the case until PL_sawampersand was disabled
+# and replaced with copy-on-write.
+
+# We still allow PL_sawampersand to be enabled with
+# -Accflags=-DPERL_SAWAMPERSAND, so when that is defined we can still run
+# these tests.  When it is not enabled, PL_sawampersand makes no observable
+# difference so the tests fail.
+
+require Config;
+exit unless "@{[Config::bincompat_options()]}" =~ /\bPERL_SAWAMPERSAND\b/;
 
 # This very much relies on a bug in the regexp implementation, but for now it's
 # the best way to work out whether PL_sawampersand is true.
diff --git a/gnu/usr.bin/perl/t/porting/utils.t b/gnu/usr.bin/perl/t/porting/utils.t
index 30c02b78930..13a164950b9 100644
--- a/gnu/usr.bin/perl/t/porting/utils.t
+++ b/gnu/usr.bin/perl/t/porting/utils.t
@@ -51,6 +51,7 @@ my @victims = (qw(installman installperl regen_perly.pl));
 my %excuses = (
                'Porting/git-deltatool' => 'Git::Wrapper',
                'Porting/podtidy' => 'Pod::Tidy',
+               'Porting/leakfinder.pl' => 'XS::APItest',
               );
 
 foreach (@maybe) {
diff --git a/gnu/usr.bin/perl/t/re/charset.t b/gnu/usr.bin/perl/t/re/charset.t
index 8d981258a21..a1e3be19ffa 100644
--- a/gnu/usr.bin/perl/t/re/charset.t
+++ b/gnu/usr.bin/perl/t/re/charset.t
@@ -8,6 +8,7 @@ BEGIN {
 
 use strict;
 use warnings;
+use Config;
 
 plan('no_plan');
 
@@ -35,19 +36,24 @@ $testcases{'[:space:]'} = $testcases{'\s'};
 $testcases{'[:word:]'} = $testcases{'\w'};
 
 my @charsets = qw(a d u aa);
-if (! is_miniperl()) {
+if (! is_miniperl() && $Config{d_setlocale}) {
     require POSIX;
     my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
     if ($current_locale eq 'C') {
-        use locale;
 
-        # Some locale implementations don't have the 128-255 characters all
-        # mean nothing.  Skip the locale tests in that situation
+        # test for d_setlocale is repeated here because this one is compile
+        # time, and the one above is run time
+        use if $Config{d_setlocale}, 'locale';
+
+        # Some implementations don't have the 128-255 range characters all
+        # mean nothing under the C locale (an example being VMS).  This is
+        # legal, but since we don't know what the right answers should be,
+        # skip the locale tests in that situation.
         for my $i (128 .. 255) {
-            goto bad_locale if chr($i) =~ /[[:print:]]/;
+            goto untestable_locale if chr($i) =~ /[[:print:]]/;
         }
         push @charsets, 'l';
-    bad_locale:
+    untestable_locale:
     }
 }
 
diff --git a/gnu/usr.bin/perl/t/re/fold_grind.t b/gnu/usr.bin/perl/t/re/fold_grind.t
index e2153e3186f..bb45a699ad6 100644
--- a/gnu/usr.bin/perl/t/re/fold_grind.t
+++ b/gnu/usr.bin/perl/t/re/fold_grind.t
@@ -6,6 +6,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
+    require Config; import Config;
     skip_all_if_miniperl("no dynamic loading on miniperl, no Encode nor POSIX");
 }
 
@@ -74,6 +75,9 @@ sub numerically {
     return $a <=> $b
 }
 
+my $list_all_tests = $ENV{PERL_DEBUG_FULL_TEST} || $DEBUG;
+$| = 1 if $list_all_tests;
+
 # Significant time is saved by not outputting each test but grouping the
 # output into subtests
 my $okays;          # Number of ok's in current subtest
@@ -86,7 +90,7 @@ sub run_test($$$) {
     $debug = "" unless $DEBUG;
     my $res = eval $test;
 
-    if (!$res || $ENV{PERL_DEBUG_FULL_TEST}) {
+    if (!$res || $list_all_tests) {
       # Failed or debug; output the result
       $count++;
       ok($res, "$test; $debug");
@@ -235,28 +239,61 @@ sub add_test($@) {
     push @{$tests{$ord_smallest_from}}, map { ord $_ } @from;
 }
 
-# Read the Unicode rules file and construct inverse mappings from it
+# Get the Unicode rules and construct inverse mappings from them
 
+use Unicode::UCD;
 my $file="../lib/unicore/CaseFolding.txt";
-open my $fh, "<", $file or die "Failed to read '$file': $!";
-
-while (<$fh>) {
-    chomp;
-
-    # Lines look like (though without the initial '#')
-    #0130; F; 0069 0307; # LATIN CAPITAL LETTER I WITH DOT ABOVE
-
-    # Get rid of comments, ignore blank or comment-only lines
-    my $line = $_ =~ s/ (?: \s* \# .* )? $ //rx;
-    next unless length $line;
-    my ($hex_from, $fold_type, @hex_folded) = split /[\s;]+/, $line;
 
-    next if $fold_type eq 'T';  # Perl doesn't do Turkish folding
-    next if $fold_type eq 'S';  # If Unicode's tables are correct, the F
-                                # should be a superset of S
-
-    my $folded_str = pack ("U0U*", map { hex $_ } @hex_folded);
-    push @{$inverse_folds{$folded_str}}, chr hex $hex_from;
+# Use the Unicode data file if we are on an ASCII platform (which its data is
+# for), and it is in the modern format (starting in Unicode 3.1.0) and it is
+# available.  This avoids being affected by potential bugs introduced by other
+# layers of Perl
+if (ord('A') == 65
+    && pack("C*", split /\./, Unicode::UCD::UnicodeVersion()) ge v3.1.0
+    && open my $fh, "<", $file)
+{
+    while (<$fh>) {
+        chomp;
+
+        # Lines look like (though without the initial '#')
+        #0130; F; 0069 0307; # LATIN CAPITAL LETTER I WITH DOT ABOVE
+
+        # Get rid of comments, ignore blank or comment-only lines
+        my $line = $_ =~ s/ (?: \s* \# .* )? $ //rx;
+        next unless length $line;
+        my ($hex_from, $fold_type, @hex_folded) = split /[\s;]+/, $line;
+
+        next if $fold_type =~ / ^ [IT] $/x; # Perl doesn't do Turkish folding
+        next if $fold_type eq 'S';  # If Unicode's tables are correct, the F
+                                    # should be a superset of S
+
+        my $folded_str = pack ("U0U*", map { hex $_ } @hex_folded);
+        push @{$inverse_folds{$folded_str}}, chr hex $hex_from;
+    }
+}
+else {  # Here, can't use the .txt file: read the Unicode rules file and
+        # construct inverse mappings from it
+
+    my ($invlist_ref, $invmap_ref, undef, $default)
+                                    = Unicode::UCD::prop_invmap('Case_Folding');
+    for my $i (0 .. @$invlist_ref - 1 - 1) {
+        next if $invmap_ref->[$i] == $default;
+
+        # Make into an array if not so already, so can treat uniformly below
+        $invmap_ref->[$i] = [ $invmap_ref->[$i] ] if ! ref $invmap_ref->[$i];
+
+        # Each subsequent element of the range requires adjustment of +1 from
+        # the previous element
+        my $adjust = -1;
+        for my $j ($invlist_ref->[$i] .. $invlist_ref->[$i+1] -1) {
+            $adjust++;
+            my $folded_str
+                        = pack "U0U*", map { $_ + $adjust } @{$invmap_ref->[$i]};
+            #note (sprintf "%d: %04X: %s", __LINE__, $j, join " ",
+            #    map { sprintf "%04X", $_  + $adjust } @{$invmap_ref->[$i]});
+            push @{$inverse_folds{$folded_str}}, chr $j;
+        }
+    }
 }
 
 # Analyze the data and generate tests to get adequate test coverage.  We sort
@@ -265,7 +302,8 @@ TO:
 foreach my $to (sort { (length $a == length $b)
                         ? $a cmp $b
                         : length $a <=> length $b
-                    } keys %inverse_folds) {
+                    } keys %inverse_folds)
+{
 
     # Within each fold, sort so that the smallest code points are done first
     @{$inverse_folds{$to}} = sort { $a cmp $b } @{$inverse_folds{$to}};
@@ -363,23 +401,27 @@ sub prefix {
 # It doesn't return pairs like (a, a), (b, b).  Change the slice to an array
 # to do that.  This was just to have fewer tests.
 sub pairs (@) {
-    #print __LINE__, ": ", join(" XXX ", @_), "\n";
+    #print __LINE__, ": ", join(" XXX ", map { sprintf "%04X", $_ } @_), "\n";
     map { prefix $_[$_], @_[0..$_-1, $_+1..$#_] } 0..$#_
 }
 
 my @charsets = qw(d u a aa);
-my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
-if ($current_locale eq 'C') {
-    use locale;
-
-    # Some locale implementations don't have the range 128-255 characters all
-    # mean nothing.  Skip the locale tests in that situation.
-    for my $i (128 .. 255) {
-        my $char = chr($i);
-        goto bad_locale if uc($char) ne $char || lc($char) ne $char;
+if($Config{d_setlocale}) {
+    my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
+    if ($current_locale eq 'C') {
+        require locale; import locale;
+
+        # Some implementations don't have the 128-255 range characters all
+        # mean nothing under the C locale (an example being VMS).  This is
+        # legal, but since we don't know what the right answers should be,
+        # skip the locale tests in that situation.
+        for my $i (128 .. 255) {
+            my $char = chr($i);
+            goto untestable_locale if uc($char) ne $char || lc($char) ne $char;
+        }
+        push @charsets, 'l';
+      untestable_locale:
     }
-    push @charsets, 'l';
-bad_locale:
 }
 
 # Finally ready to do the tests
@@ -600,9 +642,32 @@ foreach my $test (sort { numerically } keys %tests) {
           $eval = "my \$c = \"$lhs\"; my \$p = qr/$rhs|xyz/i$charset;$upgrade_target$upgrade_pattern \$c $op \$p";
           run_test($eval, "", "");
 
+          # Check that works when the folded character follows something that
+          # is quantified.  This test knows the regex code internals to the
+          # extent that it knows this is a potential problem, and that there
+          # are three different types of quantifiers generated: 1) The thing
+          # being quantified matches a single character; 2) it matches more
+          # than one character, but is fixed width; 3) it can match a variable
+          # number of characters.  (It doesn't know that case 3 shouldn't
+          # matter, since it doesn't do anything special for the character
+          # following the quantifier; nor that some of the different
+          # quantifiers execute the same underlying code, as these tests are
+          # quick, and this insulates these tests from changes in the
+          # implementation.)
+          for my $quantifier ('?', '??', '*', '*?', '+', '+?', '{1,2}', '{1,2}?') {
+            $eval = "my \$c = \"_$lhs\"; my \$p = qr/(?$charset:.$quantifier$rhs)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
+            run_test($eval, "", "");
+            $eval = "my \$c = \"__$lhs\"; my \$p = qr/(?$charset:(?:..)$quantifier$rhs)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
+            run_test($eval, "", "");
+            $eval = "my \$c = \"__$lhs\"; my \$p = qr/(?$charset:(?:.|\\R)$quantifier$rhs)/i;$upgrade_target$upgrade_pattern \$c $op \$p";
+            run_test($eval, "", "");
+          }
+
           foreach my $bracketed (0, 1) {   # Put rhs in [...], or not
             next if $bracketed && @pattern != 1;    # bracketed makes these
                                                     # or's instead of a sequence
+            foreach my $optimize_bracketed (0, 1) {
+                next if $optimize_bracketed && ! $bracketed;
             foreach my $inverted (0,1) {
                 next if $inverted && ! $bracketed;  # inversion only valid in [^...]
                 next if $inverted && @target != 1;  # [perl #89750] multi-char
@@ -624,8 +689,9 @@ foreach my $test (sort { numerically } keys %tests) {
                       $rhs .=  $rhs_char;
 
                       # Add a character to the class, so class doesn't get
-                      # optimized out
-                      $rhs .= '_]' if $bracketed;
+                      # optimized out, unless we are testing that optimization
+                      $rhs .= '_' if $optimize_bracketed;
+                      $rhs .= ']' if $bracketed;
                   }
 
                   # Add one of: no capturing parens
@@ -732,7 +798,7 @@ foreach my $test (sort { numerically } keys %tests) {
                           utf8::upgrade($p) if length($upgrade_pattern);
                           my $res = $op ? ($c =~ $p): ($c !~ $p);
 
-                          if (!$res || $ENV{PERL_DEBUG_FULL_TEST}) {
+                          if (!$res || $list_all_tests) {
                             # Failed or debug; output the result
                             $count++;
                             ok($res, "test $count - $desc");
@@ -749,9 +815,10 @@ foreach my $test (sort { numerically } keys %tests) {
               }
             }
           }
+          }
         }
       }
-      unless($ENV{PERL_DEBUG_FULL_TEST}) {
+      unless($list_all_tests) {
         $count++;
         is $okays, $this_iteration, "$okays subtests ok for"
           . " /$charset,"
diff --git a/gnu/usr.bin/perl/t/re/no_utf8_pm.t b/gnu/usr.bin/perl/t/re/no_utf8_pm.t
index 8d49751f315..6595a248b34 100644
--- a/gnu/usr.bin/perl/t/re/no_utf8_pm.t
+++ b/gnu/usr.bin/perl/t/re/no_utf8_pm.t
@@ -1,6 +1,12 @@
 #!./perl
 
-print "1..1\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 1;
 
 # Make sure that case-insensitive matching of any Latin1 chars don't load
 # utf8.pm.  We assume that NULL won't force loading utf8.pm, and since it
@@ -8,5 +14,4 @@ print "1..1\n";
 # a swash if it thought there was one.
 "\0" =~ /[\001-\xFF]/i;
 
-print "not" if exists $INC{"utf8.pm"};
-print "ok 1\n";
+ok(! exists $INC{"utf8.pm"}, 'case insensitive matching of any Latin1 chars does not load utf8.pm');
diff --git a/gnu/usr.bin/perl/t/re/overload.t b/gnu/usr.bin/perl/t/re/overload.t
index 4e99bd3ec66..dba0357a4fa 100644
--- a/gnu/usr.bin/perl/t/re/overload.t
+++ b/gnu/usr.bin/perl/t/re/overload.t
@@ -33,4 +33,234 @@ no  warnings 'syntax';
     is $1, $TAG, "void context //g against overloaded object";
 }
 
+{
+    # an overloaded stringify returning itself shouldn't loop indefinitely
+
+
+    {
+	package Self;
+	use overload q{""} => sub {
+		    return shift;
+		},
+	    fallback => 1;
+    }
+
+    my $obj = bless [], 'Self';
+    my $r = qr/$obj/;
+    pass("self object, 1 arg");
+    $r = qr/foo$obj/;
+    pass("self object, 2 args");
+}
+
+{
+    # [perl #116823]
+    # when overloading regex string constants, a different code path
+    # was taken if the regex was compile-time, leading to overloaded
+    # regex constant string segments not being handled correctly.
+    # They were just treated as OP_CONST strings to be concatted together.
+    # In particular, if the overload returned a regex object, it would
+    # just be stringified rather than having any code blocks processed.
+
+    BEGIN {
+	overload::constant qr => sub {
+	    my ($raw, $cooked, $type) = @_;
+	    return $cooked unless defined $::CONST_QR_CLASS;
+	    if ($type =~ /qq?/) {
+		return bless \$cooked, $::CONST_QR_CLASS;
+	    } else {
+		return $cooked;
+	    }
+	};
+    }
+
+    {
+	# returns a qr// object
+
+	package OL_QR;
+	use overload q{""} => sub {
+		my $re = shift;
+		return qr/(?{ $OL_QR::count++ })$$re/;
+	    },
+	fallback => 1;
+
+    }
+
+    {
+	# returns a string
+
+	package OL_STR;
+	use overload q{""} => sub {
+		my $re = shift;
+		return qq/(?{ \$OL_STR::count++ })$$re/;
+	    },
+	fallback => 1;
+
+    }
+
+    {
+	# returns chr(str)
+
+	package OL_CHR;
+	use overload q{""} => sub {
+		my $chr = shift;
+		return chr($$chr);
+	    },
+	fallback => 1;
+
+    }
+
+
+    my $qr;
+
+    $::CONST_QR_CLASS = 'OL_QR';
+
+    $OL_QR::count = 0;
+    $qr = eval q{ qr/^foo$/; };
+    ok("foo" =~ $qr, "compile-time, OL_QR, single constant segment");
+    is($OL_QR::count, 1, "flag");
+
+    $OL_QR::count = 0;
+    $qr = eval q{ qr/^foo$(?{ $OL_QR::count++ })/; };
+    ok("foo" =~ $qr, "compile-time, OL_QR, multiple constant segments");
+    is($OL_QR::count, 2, "qr2 flag");
+
+
+    # test /foo.../ when foo is given string overloading,
+    # for various permutations of '...'
+
+    $::CONST_QR_CLASS = 'OL_STR';
+
+    for my $has_re_eval (0, 1) {
+	for my $has_qr (0, 1) {
+	    for my $has_code (0, 1) {
+		for my $has_runtime (0, 1) {
+		    for my $has_runtime_code (0, 1) {
+			if ($has_runtime_code) {
+			    next unless $has_runtime;
+			}
+			note( "re_eval=$has_re_eval "
+			    . "qr=$has_qr "
+			    . "code=$has_code "
+			    . "runtime=$has_runtime "
+			    . "runtime_code=$has_runtime_code");
+			my $eval = '';
+			$eval .= q{use re 'eval'; } if $has_re_eval;
+			$eval .= q{$match = $str =~ };
+			$eval .= q{qr} if $has_qr;
+			$eval .= q{/^abc};
+			$eval .= q{(?{$blocks++})} if $has_code;
+			$eval .= q{$runtime} if $has_runtime;
+			$eval .= q{/; 1;};
+
+			my $runtime = q{def};
+			$runtime .= q{(?{$run_blocks++})} if $has_runtime_code;
+
+			my $blocks = 0;
+			my $run_blocks = 0;
+			my $match;
+			my $str = "abc";
+			$str .= "def" if $runtime;
+
+			my $result = eval $eval;
+			my $err = $@;
+			$result = $result ? 1 : 0;
+
+			if (!$has_re_eval) {
+			    is($result, 0, "EVAL: $eval");
+			    like($err, qr/Eval-group not allowed at runtime/,
+				"\$\@:   $eval");
+			    next;
+			}
+
+			is($result, 1, "EVAL: $eval");
+			diag("\$@=[$err]") unless $result;
+
+			is($match, 1, "MATCH: $eval");
+			is($blocks, $has_code, "blocks");
+			is($run_blocks, $has_runtime_code, "run_blocks");
+
+		    }
+		}
+	    }
+	}
+    }
+
+    # if the pattern gets (undetectably in advance) upgraded to utf8
+    # while being concatenated, it could mess up the alignment of the code
+    # blocks, giving rise to 'Eval-group not allowed at runtime' errs.
+
+    $::CONST_QR_CLASS = 'OL_CHR';
+
+    {
+	my $count = 0;
+	is(eval q{ "\x80\x{100}" =~ /128(?{ $count++ })256/ }, 1,
+	    "OL_CHR eval + match");
+	is($count, 1, "OL_CHR count");
+    }
+
+    undef $::CONST_QR_CLASS;
+}
+
+
+{
+    # [perl #115004]
+    # array interpolation within patterns should handle qr overloading
+    # (like it does for scalar vars)
+
+    {
+	package P115004;
+	use overload 'qr' => sub { return  qr/a/ };
+    }
+
+    my $o = bless [], 'P115004';
+    my @a = ($o);
+
+    ok("a" =~ /^$o$/, "qr overloading with scalar var interpolation");
+    ok("a" =~ /^@a$/, "qr overloading with array var interpolation");
+
+}
+
+{
+
+    # if the pattern gets silently re-parsed, ensure that any eval'ed
+    # code blocks get the correct lexical scope. The overloading of
+    # concat, along with the modification of the text of the code block,
+    # ensures that it has to be re-compiled.
+
+    {
+	package OL_MOD;
+	use overload
+	    q{""} => sub { my ($pat) = @_; $pat->[0] },
+	    q{.}  => sub {
+			    my ($a1, $a2) = @_;
+			    $a1 = $a1->[0] if ref $a1;
+			    $a2 = $a2->[0] if ref $a2;
+			    my $s = "$a1$a2";
+			    $s =~ s/x_var/y_var/;
+			    bless [ $s ];
+		     },
+	;
+    }
+
+
+    BEGIN {
+	overload::constant qr => sub { bless [ $_[0] ], 'OL_MOD' };
+    }
+
+    $::x_var  =		# duplicate to avoid 'only used once' warning
+    $::x_var  = "ABC";
+    my $x_var = "abc";
+
+    $::y_var  =		# duplicate to avoid 'only used once' warning
+    $::y_var  = "XYZ";
+    my $y_var    = "xyz";
+
+    use re 'eval';
+    my $a = 'a';
+    ok("xyz"  =~ m{^(??{ $x_var })$},   "OL_MOD");
+    ok("xyza" =~ m{^(??{ $x_var })$a$}, "OL_MOD runtime");
+}
+
+
+
 done_testing();
diff --git a/gnu/usr.bin/perl/t/re/pat_advanced.t b/gnu/usr.bin/perl/t/re/pat_advanced.t
index d82fcf12912..48a37c2c1a2 100755
--- a/gnu/usr.bin/perl/t/re/pat_advanced.t
+++ b/gnu/usr.bin/perl/t/re/pat_advanced.t
@@ -789,6 +789,12 @@ sub run_tests {
     }
 
     {
+        # The second half of RT #114808
+        warning_is(sub {'aa' =~ /.+\x{100}/}, undef,
+                   'utf8-only floating substr, non-utf8 target, no warning');
+    }
+
+    {
         my $message = "qr /.../x";
         my $R = qr / A B C # D E/x;
         ok("ABCDE" =~    $R   && $& eq "ABC", $message);
@@ -829,15 +835,6 @@ sub run_tests {
     }
 
     {
-        # XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
-        # hasn't been crashing. Disable this test until it is fixed properly.
-        # XXX also check what it returns rather than just doing ok(1,...)
-        # split /(?{ split "" })/, "abc";
-        local $::TODO = "Recursive split is still broken";
-        ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
-    }
-
-    {
         ok "\x{100}\n" =~ /\x{100}\n$/, "UTF-8 length cache and fbm_compile";
     }
 
@@ -882,16 +879,16 @@ sub run_tests {
     }
 
     {
-        for (120 .. 130) {
+        for (120 .. 130, 240 .. 260) {
             my $head = 'x' x $_;
             my $message = q [Don't misparse \x{...} in regexp ] .
-                             q [near 127 char EXACT limit];
+                             q [near EXACT char count limit];
             for my $tail ('\x{0061}', '\x{1234}', '\x61') {
                 eval qq{like("$head$tail", qr/$head$tail/, \$message)};
 		is($@, '', $message);
             }
             $message = q [Don't misparse \N{...} in regexp ] .
-                             q [near 127 char EXACT limit];
+                             q [near EXACT char count limit];
             for my $tail ('\N{SNOWFLAKE}') {
                 eval qq {use charnames ':full';
                          like("$head$tail", qr/$head$tail/, \$message)};
@@ -980,13 +977,16 @@ sub run_tests {
         use Cname;
 
         ok 'fooB'  =~ /\N{foo}[\N{B}\N{b}]/, "Passthrough charname";
+        my $name = "foo\xDF";
+        my $result = eval "'A${name}B'  =~ /^A\\N{$name}B\$/";
+        ok !$@ && $result,  "Passthrough charname of non-ASCII, Latin1";
         #
         # Why doesn't must_warn work here?
         #
         my $w;
         local $SIG {__WARN__} = sub {$w .= "@_"};
         eval 'q(xxWxx) =~ /[\N{WARN}]/';
-        ok $w && $w =~ /Using just the first character returned by \\N{} in character class/,
+        ok $w && $w =~ /Using just the first character returned by \\N\{} in character class/,
                  "single character in [\\N{}] warning";
 
         undef $w;
@@ -994,6 +994,16 @@ sub run_tests {
                    "Zerolength charname in charclass doesn't match \\\\0"];
         ok $w && $w =~ /Ignoring zero length/,
                  'Ignoring zero length \N{} in character class warning';
+        undef $w;
+        eval q [ok 'xy' =~ /x[\N{EMPTY-STR} y]/x,
+                    'Empty string charname in [] is ignored; finds a following character'];
+        ok $w && $w =~ /Ignoring zero length/,
+                 'Ignoring zero length \N{} in character class warning';
+        undef $w;
+        eval q [ok 'x ' =~ /x[\N{EMPTY-STR} y]/,
+                    'Empty string charname in [] is ignored; finds a following blank under /x'];
+        ok $w && $w =~ /Ignoring zero length/,
+                 'Ignoring zero length \N{} in character class warning';
 
         ok 'AB'  =~ /(\N{EVIL})/ && $1 eq 'A', 'Charname caching $1';
         ok 'ABC' =~ /(\N{EVIL})/,              'Charname caching $1';
@@ -1004,27 +1014,82 @@ sub run_tests {
         ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/, 'Verify that long string works';
         ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
 
+        eval '/(?[[\N{EMPTY-STR}]])/';
+        ok $@ && $@ =~ /Zero length \\N\{}/;
+
+        undef $w;
+        eval q [is("\N{TOO  MANY SPACES}", "TOO  MANY SPACES", "Multiple spaces in character name works")];
+        like ($w, qr/A sequence of multiple spaces in a charnames alias definition is deprecated/, "... but returns a deprecation warning");
+        eval q [use utf8; is("\N{TOO  MANY SPACES}", "TOO  MANY SPACES", "Same under 'use utf8': they work")];
+        like ($w, qr/A sequence of multiple spaces in a charnames alias definition is deprecated/, "... but return a deprecation warning");
+        {
+            no warnings 'deprecated';
+            undef $w;
+            eval q ["\N{TOO  MANY SPACES}"];
+            ok (! defined $w, "... and no warning if warnings are off");
+            eval q [use utf8; "\N{TOO  MANY SPACES}"];
+            ok (! defined $w, "... same under 'use utf8'");
+        }
+
+        undef $w;
+        eval q [is("\N{TRAILING SPACE }", "TRAILING SPACE ", "Trailing space in character name works")];
+        like ($w, qr/Trailing white-space in a charnames alias definition is deprecated/, "... but returns a deprecation warning");
+        eval q [use utf8; is("\N{TRAILING SPACE }", "TRAILING SPACE ", "Same under 'use utf8': they work")];
+        like ($w, qr/Trailing white-space in a charnames alias definition is deprecated/, "... but returns a deprecation warning");
+        {
+            no warnings 'deprecated';
+            undef $w;
+            eval q ["\N{TRAILING SPACE }"];
+            ok (! defined $w, "... and no warning if warnings are off");
+            eval q [use utf8; "\N{TRAILING SPACE }"];
+            ok (! defined $w, "... same under 'use utf8'");
+        }
+
         # If remove the limitation in regcomp code these should work
         # differently
         undef $w;
         eval q [ok "\N{TOO-LONG-STR}" =~ /^\N{TOO-LONG-STR}$/, 'Verify that what once was too long a string works'];
         eval 'q(syntax error) =~ /\N{MALFORMED}/';
         ok $@ && $@ =~ /Malformed/, 'Verify that malformed utf8 gives an error';
-        undef $w;
         eval 'q() =~ /\N{4F}/';
-        ok $w && $w =~ /Deprecated/, 'Verify that leading digit in name gives warning';
-        undef $w;
+        ok $@ && $@ =~ /Invalid character/, 'Verify that leading digit in name gives error';
         eval 'q() =~ /\N{COM,MA}/';
-        ok $w && $w =~ /Deprecated/, 'Verify that comma in name gives warning';
-        undef $w;
-        my $name = "A\x{D7}O";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that comma in name gives error';
+        $name = "A\x{D7}O";
         eval "q(W) =~ /\\N{$name}/";
-        ok $w && $w =~ /Deprecated/, 'Verify that latin1 symbol in name gives warning';
+        ok $@ && $@ =~ /Invalid character/, 'Verify that latin1 symbol in name gives error';
+        my $utf8_name = "7 CITIES OF GOLD";
+        utf8::upgrade($utf8_name);
+        eval "use utf8; q(W) =~ /\\N{$utf8_name}/";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that leading digit in utf8 name gives error';
+        $utf8_name = "SHARP #";
+        utf8::upgrade($utf8_name);
+        eval "use utf8; q(W) =~ /\\N{$utf8_name}/";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that ASCII symbol in utf8 name gives error';
+        $utf8_name = "A HOUSE \xF7 AGAINST ITSELF";
+        utf8::upgrade($utf8_name);
+        eval "use utf8; q(W) =~ /\\N{$utf8_name}/";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that latin1 symbol in utf8 name gives error';
+        $utf8_name = "\x{664} HORSEMEN}";
+        eval "use utf8; q(W) =~ /\\N{$utf8_name}/";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that leading above Latin1 digit in utf8 name gives error';
+        $utf8_name = "A \x{1F4A9} WOULD SMELL AS SWEET}";
+        eval "use utf8; q(W) =~ /\\N{$utf8_name}/";
+        ok $@ && $@ =~ /Invalid character/, 'Verify that above Latin1 symbol in utf8 name gives error';
+
         undef $w;
         $name = "A\x{D1}O";
         eval "q(W) =~ /\\N{$name}/";
         ok ! $w, 'Verify that latin1 letter in name doesnt give warning';
 
+        # This tests the code path that restarts the parse when the recursive
+        # call to S_reg() from within S_grok_bslash_N() discovers that the
+        # pattern needs to be recalculated as UTF-8.  use eval to avoid
+        # needing literal Unicode in this source file:
+        my $r = eval "qr/\\N{\x{100}\x{100}}/";
+        isnt $r, undef, "Generated regex for multi-char UTF-8 charname"
+	    or diag($@);
+        ok "\x{100}\x{100}" =~ $r, "which matches";
     }
 
     {
@@ -1588,7 +1653,7 @@ sub run_tests {
     {
         # Test for keys in %+ and %-
         my $message = 'Test keys in %+ and %-';
-        no warnings 'uninitialized';
+        no warnings 'uninitialized', 'deprecated', 'experimental::lexical_topic';
         my $_ = "abcdef";
         /(?<foo>a)|(?<foo>b)/;
         is((join ",", sort keys %+), "foo", $message);
@@ -1609,6 +1674,7 @@ sub run_tests {
 
     {
         # length() on captures, the numbered ones end up in Perl_magic_len
+        no warnings 'deprecated', 'experimental::lexical_topic';
         my $_ = "aoeu \xe6var ook";
         /^ \w+ \s (?<eek>\S+)/x;
 
@@ -1658,7 +1724,6 @@ $x='123';
 print ">$1<\n";
 EOP
 
-        local $::TODO = 'RT #86042';
         fresh_perl_is(<<'EOP', ">abc<\n", {}, 'no mention of $&');
 my $x; 
 ($x='abc')=~/(abc)/g; 
@@ -1747,6 +1812,7 @@ EOP
 	   'IsPunct disagrees with [:punct:] outside ASCII');
 
         my @isPunctLatin1 = eval q {
+            no warnings 'deprecated';
             use encoding 'latin1';
             grep {/[[:punct:]]/ != /\p{IsPunct}/} map {chr} 0x80 .. 0xff;
         };
@@ -2072,6 +2138,55 @@ EOP
     ok "x" =~ /\A(?>(?:(?:)A|B|C?x))\z/,
         "Check TRIE does not overwrite EXACT following NOTHING at start - RT #111842";
 
+    {
+        my $single = ":";
+        my $upper = "\x{390}";  # Fold is 3 chars.
+        my $multi = CORE::fc($upper);
+
+        my $failed = 0;
+
+        # Try forcing a node to be split, with a multi-char fold at the
+        # boundary
+        for my $repeat (1 .. 300) {
+            my $string = $single x $repeat;
+            my $lhs = $string . $upper;
+            if ($lhs !~ m/$string$multi/i) {
+                $failed = $repeat;
+                last;
+            }
+        }
+        ok(! $failed, "Matched multi-char fold across EXACTFish node boundaries; if failed, was at count $failed");
+
+        $failed = 0;
+        for my $repeat (1 .. 300) {
+            my $string = $single x $repeat;
+            my $lhs = $string . "\N{LATIN SMALL LIGATURE FFI}";
+            if ($lhs !~ m/${string}ff\N{LATIN SMALL LETTER I}/i) {
+                $failed = $repeat;
+                last;
+            }
+        }
+        ok(! $failed, "Matched multi-char fold across EXACTFish node boundaries; if failed, was at count $failed");
+
+        $failed = 0;
+        for my $repeat (1 .. 300) {
+            my $string = $single x $repeat;
+            my $lhs = $string . "\N{LATIN SMALL LIGATURE FFL}";
+            if ($lhs !~ m/${string}ff\N{U+6c}/i) {
+                $failed = $repeat;
+                last;
+            }
+        }
+        ok(! $failed, "Matched multi-char fold across EXACTFish node boundaries; if failed, was at count $failed");
+    }
+
+    {
+        fresh_perl_is('print eval "\"\x{101}\" =~ /[[:lower:]]/", "\n"; print eval "\"\x{100}\" =~ /[[:lower:]]/i", "\n";',
+                      "1\n1",   # Both re's should match
+                      "",
+                      "get [:lower:] swash in first eval; test under /i in second");
+    }
+
     #
     # Keep the following tests last -- they may crash perl
     #
@@ -2134,6 +2249,11 @@ EOP
                             "chr(0xFFFF_FFFE) can match a Unicode property");
             ok(chr(0xFFFF_FFFF) =~ /\p{Is_32_Bit_Super}/,
                             "chr(0xFFFF_FFFF) can match a Unicode property");
+            my $p = qr/^[\x{FFFF_FFFF}]$/;
+            ok(chr(0xFFFF_FFFF) =~ $p,
+                    "chr(0xFFFF_FFFF) can match itself in a [class]");
+            ok(chr(0xFFFF_FFFF) =~ $p, # Tests any caching
+                    "chr(0xFFFF_FFFF) can match itself in a [class] subsequently");
         }
         else {
             no warnings 'overflow';
@@ -2142,6 +2262,12 @@ EOP
             ok(chr(0xFFFF_FFFF_FFFF_FFFF) =~ qr/^\p{Is_Portable_Super}$/,
                     "chr(0xFFFF_FFFF_FFFF_FFFF) can match a Unicode property");
 
+            my $p = qr/^[\x{FFFF_FFFF_FFFF_FFFF}]$/;
+            ok(chr(0xFFFF_FFFF_FFFF_FFFF) =~ $p,
+                    "chr(0xFFFF_FFFF_FFFF_FFFF) can match itself in a [class]");
+            ok(chr(0xFFFF_FFFF_FFFF_FFFF) =~ $p, # Tests any caching
+                    "chr(0xFFFF_FFFF_FFFF_FFFF) can match itself in a [class] subsequently");
+
             # This test is because something was declared as 32 bits, but
             # should have been cast to 64; only a problem where
             # sizeof(STRLEN) != sizeof(UV)
@@ -2155,6 +2281,14 @@ EOP
                             "Overlapping ranges in user-defined properties");
     }
 
+    { # Regexp:Grammars was broken:
+  # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2013-06/msg01290.html
+        fresh_perl_like('use warnings; "abc" =~ qr{(?&foo){0}abc(?<foo>)}',
+                        'Quantifier unexpected on zero-length expression',
+                        "",
+                        'No segfault on qr{(?&foo){0}abc(?<foo>)}');
+    }
+
     # !!! NOTE that tests that aren't at all likely to crash perl should go
     # a ways above, above these last ones.
 
diff --git a/gnu/usr.bin/perl/t/re/pat_psycho.t b/gnu/usr.bin/perl/t/re/pat_psycho.t
index c5073a5537b..04337603ae1 100755
--- a/gnu/usr.bin/perl/t/re/pat_psycho.t
+++ b/gnu/usr.bin/perl/t/re/pat_psycho.t
@@ -3,6 +3,9 @@
 # This is a home for regular expression tests that don't fit into
 # the format supported by re/regexp.t.  If you want to add a test
 # that does fit that format, add it to re/re_tests, not here.
+#
+# this file includes test that my burn a lot of CPU or otherwise be heavy
+# on resources. Set env var $PERL_SKIP_PSYCHO_TEST to skip this file
 
 use strict;
 use warnings;
@@ -21,7 +24,8 @@ BEGIN {
 }
 
 
-plan tests => 11;  # Update this when adding/deleting tests.
+skip_all('$PERL_SKIP_PSYCHO_TEST set') if $ENV{PERL_SKIP_PSYCHO_TEST};
+plan tests => 15;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -29,16 +33,17 @@ run_tests() unless caller;
 # Tests start here.
 #
 sub run_tests {
+    print "# Set PERL_SKIP_PSYCHO_TEST to skip these tests\n";
 
-  SKIP:
     {
-        print "# Set PERL_SKIP_PSYCHO_TEST to skip this test\n";
-        my @normal = qw [the are some normal words];
 
-        skip "Skipped Psycho", 2 * @normal if $ENV {PERL_SKIP_PSYCHO_TEST};
+	# stress test tries
+
+        my @normal = qw [the are some normal words];
 
         local $" = "|";
 
+	note "setting up trie psycho vars ...";
         my @psycho = (@normal, map chr $_, 255 .. 20000);
         my $psycho1 = "@psycho";
         for (my $i = @psycho; -- $i;) {
@@ -48,13 +53,12 @@ sub run_tests {
         my $psycho2 = "@psycho";
 
         foreach my $word (@normal) {
-            ok $word =~ /($psycho1)/ && $1 eq $word, 'Psycho';
-            ok $word =~ /($psycho2)/ && $1 eq $word, 'Psycho';
+            ok $word =~ /($psycho1)/ && $1 eq $word, qq{"$word" =~ /\$psycho1/};
+            ok $word =~ /($psycho2)/ && $1 eq $word, qq{"$word" =~ /\$psycho1/};
         }
     }
 
 
-  SKIP:
     {
         # stress test CURLYX/WHILEM.
         #
@@ -63,8 +67,6 @@ sub run_tests {
         # CURLYX and WHILEM blocks, except those related to LONGJMP, the
         # super-linear cache and warnings. It executes about 0.5M regexes
 
-        skip "No psycho tests" if $ENV {PERL_SKIP_PSYCHO_TEST};
-        print "# Set PERL_SKIP_PSYCHO_TEST to skip this test\n";
         my $r = qr/^
                     (?:
                         ( (?:a|z+)+ )
@@ -158,6 +160,49 @@ sub run_tests {
         }
         ok($ok, $msg);
     }
+
+
+    {
+	# these bits of test code used to run quadratically. If we break
+	# anything, they'll start to take minutes to run, rather than
+	# seconds. We don't actually measure times or set alarms, since
+	# that tends to be very fragile and prone to false positives.
+	# Instead, just hope that if someone is messing with
+	# performance-related code, they'll re-run the test suite and
+	# notice it suddenly takes a lot longer.
+
+	my $x;
+
+	$x = 'x' x 1_000_000;
+	1 while $x =~ /(.)/g;
+	pass "ascii =~ /(.)/";
+
+	{
+	    local ${^UTF8CACHE} = 1; # defeat debugging
+	    $x = "\x{100}" x 1_000_000;
+	    1 while $x =~ /(.)/g;
+	    pass "utf8 =~ /(.)/";
+	}
+
+	# run these in separate processes, since they set $&
+
+        fresh_perl_is(<<'EOF', "ok\n", {}, 'ascii =~ /(.)/, mention $&');
+$&;
+$x = 'x' x 1_000_000;
+1 while $x =~ /(.)/g;
+print "ok\n";
+EOF
+
+        fresh_perl_is(<<'EOF', "ok\n", {}, 'utf8 =~ /(.)/, mention $&');
+$&;
+local ${^UTF8CACHE} = 1; # defeat debugging
+$x = "\x{100}" x 1_000_000;
+1 while $x =~ /(.)/g;
+print "ok\n";
+EOF
+
+
+    }
 } # End of sub run_tests
 
 1;
diff --git a/gnu/usr.bin/perl/t/re/pat_re_eval.t b/gnu/usr.bin/perl/t/re/pat_re_eval.t
index 20bc7b32d3b..e47aaf34849 100755
--- a/gnu/usr.bin/perl/t/re/pat_re_eval.t
+++ b/gnu/usr.bin/perl/t/re/pat_re_eval.t
@@ -6,6 +6,7 @@
 
 use strict;
 use warnings;
+use Config;
 use 5.010;
 
 
@@ -22,10 +23,16 @@ BEGIN {
 }
 
 
-plan tests => 123;  # Update this when adding/deleting tests.
+plan tests => 519;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
+# test that runtime code without 'use re eval' is trapped
+
+sub norun {
+    like($@, qr/Eval-group not allowed at runtime/, @_);
+}
+
 #
 # Tests start here.
 #
@@ -42,11 +49,16 @@ sub run_tests {
 
         undef $@;
         eval {/$c/};
-        like($@, qr/not allowed at runtime/, $message);
+	norun("$message norun 1");
 
-        use re "eval";
-        /$a$c$a/;
-        is($b, '14', $message);
+
+        {
+	    eval {/$a$c$a/};
+	    norun("$message norun 2");
+	    use re "eval";
+	    /$a$c$a/;
+	    is($b, '14', $message);
+	}
 
         our $lex_a = 43;
         our $lex_b = 17;
@@ -57,9 +69,9 @@ sub run_tests {
         is($lex_a, 44, $message);
         is($lex_c, 43, $message);
 
-        no re "eval";
         undef $@;
-        my $match = eval { /$a$c$a/ };
+        my $d = '(?{1})';
+        my $match = eval { /$a$c$a$d/ };
         ok($@ && $@ =~ /Eval-group not allowed/ && !$match, $message);
         is($b, '14', $message);
 
@@ -92,7 +104,6 @@ sub run_tests {
         is(length qr /##/x, 9, "## in qr // doesn't corrupt memory; Bug 17776");
 
         {
-            use re 'eval';
             ok "$x$x" =~ /^$x(??{$x})\z/,
                "Postponed UTF-8 string in UTF-8 re matches UTF-8";
             ok "$y$x" =~ /^$y(??{$x})\z/,
@@ -116,8 +127,7 @@ sub run_tests {
 
 
     {
-        use re 'eval';
-        # Test if $^N and $+ work in (?{{})
+        # Test if $^N and $+ work in (?{})
         our @ctl_n = ();
         our @plus = ();
         our $nested_tags;
@@ -170,9 +180,6 @@ sub run_tests {
     }
 
     {
-        use re 'eval';
-
-
         our $f;
         local $f;
         $f = sub {
@@ -312,11 +319,8 @@ sub run_tests {
             is("@plus", $test->[3], "plus $c; Bug 56194");
             is($str, $test->[4], "str $c; Bug 56194");
         }
-        SKIP: {
-            if ($] le '5.010') {
-                skip "test segfaults on perl < 5.10", 4;
-            }
 
+        {
             @ctl_n = ();
             @plus = ();
 
@@ -342,6 +346,837 @@ sub run_tests {
        }
     }
 
+    {
+	# re evals within \U, \Q etc shouldn't be seen by the lexer
+	local our $a  = "i";
+	local our $B  = "J";
+	ok('(?{1})' =~ /^\Q(?{1})\E$/,   '\Q(?{1})\E');
+	ok('(?{1})' =~ /^\Q(?{\E1\}\)$/, '\Q(?{\E1\}\)');
+	eval {/^\U(??{"$a\Ea"})$/ }; norun('^\U(??{"$a\Ea"})$ norun');
+	eval {/^\L(??{"$B\Ea"})$/ }; norun('^\L(??{"$B\Ea"})$ norun');
+	use re 'eval';
+	ok('Ia' =~ /^\U(??{"$a\Ea"})$/,  '^\U(??{"$a\Ea"})$');
+	ok('ja' =~ /^\L(??{"$B\Ea"})$/,  '^\L(??{"$B\Ea"})$');
+    }
+
+    {
+	# Comprehensive (hopefully) tests of closure behaviour:
+	# i.e. when do (?{}) blocks get (re)compiled, and what instances
+	# of lexical vars do they close over?
+
+	# if the pattern string gets utf8 upgraded while concatenating,
+	# make sure a literal code block is still detected (by still
+	# compiling in the absence of use re 'eval')
+
+	{
+	    my $s1 = "\x{80}";
+	    my $s2 = "\x{100}";
+	    ok("\x{80}\x{100}" =~ /^$s1(?{1})$s2$/, "utf8 upgrade");
+	}
+
+	my ($cr1, $cr2, $cr3, $cr4);
+
+	for my $x (qw(a b c)) {
+	    my $bc = ($x ne 'a');
+	    my $c80 = chr(0x80);
+
+	    # the most basic: literal code should be in same scope
+	    # as the parent
+
+	    ok("A$x"       =~ /^A(??{$x})$/,       "[$x] literal code");
+	    ok("\x{100}$x" =~ /^\x{100}(??{$x})$/, "[$x] literal code UTF8");
+
+	    # the "don't recompile if pattern unchanged" mechanism
+	    # shouldn't apply to code blocks - recompile every time
+	    # to pick up new instances of variables
+
+	    my $code1  = 'B(??{$x})';
+	    my $code1u = $c80 . "\x{100}" . '(??{$x})';
+
+	    eval {/^A$code1$/};
+	    norun("[$x] unvarying runtime code AA norun");
+	    eval {/^A$code1u$/};
+	    norun("[$x] unvarying runtime code AU norun");
+	    eval {/^$c80\x{100}$code1$/};
+	    norun("[$x] unvarying runtime code UA norun");
+	    eval {/^$c80\x{101}$code1u$/};
+	    norun("[$x] unvarying runtime code UU norun");
+
+	    {
+		use re 'eval';
+		ok("AB$x" =~ /^A$code1$/, "[$x] unvarying runtime code AA");
+		ok("A$c80\x{100}$x" =~ /^A$code1u$/,
+					    "[$x] unvarying runtime code AU");
+		ok("$c80\x{100}B$x" =~ /^$c80\x{100}$code1$/,
+					    "[$x] unvarying runtime code UA");
+		ok("$c80\x{101}$c80\x{100}$x" =~ /^$c80\x{101}$code1u$/,
+					    "[$x] unvarying runtime code UU");
+	    }
+
+	    # mixed literal and run-time code blocks
+
+	    my $code2  = 'B(??{$x})';
+	    my $code2u = $c80 . "\x{100}" . '(??{$x})';
+
+	    eval {/^A(??{$x})-$code2$/};
+	    norun("[$x] literal+runtime AA norun");
+	    eval {/^A(??{$x})-$code2u$/};
+	    norun("[$x] literal+runtime AU norun");
+	    eval {/^$c80\x{100}(??{$x})-$code2$/};
+	    norun("[$x] literal+runtime UA norun");
+	    eval {/^$c80\x{101}(??{$x})-$code2u$/};
+	    norun("[$x] literal+runtime UU norun");
+
+	    {
+		use re 'eval';
+		ok("A$x-B$x" =~ /^A(??{$x})-$code2$/,
+					    "[$x] literal+runtime AA");
+		ok("A$x-$c80\x{100}$x" =~ /^A(??{$x})-$code2u$/,
+					    "[$x] literal+runtime AU");
+		ok("$c80\x{100}$x-B$x" =~ /^$c80\x{100}(??{$x})-$code2$/,
+					    "[$x] literal+runtime UA");
+		ok("$c80\x{101}$x-$c80\x{100}$x"
+					    =~ /^$c80\x{101}(??{$x})-$code2u$/,
+					    "[$x] literal+runtime UU");
+	    }
+
+	    # literal qr code only created once, naked
+
+	    $cr1 //= qr/^A(??{$x})$/;
+	    ok("Aa" =~ $cr1, "[$x] literal qr once naked");
+
+	    # literal qr code only created once, embedded with text
+
+	    $cr2 //= qr/B(??{$x})$/;
+	    ok("ABa" =~ /^A$cr2/, "[$x] literal qr once embedded text");
+
+	    # literal qr code only created once, embedded with text + lit code
+
+	    $cr3 //= qr/C(??{$x})$/;
+	    ok("A$x-BCa" =~ /^A(??{$x})-B$cr3/,
+			    "[$x] literal qr once embedded text + lit code");
+
+	    # literal qr code only created once, embedded with text + run code
+
+	    $cr4 //= qr/C(??{$x})$/;
+	    my $code3 = 'A(??{$x})';
+
+	    eval {/^$code3-B$cr4/};
+	    norun("[$x] literal qr once embedded text + run code norun");
+	    {
+		use re 'eval';
+		ok("A$x-BCa" =~ /^$code3-B$cr4/,
+			    "[$x] literal qr once embedded text + run code");
+	    }
+
+	    # literal qr code, naked
+
+	    my $r1 = qr/^A(??{$x})$/;
+	    ok("A$x" =~ $r1, "[$x] literal qr naked");
+
+	    # literal qr code, embedded with text
+
+	    my $r2 = qr/B(??{$x})$/;
+	    ok("AB$x" =~ /^A$r2/, "[$x] literal qr embedded text");
+
+	    # literal qr code, embedded with text + lit code
+
+	    my $r3 = qr/C(??{$x})$/;
+	    ok("A$x-BC$x" =~ /^A(??{$x})-B$r3/,
+				"[$x] literal qr embedded text + lit code");
+
+	    # literal qr code, embedded with text + run code
+
+	    my $r4 = qr/C(??{$x})$/;
+	    my $code4 = '(??{$x})';
+
+	    eval {/^A$code4-B$r4/};
+	    norun("[$x] literal qr embedded text + run code");
+	    {
+		use re 'eval';
+		ok("A$x-BC$x" =~ /^A$code4-B$r4/,
+				"[$x] literal qr embedded text + run code");
+	    }
+
+	    # nested qr in different scopes
+
+	    my $code5 = '(??{$x})';
+	    my $r5 = qr/C(??{$x})/;
+
+	    my $r6;
+	    eval {qr/$code5-C(??{$x})/}; norun("r6 norun");
+	    {
+		use re 'eval';
+		$r6 = qr/$code5-C(??{$x})/;
+	    }
+
+	    my @rr5;
+	    my @rr6;
+
+	    for my $y (qw(d e f)) {
+
+		my $rr5 = qr/^A(??{"$x$y"})-$r5/;
+		push @rr5, $rr5;
+		ok("A$x$y-C$x" =~ $rr5,
+				"[$x-$y] literal qr + r5");
+
+		my $rr6 = qr/^A(??{"$x$y"})-$r6/;
+		push @rr6, $rr6;
+		ok("A$x$y-$x-C$x" =~ $rr6,
+				"[$x-$y] literal qr + r6");
+	    }
+
+	    for my $i (0,1,2) {
+		my $y = 'Y';
+		my $yy = (qw(d e f))[$i];
+		my $rr5 = $rr5[$i];
+		ok("A$x$yy-C$x" =~ $rr5, "[$x-$yy] literal qr + r5, outside");
+		ok("A$x$yy-C$x-D$x" =~ /$rr5-D(??{$x})$/,
+				"[$x-$yy] literal qr + r5 + lit, outside");
+
+
+		my $rr6 = $rr6[$i];
+		push @rr6, $rr6;
+		ok("A$x$yy-$x-C$x" =~ $rr6,
+				"[$x-$yy] literal qr + r6, outside");
+		ok("A$x$yy-$x-C$x-D$x" =~ /$rr6-D(??{$x})/,
+				"[$x-$yy] literal qr + r6 +lit, outside");
+	    }
+	}
+
+	# recursive subs should get lexical from the correct pad depth
+
+	sub recurse {
+	    my ($n) = @_;
+	    return if $n > 2;
+	    ok("A$n" =~ /^A(??{$n})$/, "recurse($n)");
+	    recurse($n+1);
+	}
+	recurse(0);
+
+	# for qr// containing run-time elements but with a compile-time
+	# code block, make sure the run-time bits are executed in the same
+	# pad they were compiled in
+	{
+	    my $a = 'a'; # ensure outer and inner pads don't align
+	    my $b = 'b';
+	    my $c = 'c';
+	    my $d = 'd';
+	    my $r = qr/^$b(??{$c})$d$/;
+	    ok("bcd" =~ $r, "qr with run-time elements and code block");
+	}
+
+	# check that cascaded embedded regexes all see their own lexical
+	# environment
+
+	{
+	    my ($r1, $r2, $r3, $r4);
+	    my ($x1, $x2, $x3, $x4) = (5,6,7,8);
+	    { my $x1 = 1; $r1 = qr/A(??{$x1})/; }
+	    { my $x2 = 2; $r2 = qr/$r1(??{$x2})/; }
+	    { my $x3 = 3; $r3 = qr/$r2(??{$x3})/; }
+	    { my $x4 = 4; $r4 = qr/$r3(??{$x4})/; }
+	    ok("A1234" =~ /^$r4$/, "cascaded qr");
+	}
+
+	# and again, but in a loop, with no external references
+	# being maintained to the qr's
+
+	{
+	    my $r = 'A';
+	    for my $x (1..4) {
+		$r = qr/$r(??{$x})/;
+	    }
+	    my $x = 5;
+	    ok("A1234" =~ /^$r$/, "cascaded qr loop");
+	}
+
+
+	# and again, but compiling the qrs in an eval so there
+	# aren't even refs to the qrs from any ops
+
+	{
+	    my $r = 'A';
+	    for my $x (1..4) {
+		$r = eval q[ qr/$r(??{$x})/; ];
+	    }
+	    my $x = 5;
+	    ok("A1234" =~ /^$r$/, "cascaded qr loop");
+	}
+
+	# have qrs with either literal code blocks or only embedded
+	# code blocks, but not both
+
+	{
+	    my ($r1, $r2, $r3, $r4);
+	    my ($x1, $x3) = (7,8);
+	    { my $x1 = 1; $r1 = qr/A(??{$x1})/; }
+	    {             $r2 = qr/${r1}2/; }
+	    { my $x3 = 3; $r3 = qr/$r2(??{$x3})/; }
+	    {             $r4 = qr/${r3}4/; }
+	    ok("A1234"  =~   /^$r4$/,    "cascaded qr mix 1");
+	    ok("A12345" =~   /^${r4}5$/, "cascaded qr mix 2");
+	    ok("A1234"  =~ qr/^$r4$/   , "cascaded qr mix 3");
+	    ok("A12345" =~ qr/^${r4}5$/, "cascaded qr mix 4");
+	}
+
+	# and make sure things are freed at the right time
+
+        SKIP: {
+            if ($Config{mad}) {
+                skip "MAD doesn't free eval CVs", 3;
+	    }
+
+	    {
+		sub Foo99::DESTROY { $Foo99::d++ }
+		$Foo99::d = 0;
+		my $r1;
+		{
+		    my $x = bless [1], 'Foo99';
+		    $r1 = eval 'qr/(??{$x->[0]})/';
+		}
+		my $r2 = eval 'qr/a$r1/';
+		my $x = 2;
+		ok(eval '"a1" =~ qr/^$r2$/', "match while in scope");
+		# make sure PL_reg_curpm isn't holding on to anything
+		"a" =~ /a(?{1})/;
+		is($Foo99::d, 0, "before scope exit");
+	    }
+	    ::is($Foo99::d, 1, "after scope exit");
+	}
+
+	# forward declared subs should Do The Right Thing with any anon CVs
+	# within them (i.e. pad_fixup_inner_anons() should work)
+
+	sub forward;
+	sub forward {
+	    my $x = "a";
+	    my $A = "A";
+	    ok("Aa" =~ qr/^A(??{$x})$/,  "forward qr compiletime");
+	    ok("Aa" =~ qr/^$A(??{$x})$/, "forward qr runtime");
+	}
+	forward;
+    }
+
+    # test that run-time embedded code, when re-fed into toker,
+    # does all the right escapes
+
+    {
+	my $enc = eval 'use Encode; find_encoding("ascii")';
+
+	my $x = 0;
+	my $y = 'bad';
+
+	# note that most of the strings below are single-quoted, and the
+	# things within them, like '$y', *aren't* intended to interpolate
+
+	my $s1 =
+	    'a\\$y(?# (??{BEGIN{$x=1} "X1"})b(?# \Ux2\E)c\'d\\\\e\\\\Uf\\\\E';
+
+	ok(q{a$ybc'd\e\Uf\E} =~ /^$s1$/, "reparse");
+	is($x, 0, "reparse no BEGIN");
+
+	my $s2 = 'g\\$y# (??{{BEGIN{$x=2} "X3"}) \Ux3\E'  . "\nh";
+
+	ok(q{a$ybc'd\\e\\Uf\\Eg$yh} =~ /^$s1$s2$/x, "reparse /x");
+	is($x, 0, "reparse /x no BEGIN");
+
+	my $b = '\\';
+	my $q = '\'';
+
+	#  non-ascii in string as "<0xNNN>"
+	sub esc_str {
+	    my $s = shift;
+	    $s =~ s{(.)}{
+			my $c = ord($1);
+			($c< 32 || $c > 127) ? sprintf("<0x%x>", $c) : $1;
+		}ge;
+	    $s;
+	}
+	sub  fmt { sprintf "hairy backslashes %s [%s] =~ /^%s/",
+			$_[0], esc_str($_[1]), esc_str($_[2]);
+	}
+
+
+	for my $u (
+	    [ '',  '', 'blank ' ],
+	    [ "\x{100}", '\x{100}', 'single' ],
+	    [ "\x{100}", "\x{100}", 'double' ])
+	{
+	    for my $pair (
+		    [ "$b",        "$b$b"               ],
+		    [ "$q",        "$q"                 ],
+		    [ "$b$q",      "$b$b$b$q"           ],
+		    [ "$b$b$q",    "$b$b$b$b$q"         ],
+		    [ "$b$b$b$q",  "$b$b$b$b$b$b$q"     ],
+		    [ "$b$b$b$b$q","$b$b$b$b$b$b$b$b$q" ],
+	    ) {
+		my ($s, $r) = @$pair;
+		$s = "9$s";
+		my $ss = "$u->[0]$s";
+
+		my $c = '9' . $r;
+		my $cc = "$u->[1]$c";
+
+		ok($ss =~ /^$cc/, fmt("plain      $u->[2]", $ss, $cc));
+
+		no strict;
+		my $chr41 = "\x41";
+		$ss = "$u->[0]\t${q}$chr41${b}x42$s";
+		$nine = $nine = "bad";
+		for my $use_qr ('', 'qr') {
+		    $c =  qq[(??{my \$z='{';]
+			. qq[$use_qr"$b${b}t$b$q$b${b}x41$b$b$b${b}x42"]
+			. qq[. \$nine})];
+		    # (??{ qr/str/ }) goes through one less interpolation
+		    # stage than  (??{ qq/str/ })
+		    $c =~ s{\\\\}{\\}g if ($use_qr eq 'qr');
+		    $c .= $r;
+		    $cc = "$u->[1]$c";
+		    my $nine = 9;
+
+		    eval {/^$cc/}; norun(fmt("code   norun $u->[2]", $ss, $cc));
+		    {
+			use re 'eval';
+			ok($ss =~ /^$cc/, fmt("code         $u->[2]", $ss, $cc));
+		    }
+
+		    {
+			# Poor man's "use encoding 'ascii'".
+			# This causes a different code path in S_const_str()
+			# to be used
+			local ${^ENCODING} = $enc;
+			use re 'eval';
+			ok($ss =~ /^$cc/, fmt("encode       $u->[2]", $ss, $cc));
+		    }
+		}
+	    }
+	}
+
+	my $code1u = "(??{qw(\x{100})})";
+	eval {/^$code1u$/}; norun("reparse embeded unicode norun");
+	{
+	    use re 'eval';
+	    ok("\x{100}" =~ /^$code1u$/, "reparse embeded unicode");
+	}
+    }
+
+    # a non-pattern literal won't get code blocks parsed at compile time;
+    # but they must get parsed later on if 'use re eval' is in scope
+    # also check that unbalanced {}'s are parsed ok
+
+    {
+	eval q["a{" =~ '^(??{"a{"})$'];
+	norun("non-pattern literal code norun");
+	eval {/^${\'(??{"a{"})'}$/};
+	norun("runtime code with unbalanced {} norun");
+
+	use re 'eval';
+	ok("a{" =~ '^a(??{"{"})$', "non-pattern literal code");
+	ok("a{" =~ /^a${\'(??{"{"})'}$/, "runtime code with unbalanced {}");
+    }
+
+    # make sure warnings come from the right place
+
+    {
+	use warnings;
+	my ($s, $t, $w);
+	local $SIG{__WARN__} = sub { $w .= "@_" };
+
+	$w = ''; $s = 's';
+	my $r = qr/(?{$t=$s+1})/;
+	"a" =~ /a$r/;
+	like($w, qr/pat_re_eval/, "warning main file");
+
+	# do it in an eval to get predictable line numbers
+	eval q[
+
+	    $r = qr/(?{$t=$s+1})/;
+	];
+	$w = ''; $s = 's';
+	"a" =~ /a$r/;
+	like($w, qr/ at \(eval \d+\) line 3/, "warning eval A");
+
+	$w = ''; $s = 's';
+	eval q[
+	    use re 'eval';
+	    my $c = '(?{$t=$s+1})';
+	    "a" =~ /a$c/;
+	    1;
+	];
+	like($w, qr/ at \(eval \d+\) line 1/, "warning eval B");
+    }
+
+    # jumbo test for:
+    # * recursion;
+    # * mixing all the different types of blocks (literal, qr/literal/,
+    #   runtime);
+    # * backtracking (the Z+ alternation ensures CURLYX and full
+    #   scope popping on backtracking)
+
+    {
+        sub recurse2 {
+            my ($depth)= @_;
+	    return unless $depth;
+            my $s1 = '3-LMN';
+            my $r1 = qr/(??{"$s1-$depth"})/;
+
+	    my $s2 = '4-PQR';
+            my $c1 = '(??{"$s2-$depth"})';
+            use re 'eval';
+	    ok(   "<12345-ABC-$depth-123-LMN-$depth-1234-PQR-$depth>"
+	        . "<12345-ABC-$depth-123-LMN-$depth-1234-PQR-$depth>"
+		=~
+		  /^<(\d|Z+)+(??{"45-ABC-$depth-"})(\d|Z+)+$r1-\d+$c1>
+		    <(\d|Z+)+(??{"45-ABC-$depth-"})(\d|Z+)+$r1-\d+$c1>$/x,
+		"recurse2($depth)");
+	    recurse2($depth-1);
+	}
+	recurse2(5);
+    }
+
+    # nested (??{}) called from various levels of a recursive function
+
+    {
+	sub recurse3 {
+	    my ($n) = @_;
+	    return if $n > 3;
+	    ok("A$n" =~ m{^A(??{ "0123" =~ /((??{$n}))/; $1 })$},
+		"recurse3($n)");
+	    ok("A$n" !~ m{^A(??{ "0123" =~ /((??{$n}))/; "X" })$},
+		"recurse3($n) nomatch");
+	    recurse3($n+1);
+	}
+	recurse3(0);
+    }
+
+    # nested (??{}) being invoked recursively via a function
+
+    {
+	my $s = '';
+	our $recurse4;
+	my @alpha = qw(A B C D E);
+	$recurse4 = sub {
+	    my ($n) = @_;
+	    $s .= "(n=$n:";
+	    if ($n < 4) {
+		my $m = ("$alpha[$n]" . substr("0123", 0, $n+1)) =~
+		    m{^([A-Z])
+		      (??{
+			    $s .= "1=$1:";
+			    "$n-0123" =~ m{^(\d)-(((??{$recurse4->($n+1)})))};
+			    $s .= "i1=$1:<=[$2]";
+			    $3; # NB - not stringified
+		       })
+		       $
+		     }x;
+		$s .= "1a=$1:";
+		$s .= $m ? 'M' : '!M';
+	    }
+	    my $ret =  '.*?' . ($n-1);
+	    $s .= "<=[$ret])";
+	    return $ret;
+	};
+	$recurse4->(0);
+	my $exp =   '(n=0:1=A:(n=1:1=B:(n=2:1=C:(n=3:1=D:(n=4:<=[.*?3])'
+		  . 'i1=3:<=[0123]1a=D:M<=[.*?2])i1=2:<=[012]1a=C:M<=[.*?1])'
+		  . 'i1=1:<=[01]1a=B:M<=[.*?0])i1=0:<=[0]1a=A:M<=[.*?-1])';
+	is($s, $exp, 'recurse4');
+    }
+
+    # single (??{}) being invoked recursively via a function
+
+    {
+	my $s = '';
+	our $recurse5;
+	my @alpha = qw(A B C D E);
+	$recurse5 = sub {
+	    my ($n) = @_;
+	    $s .= "(n=$n:";
+	    if ($n < 4) {
+		my $m = ("$alpha[$n]" . substr("0123", 0, $n+1)) =~
+		    m{^([A-Z])
+		      ((??{
+			    $s .= "1=$1:";
+			    $recurse5->($n+1);
+		       }))
+		       $
+		     }x;
+		$s .= "1a=$1:2=$2:";
+		$s .= $m ? 'M' : '!M';
+	    }
+	    my $ret =  '.*?' . ($n-1);
+	    $s .= "<=[$ret])";
+	    return $ret;
+	};
+	$recurse5->(0);
+	my $exp =   '(n=0:1=A:(n=1:1=B:(n=2:1=C:(n=3:1=D:(n=4:<=[.*?3])'
+		  . '1a=D:2=0123:M<=[.*?2])1a=C:2=012:M<=[.*?1])'
+		  . '1a=B:2=01:M<=[.*?0])1a=A:2=0:M<=[.*?-1])';
+	is($s, $exp, 'recurse5');
+    }
+
+
+    # make sure that errors during compiling run-time code get trapped
+
+    {
+	use re 'eval';
+
+	my $code = '(?{$x=})';
+	eval { "a" =~ /^a$code/ };
+	like($@, qr/syntax error at \(eval \d+\) line \d+/, 'syntax error');
+
+	$code = '(?{BEGIN{die})';
+	eval { "a" =~ /^a$code/ };
+	like($@,
+	    qr/BEGIN failed--compilation aborted at \(eval \d+\) line \d+/,
+	    'syntax error');
+    }
+
+    # make sure that 'use re eval' is propagated into compiling the
+    # pattern returned by (??{})
+
+    {
+	use re 'eval';
+	my $pat = 'B(??{1})C';
+	my $A = 'A';
+	# compile-time outer code-block
+	ok("AB1CD" =~ /^A(??{$pat})D$/, "re eval propagated compile-time");
+	# run-time outer code-block
+	ok("AB1CD" =~ /^$A(??{$pat})D$/, "re eval propagated run-time");
+    }
+
+    # returning a ref to something that had set magic but wasn't
+    # PERL_MAGIC_qr triggered a false positive assertion failure
+    # The test is not so much concerned with it not matching,
+    # as with not failing the assertion
+
+    {
+	ok("a" !~ /^(a)(??{ \$1 })/, '(??{ ref })');
+    }
+
+    # make sure the uninit warning from returning an undef var
+    # sees the right var
+
+    {
+	my ($u1, $u2);
+	my $warn = '';
+	local $SIG{__WARN__} = sub {  $warn .= $_[0] };
+	$u1 =~ /(??{$u2})/ or die;
+	like($warn, qr/value \$u1 in pattern match.*\n.*value at/, 'uninit');
+    }
+
+    # test that code blocks are called in scalar context
+
+    {
+	my @a = (0);
+	ok("" =~ /^(?{@a})$/, '(?{}) in scalar context');
+	is($^R, 1, '(?{}) in scalar context: $^R');
+	ok("1" =~ /^(??{@a})$/, '(??{}) in scalar context');
+	ok("foo" =~ /^(?(?{@a})foo|bar)$/, '(?(?{})|) in scalar context');
+    }
+
+    # BEGIN in compiled blocks shouldn't mess with $1 et al
+
+    {
+	use re 'eval';
+	my $code1 = '(B)(??{ BEGIN { "X" =~ /X/ } $1})(C)';
+	ok("ABBCA" =~ /^(.)(??{$code1})\1$/, '(?{}) BEGIN and $1');
+	my $code2 = '(B)(??{ BEGIN { "X" =~ /X/ } $1 =~ /(.)/ ? $1 : ""})(C)';
+	ok("ABBCA" =~ /^(.)(??{$code2})\1$/, '(?{}) BEGIN and $1 mark 2');
+    }
+
+    # check that the optimiser is applied to code blocks: see if aelem has
+    # been converted to aelemfast
+
+    {
+	my $out;
+	for my $prog (
+	    '/(?{$a[0]})/',
+	    'q() =~ qr/(?{$a[0]})/',
+	    'use re q(eval); q() =~ q{(?{$a[0]})}',
+	    'use re q(eval); $c = q{(?{$a[0]})}; /$c/',
+	    'use re q(eval); $c = q{(?{$a[0]})}; /(?{1;})$c/',
+	) {
+	    $out = runperl(switches => ["-Dt"], prog => $prog, stderr => 1);
+	    like($out, qr/aelemfast|Recompile perl with -DDEBUGGING/,
+		"optimise: '$prog'");
+	}
+    }
+
+    #  [perl #115080]
+    #  Ensure that ?pat? matches exactly once, even when the run-time
+    #  pattern changes, and even when the presence of run-time (?{}) affects
+    #  how and when patterns are recompiled
+
+    {
+	my $m;
+
+	$m = '';
+	for (qw(a a a)) {
+	    $m .= $_ if m?$_?;
+	}
+	is($m, 'a', '?pat? with a,a,a');
+
+	$m = '';
+	for (qw(a b c)) {
+	    $m .= $_ if m?$_?;
+	}
+	is($m, 'a', '?pat? with a,b,c');
+
+	use re 'eval';
+
+	$m = '';
+	for (qw(a a a)) {
+	my $e = qq[(??{"$_"})];
+	    $m .= $_ if m?$e?;
+	}
+	is($m, 'a', '?pat? with (??{a,a,a})');
+
+	$m = '';
+	for (qw(a b c)) {
+	my $e = qq[(??{"$_"})];
+	    $m .= $_ if m?$e?;
+	}
+	is($m, 'a', '?pat? with (??{a,b,c})');
+    }
+
+    {
+	# this code won't actually fail, but it used to fail valgrind,
+	# so its here just to make sure valgrind doesn't fail again
+	# While examining the ops of the secret anon sub wrapped around
+	# the qr//, the pad of the sub was in scope, so cSVOPo_sv
+	# got the const from the wrong pad. By having lots of $s's
+	# (aka gvsv(*s), this forces the targs of the consts which have
+	# been moved to the pad, to have high indices.
+
+	sub {
+	    local our $s = "abc";
+	    my $qr = qr/^(?{1})$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s$s/;
+	}->();
+	pass("cSVOPo_sv");
+    }
+
+    # [perl #115004]
+    # code blocks in qr objects that are interpolated in arrays need
+    # handling the same as if they were interpolated from scalar vars
+    # (before this code would need 'use re "eval"')
+
+    {
+	use Tie::Array;
+
+	use vars '@global';
+	local @global;
+	my @array;
+	my @refs = (0, \@array, 2);
+	my @tied;
+	tie @tied, 'Tie::StdArray';
+	{
+	    my $bb = 'B';
+	    my $dd = 'D';
+	    @array = ('A', qr/(??{$bb})/, 'C', qr/(??{$dd})/, 'E');
+	    @tied  = @array;
+	    @global = @array;
+	}
+	my $bb = 'X';
+	my $dd = 'Y';
+	ok("A B C D E=" =~ /@array/, 'bare interpolated array match');
+	ok("A B C D E=" =~ qr/@array/, 'qr bare interpolated array match');
+	ok("A B C D E=" =~ /@global/, 'bare interpolated global array match');
+	ok("A B C D E=" =~ qr/@global/,
+				    'qr bare interpolated global array match');
+	ok("A B C D E=" =~ /@{$refs[1]}/, 'bare interpolated ref array match');
+	ok("A B C D E=" =~ qr/@{$refs[1]}/,
+					'qr bare interpolated ref array match');
+	ok("A B C D E=" =~ /@tied/,  'bare interpolated tied array match');
+	ok("A B C D E=" =~ qr/@tied/,  'qr bare interpolated tied array match');
+	ok("aA B C D E=" =~ /^a@array=$/, 'interpolated array match');
+	ok("aA B C D E=" =~ qr/^a@array=$/, 'qr interpolated array match');
+	ok("aA B C D E=" =~ /^a@global=$/, 'interpolated global array match');
+	ok("aA B C D E=" =~ qr/^a@global=$/,
+					'qr interpolated global array match');
+	ok("aA B C D E=" =~ /^a@{$refs[1]}=$/, 'interpolated ref array match');
+	ok("aA B C D E=" =~ qr/^a@{$refs[1]}=$/,
+					    'qr interpolated ref array match');
+	ok("aA B C D E=" =~ /^a@tied=$/,  'interpolated tied array match');
+	ok("aA B C D E=" =~ qr/^a@tied=$/,  'qr interpolated tied array match');
+
+	{
+	    local $" = '-';
+	    ok("aA-B-C-D-E=" =~ /^a@{array}=$/,
+			'interpolated array match with local sep');
+	    ok("aA-B-C-D-E=" =~ qr/^a@{array}=$/,
+			'qr interpolated array match with local sep');
+	    ok("aA-B-C-D-E=" =~ /^a@{global}=$/,
+			'interpolated global array match with local sep');
+	    ok("aA-B-C-D-E=" =~ qr/^a@{global}=$/,
+			'qr interpolated global array match with local sep');
+	    ok("aA-B-C-D-E=" =~ /^a@{tied}=$/,
+			'interpolated tied array match with local sep');
+	    ok("aA-B-C-D-E=" =~ qr/^a@{tied}=$/,
+			'qr interpolated tied array match with local sep');
+	}
+
+	# but don't handle the array ourselves in the presence of \Q etc
+
+	@array  = ('A', '(?{})');
+	@global = @array;
+	@tied   = @array;
+	ok("aA (?{})=" =~ /^a\Q@{array}\E=$/,
+				'interpolated array match with \Q');
+	ok("aA (?{})=" =~ qr/^a\Q@{array}\E=$/,
+				'qr interpolated array match with \Q');
+	ok("aA (?{})=" =~ /^a\Q@{global}\E=$/,
+				'interpolated global array match with \Q');
+	ok("aA (?{})=" =~ qr/^a\Q@{global}\E=$/,
+				'qr interpolated global array match with \Q');
+	ok("aA (?{})=" =~ /^a\Q@{$refs[1]}\E=$/,
+				'interpolated ref array match with \Q');
+	ok("aA (?{})=" =~ qr/^a\Q@{$refs[1]}\E=$/,
+				'qr interpolated ref array match with \Q');
+	ok("aA (?{})=" =~ /^a\Q@{tied}\E=$/,
+				'interpolated tied array match with \Q');
+	ok("aA (?{})=" =~ qr/^a\Q@{tied}\E=$/,
+				'qr interpolated tied array match with \Q');
+
+	# and check it works with an empty array
+
+	@array = ();
+	@global = ();
+	@tied = ();
+	ok("a=" =~ /^a@array=$/, 'empty array match');
+	ok("a=" =~ qr/^a@array=$/, 'qr empty array match');
+	ok("a=" =~ /^a@global=$/, 'empty global array match');
+	ok("a=" =~ qr/^a@global=$/, 'qr empty global array match');
+	ok("a=" =~ /^a@tied=$/,  'empty tied array match');
+	ok("a=" =~ qr/^a@tied=$/,  'qr empty tied array match');
+	ok("a=" =~ /^a\Q@{array}\E=$/, 'empty array match with \Q');
+	ok("a=" =~ /^a\Q@{array}\E=$/, 'empty array match with \Q');
+	ok("a=" =~ qr/^a\Q@{global}\E=$/,
+				    'qr empty global array match with \Q');
+	ok("a=" =~ /^a\Q@{tied}\E=$/, 'empty tied array match with \Q');
+	ok("a=" =~ qr/^a\Q@{tied}\E=$/, 'qr empty tied array match with \Q');
+
+	# NB: these below are empty patterns, so they happen to use the
+	# successful match from the line above
+
+	ok("a=" =~ /@array/, 'empty array pattern');
+	ok("a=" =~ qr/@array/, 'qr empty array pattern');
+	ok("a=" =~ /@global/, 'empty global array pattern');
+	ok("a=" =~ qr/@global/, 'qr empty global array pattern');
+	ok("a=" =~ /@tied/, 'empty tied pattern');
+	ok("a=" =~ qr/@tied/, 'qr empty tied pattern');
+	ok("a=" =~ /\Q@array\E/, 'empty array pattern with \Q');
+	ok("a=" =~ qr/\Q@array\E/, 'qr empty array pattern with \Q');
+	ok("a=" =~ /\Q@global\E/, 'empty global array pattern with \Q');
+	ok("a=" =~ qr/\Q@global\E/, 'qr empty global array pattern with \Q');
+	ok("a=" =~ /\Q@tied\E/, 'empty tied pattern with \Q');
+	ok("a=" =~ qr/\Q@tied\E/, 'qr empty tied pattern with \Q');
+	ok("a=" =~ //, 'completely empty pattern');
+	ok("a=" =~ qr//, 'qr completely empty pattern');
+    }
+
+
 } # End of sub run_tests
 
 1;
diff --git a/gnu/usr.bin/perl/t/re/pat_rt_report.t b/gnu/usr.bin/perl/t/re/pat_rt_report.t
index 781a6da615c..9a9b5f50049 100755
--- a/gnu/usr.bin/perl/t/re/pat_rt_report.t
+++ b/gnu/usr.bin/perl/t/re/pat_rt_report.t
@@ -22,7 +22,7 @@ BEGIN {
 }
 
 
-plan tests => 2521;  # Update this when adding/deleting tests.
+plan tests => 2532;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -384,14 +384,7 @@ sub run_tests {
         is("@_", "a|b|c", $message);
     }
 
-    {
-        # XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
-        # hasn't been crashing. Disable this test until it is fixed properly.
-        # XXX also check what it returns rather than just doing ok(1,...)
-        # split /(?{ split "" })/, "abc";
-        local $::TODO = "Recursive split is still broken";
-        ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
-    }
+    is(join('-', split /(?{ split "" })/, "abc"), 'a-b-c', 'nested split');
 
     {
         $_ = "code:   'x' { '...' }\n"; study;
@@ -922,12 +915,17 @@ sub run_tests {
     {
          my $message = '$REGMARK in replacement; Bug 49190';
          our $REGMARK;
+         no warnings 'experimental::lexical_topic';
          my $_ = "A";
          ok(s/(*:B)A/$REGMARK/, $message);
          is($_, "B", $message);
          $_ = "CCCCBAA";
          ok(s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g, $message);
          is($_, "ZYX", $message);
+         # Use a longer name to force reallocation of $REGMARK.
+         $_ = "CCCCBAA";
+         ok(s/(*:X)A+|(*:YYYYYYYYYYYYYYYY)B+|(*:Z)C+/$REGMARK/g, $message);
+         is($_, "ZYYYYYYYYYYYYYYYYX", $message);
     }
 
     {
@@ -1135,6 +1133,46 @@ $t =~ s/([^a])//ge;
 EOP
     }
 
+    {
+        # pattern must be compiled late or we can break the test file
+        my $message = '[perl #115050] repeated nothings in a trie can cause panic';
+        my $pattern;
+        $pattern = '[xyz]|||';
+        ok("blah blah" =~ /$pattern/, $message);
+        ok("blah blah" =~ /(?:$pattern)h/, $message);
+        $pattern = '|||[xyz]';
+        ok("blah blah" =~ /$pattern/, $message);
+        ok("blah blah" =~ /(?:$pattern)h/, $message);
+    }
+
+    {
+        # [perl #4289] First mention $& after a match
+        local $::TODO = "these tests fail without Copy-on-Write enabled";
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$&|, "\n"',
+            "b\n", {}, '$& first mentioned after match');
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$`|, "\n"',
+            "a\n", {}, '$` first mentioned after match');
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$\'|,"\n"',
+            "c\n", {}, '$\' first mentioned after match');
+    }
+
+    {
+	# [perl #118175] threaded perl-5.18.0 fails pat_rt_report_thr.t
+	# this tests some related failures
+	#
+	# The tests in the block *only* fail when run on 32-bit systems
+	# with a malloc that allocates above the 2GB line.  On the system
+	# in the report above that only happened in a thread.
+	my $s = "\x{1ff}" . "f" x 32;
+	ok($s =~ /\x{1ff}[[:alpha:]]+/gca, "POSIXA pointer wrap");
+
+	# this one segfaulted under the conditions above
+	# of course, CANY is evil, maybe it should crash
+	ok($s =~ /.\C+/, "CANY pointer wrap");
+    }
 } # End of sub run_tests
 
 1;
diff --git a/gnu/usr.bin/perl/t/re/pos.t b/gnu/usr.bin/perl/t/re/pos.t
new file mode 100644
index 00000000000..14cc1fa1588
--- /dev/null
+++ b/gnu/usr.bin/perl/t/re/pos.t
@@ -0,0 +1,68 @@
+#!./perl
+
+# Make sure pos / resetting pos on failed match works
+
+use strict;
+use warnings;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 8;
+
+##  Early bailout of pp_match because matchlen > stringlen
+
+# With a var
+{
+	my $str = "bird";
+
+	$str =~ /i/g;
+
+	is(pos($str),  2, 'pos correct');
+
+	$str =~ /toolongtomatch/g;
+
+	is(pos($str), undef, 'pos undef after failed match');
+}
+
+# With $_
+{
+	$_ = "bird";
+
+	m/i/g;
+
+	is(pos, 2, 'pos correct');
+
+	m/toolongtomatch/g;
+
+	is(pos, undef, 'pos undef after failed match');
+}
+
+## Early bail out of pp_match because ?? already matched
+
+# With a var
+{
+	my $str = "bird";
+
+	for (1..2) {
+		if ($str =~ m?bird?g) {
+			is(pos($str),  4, 'pos correct');
+		} else {
+			is(pos($str), undef, 'pos undef after failed match');
+		}
+	}
+}
+
+# With $_
+{
+	for (1..2) {
+		if (m?\d?g) {
+			is(pos,  1, 'pos correct');
+		} else {
+			is(pos, undef, 'pos undef after failed match');
+		}
+	}
+}
diff --git a/gnu/usr.bin/perl/t/re/qr.t b/gnu/usr.bin/perl/t/re/qr.t
index 137877283c9..811f5c577d5 100755
--- a/gnu/usr.bin/perl/t/re/qr.t
+++ b/gnu/usr.bin/perl/t/re/qr.t
@@ -33,6 +33,7 @@ is(ref $rx, "Regexp", "qr// blessed into 'Regexp' by default");
 
  is $output, "5\n1: 5\n2: 5\n", '$a_match_var =~ /$qr/';
 }
+no warnings 'experimental::lexical_topic';
 for my $_($'){
  my $output = '';
  my $rx = qr/o/;
diff --git a/gnu/usr.bin/perl/t/re/re_tests b/gnu/usr.bin/perl/t/re/re_tests
index cfc813f0a36..0af345ae3e8 100644
--- a/gnu/usr.bin/perl/t/re/re_tests
+++ b/gnu/usr.bin/perl/t/re/re_tests
@@ -2,7 +2,8 @@
 # run this file via a shell glob.  The full format of this file is given
 # in regexp.t
 # Prior to the implementation of autoloading of \N{}, tests that used \N{name}
-# could not go in this file, and were farmed out to other .t's.
+# could not go in this file, and were farmed out to other .t's, where they
+# remain
 #
 # pat	string	y/n/etc	expr	expected-expr	skip-reason
 __END__
@@ -107,7 +108,7 @@ a[b-d]e	ace	y	$&	ace
 a[b-d]	aac	y	$&	ac
 a[-b]	a-	y	$&	a-
 a[b-]	a-	y	$&	a-
-a[b-a]	-	c	-	Invalid [] range \"b-a\"
+a[b-a]	-	c	-	Invalid [] range
 a[]b	-	c	-	Unmatched [
 a[	-	c	-	Unmatched [
 a]	a]	y	$&	a]
@@ -162,6 +163,7 @@ ab|cd	abcd	y	$&	ab
 ()ef	def	y	$&-$1	ef-
 ()ef	def	y	$-[0]	1
 ()ef	def	y	$+[0]	3
+()\x{100}\x{1000}	d\x{100}\x{1000}	y	$+[0]	3
 ()ef	def	y	$-[1]	1
 ()ef	def	y	$+[1]	1
 *a	-	c	-	Quantifier follows nothing
@@ -350,7 +352,7 @@ a[-]?c	ac	y	$&	ac
 'a[b-d]'i	AAC	y	$&	AC
 'a[-b]'i	A-	y	$&	A-
 'a[b-]'i	A-	y	$&	A-
-'a[b-a]'i	-	c	-	Invalid [] range \"b-a\"
+'a[b-a]'i	-	c	-	Invalid [] range
 'a[]b'i	-	c	-	Unmatched [
 'a['i	-	c	-	Unmatched [
 'a]'i	A]	y	$&	A]
@@ -480,7 +482,7 @@ a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
 (?<!c)b	cb	n	-	-
 (?<!c)b	b	y	-	-
 (?<!c)b	b	y	$&	b
-(?<%)b	-	c	-	Sequence (?<%...) not recognized
+(?<%)b	-	c	-	Group name must start with a non-digit word character
 (?:..)*a	aba	y	$&	aba
 (?:..)*?a	aba	y	$&	a
 ^(?:b|a(?=(.)))*\1	abc	y	$&	ab
@@ -534,12 +536,12 @@ a(?:b|(c|e){1,2}?|d)+?(.)	ace	y	$1$2	ce
 '(ab)\d\1'i	ab4Ab	y	$1	ab
 foo\w*\d{4}baz	foobar1234baz	y	$&	foobar1234baz
 a(?{})b	cabd	y	$&	ab
-a(?{)b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
-a(?{{})b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
+a(?{f()+	-	c	-	Missing right curly or square bracket
+a(?{{1}+	-	c	-	Missing right curly or square bracket
 a(?{}})b	-	c	-	
-a(?{"{"})b	-	c	-	Sequence (?{...}) not terminated or not {}-balanced
+a(?{"{"})b	ab	y	-	-
 a(?{"\{"})b	cabd	y	$&	ab
-a(?{"{"}})b	-	c	-	Unmatched right curly bracket
+a(?{"{"}})b	-	c	-	Sequence (?{...}) not terminated with ')'
 a(?{$::bl="\{"}).b	caxbd	y	$::bl	{
 x(~~)*(?:(?:F)?)?	x~~	y	-	-
 ^a(?#xxx){3}c	aaac	y	$&	aaac
@@ -580,8 +582,8 @@ x(~~)*(?:(?:F)?)?	x~~	y	-	-
 ^(\(+)?blah(?(1)(\)))$	blah	y	($2)	()
 ^(\(+)?blah(?(1)(\)))$	blah)	n	-	-
 ^(\(+)?blah(?(1)(\)))$	(blah	n	-	-
-(?(1?)a|b)	a	c	-	Switch condition not recognized
-(?(1)a|b|c)	a	c	-	Switch (?(condition)... contains too many branches
+(?(1?)a|b)	-	c	-	Switch condition not recognized
+(?(1)a|b|c)	-	c	-	Switch (?(condition)... contains too many branches
 (?(?{0})a|b)	a	n	-	-
 (?(?{0})b|a)	a	y	$&	a
 (?(?{1})b|a)	a	n	-	-
@@ -590,6 +592,10 @@ x(~~)*(?:(?:F)?)?	x~~	y	-	-
 (?(?!a)b|a)	a	y	$&	a
 (?(?=a)b|a)	a	n	-	-
 (?(?=a)a|b)	a	y	$&	a
+(?(?!\x{100})\x{100}|b)	\x{100}	n	-	-
+(?(?!\x{100})b|\x{100})	\x{100}	y	$&	\x{100}
+(?(?=\x{100})b|\x{100})	\x{100}	n	-	-
+(?(?=\x{100})\x{100}|b)	\x{100}	y	$&	\x{100}
 (?=(a+?))(\1ab)	aaab	y	$2	aab
 ^(?=(a+?))\1ab	aaab	n	-	-
 (\w+:)+	one:	y	$1	one:
@@ -615,8 +621,7 @@ $(?<=^(a))	a	y	$1	a
 [a[:xyz:	-	c	-	Unmatched [
 [a[:xyz:]	-	c	-	POSIX class [:xyz:] unknown
 [a[:]b[:c]	abc	y	$&	abc
-([a[:xyz:]b]+)	pbaq	c	-	POSIX class [:xyz:] unknown
-[a[:]b[:c]	abc	y	$&	abc
+([a[:xyz:]b]+)	-	c	-	POSIX class [:xyz:] unknown
 ([[:alpha:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	ABcd
 ([[:alnum:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	ABcd01Xy
 ([[:ascii:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	ABcd01Xy__--  ${nulnul}
@@ -633,6 +638,7 @@ $(?<=^(a))	a	y	$1	a
 ([[:^alpha:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	01
 ((?a)[[:^alnum:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	__--  ${nulnul}${ffff}
 ([[:^ascii:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	${ffff}
+([:[:^ascii:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	${ffff}	RT #120799
 ([[:^cntrl:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	ABcd01Xy__--  
 ([[:^digit:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	ABcd
 ([[:^lower:]]+)	ABcd01Xy__--  ${nulnul}${ffff}	y	$1	AB
@@ -648,8 +654,7 @@ $(?<=^(a))	a	y	$1	a
 (?>(a+))b	aaab	y	$1	aaa
 ((?>[^()]+)|\([^()]*\))+	((abc(ade)ufh()()x	y	$&	abc(ade)ufh()()x
 (?<=x+)y	-	c	-	Variable length lookbehind not implemented
-a{37,17}	-	c	-	Can't do {n,m} with n > m
-a{37,0}	-	c	-	Can't do {n,m} with n > m
+((def){37,17})?ABC	ABC	y	$&	ABC
 \Z	a\nb\n	y	$-[0]	3
 \z	a\nb\n	y	$-[0]	4
 $	a\nb\n	y	$-[0]	3
@@ -848,6 +853,7 @@ abb$	b\nca	n	-	-
 'abb\Z'm	b\nca	n	-	-
 'abb\z'm	b\nca	n	-	-
 'abb$'m	b\nca	n	-	-
+'\Aa$'m	a\n\n	y	$&	a
 (^|x)(c)	ca	y	$2	c
 a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz	x	n	-	-
 a(?{$a=2;$b=3;($b)=$a})b	yabz	y	$b	2
@@ -875,12 +881,18 @@ foo.bart	foo.bart	y	-	-
 .[X](.+)+[X][X]	bbbbXXXaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa	n	-	-
 .[X][X](.+)+[X]	bbbbXXXaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa	n	-	-
 tt+$	xxxtt	y	-	-
-([a-\d]+)	za-9z	y	$1	a-9
-([\d-z]+)	a0-za	y	$1	0-z
-([\d-\s]+)	a0- z	y	$1	0- 
-([a-[:digit:]]+)	za-9z	y	$1	a-9
-([[:digit:]-z]+)	=0-z=	y	$1	0-z
-([[:digit:]-[:alpha:]]+)	=0-z=	y	$1	0-z
+([a-\d]+)	za-9z	Sy	$1	a-9
+([a-\d]+)	-	sc	-	False [] range
+([\d-z]+)	a0-za	Sy	$1	0-z
+([\d-z]+)	-	sc	$1	False [] range
+([\d-\s]+)	a0- z	Sy	$1	0- 
+([\d-\s]+)	-	sc	$1	False [] range
+([a-[:digit:]]+)	za-9z	Sy	$1	a-9
+([a-[:digit:]]+)	-	sc	-	False [] range
+([[:digit:]-z]+)	=0-z=	Sy	$1	0-z
+([[:digit:]-z]+)	-	sc	c	False [] range
+([[:digit:]-[:alpha:]]+)	=0-z=	Sy	$1	0-z
+([[:digit:]-[:alpha:]]+)	-	sc	-	False [] range
 \GX.*X	aaaXbX	n	-	-
 (\d+\.\d+)	3.1415926	y	$1	3.1415926
 (\ba.{0,10}br)	have a web browser	y	$1	a web br
@@ -995,8 +1007,8 @@ a(b)??	abc	y	<$1>	<>	# undef [perl #16773]
 ^.{2,3}?((?:b|a|r)+?)\1\z	foobarbar	y	$1	bar
 ^(?:f|o|b){2,3}?((?:b|a|r)+?)\1\z	foobarbar	y	$1	bar
 .*a(?!(b|cd)*e).*f	......abef	n	-	-	# [perl #23030]
-x(?#	x	c	-	Sequence (?#... not terminated
-:x(?#:	x	c	-	Sequence (?#... not terminated
+x(?#	-	c	-	Sequence (?#... not terminated
+:x(?#:	-	c	-	Sequence (?#... not terminated
 (WORDS|WORD)S	WORDS	y	$1	WORD
 (X.|WORDS|X.|WORD)S	WORDS	y	$1	WORD
 (WORDS|WORLD|WORD)S	WORDS	y	$1	WORD
@@ -1081,9 +1093,9 @@ X(?<=foo.)[YZ]	..XfooXY..	y	pos	8
 (?P<n>foo|bar|baz)(?P<m>[ew]+)	snofooewa	yM	$+{m}	ew	miniperl cannot load Tie::Hash::NamedCapture
 (?P<n>foo)|(?P<n>bar)|(?P<n>baz)	snofooewa	yM	$+{n}	foo	miniperl cannot load Tie::Hash::NamedCapture
 (?P<n>foo)(??{ $+{n} })	snofooefoofoowaa	yM	$+{n}	foo	miniperl cannot load Tie::Hash::NamedCapture
-(?P<=n>foo|bar|baz)	snofooewa	c	-	Sequence (?P<=...) not recognized
-(?P<!n>foo|bar|baz)	snofooewa	c	-	Sequence (?P<!...) not recognized
-(?PX<n>foo|bar|baz)	snofooewa	c	-	Sequence (?PX<...) not recognized
+(?P<=n>foo|bar|baz)	-	c	-	Group name must start with a non-digit word character
+(?P<!n>foo|bar|baz)	-	c	-	Group name must start with a non-digit word character
+(?PX<n>foo|bar|baz)	-	c	-	Sequence (?PX<...) not recognized
 /(?'n'foo|bar|baz)/	snofooewa	y	$1	foo
 /(?'n'foo|bar|baz)/	snofooewa	yM	$+{n}	foo	miniperl cannot load Tie::Hash::NamedCapture
 /(?'n'foo|bar|baz)(?'m'[ew]+)/	snofooewa	yM	$+{n}	foo	miniperl cannot load Tie::Hash::NamedCapture
@@ -1261,30 +1273,30 @@ a*(*F)	aaaab	n	-	-
 /(?<_>foo) \k<_>/	..foo foo..	yM	$+{_}	foo	miniperl cannot load Tie::Hash::NamedCapture
 /(?'_0_'foo) \k'_0_'/	..foo foo..	yM	$+{_0_}	foo	miniperl cannot load Tie::Hash::NamedCapture
 /(?<_0_>foo) \k<_0_>/	..foo foo..	yM	$+{_0_}	foo	miniperl cannot load Tie::Hash::NamedCapture
-/(?'0'foo) bar/	..foo bar..	c	-	Sequence (?'
-/(?<0>foo) bar/	..foo bar..	c	-	Sequence (?<
-/(?'12'foo) bar/	..foo bar..	c	-	Sequence (?'
-/(?<12>foo) bar/	..foo bar..	c	-	Sequence (?<
-/(?'1a'foo) bar/	..foo bar..	c	-	Sequence (?'
-/(?<1a>foo) bar/	..foo bar..	c	-	Sequence (?<
-/(?''foo) bar/	..foo bar..	c	-	Sequence (?''
-/(?<>foo) bar/	..foo bar..	c	-	Sequence (?<>
-/foo \k'n'/	foo foo	c	-	Reference to nonexistent named group
-/foo \k<n>/	foo foo	c	-	Reference to nonexistent named group
-/foo \k'a1'/	foo foo	c	-	Reference to nonexistent named group
-/foo \k<a1>/	foo foo	c	-	Reference to nonexistent named group
-/foo \k'_'/	foo foo	c	-	Reference to nonexistent named group
-/foo \k<_>/	foo foo	c	-	Reference to nonexistent named group
-/foo \k'_0_'/	foo foo	c	-	Reference to nonexistent named group
-/foo \k<_0_>/	foo foo	c	-	Reference to nonexistent named group
-/foo \k'0'/	foo foo	c	-	Sequence \\k'
-/foo \k<0>/	foo foo	c	-	Sequence \\k<
-/foo \k'12'/	foo foo	c	-	Sequence \\k'
-/foo \k<12>/	foo foo	c	-	Sequence \\k<
-/foo \k'1a'/	foo foo	c	-	Sequence \\k'
-/foo \k<1a>/	foo foo	c	-	Sequence \\k<
-/foo \k''/	foo foo	c	-	Sequence \\k'
-/foo \k<>/	foo foo	c	-	Sequence \\k<
+/(?'0'foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?<0>foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?'12'foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?<12>foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?'1a'foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?<1a>foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?''foo) bar/	-	c	-	Group name must start with a non-digit word character
+/(?<>foo) bar/	-	c	-	Group name must start with a non-digit word character
+/foo \k'n'/	-	c	-	Reference to nonexistent named group
+/foo \k<n>/	-	c	-	Reference to nonexistent named group
+/foo \k'a1'/	-	c	-	Reference to nonexistent named group
+/foo \k<a1>/	-	c	-	Reference to nonexistent named group
+/foo \k'_'/	-	c	-	Reference to nonexistent named group
+/foo \k<_>/	-	c	-	Reference to nonexistent named group
+/foo \k'_0_'/	-	c	-	Reference to nonexistent named group
+/foo \k<_0_>/	-	c	-	Reference to nonexistent named group
+/foo \k'0'/	-	c	-	Group name must start with a non-digit word character
+/foo \k<0>/	-	c	-	Group name must start with a non-digit word character
+/foo \k'12'/	-	c	-	Group name must start with a non-digit word character
+/foo \k<12>/	-	c	-	Group name must start with a non-digit word character
+/foo \k'1a'/	-	c	-	Group name must start with a non-digit word character
+/foo \k<1a>/	-	c	-	Group name must start with a non-digit word character
+/foo \k''/	-	c	-	Group name must start with a non-digit word character
+/foo \k<>/	-	c	-	Group name must start with a non-digit word character
 /(?<as>as) (\w+) \k<as> (\w+)/	as easy as pie	y	$1-$2-$3	as-easy-pie
 
 # \g{...} with a name as the argument 
@@ -1433,7 +1445,8 @@ abc\N	abc\n	n
 # and bypasses the lexer.
 /\N{U+}/	-	c	-	Invalid hexadecimal number
 # Below currently gives a misleading message
-/[\N{U+}]/	-	c	-	Unmatched
+/[\N{U+}]/	-	Sc	-	Unmatched
+/[\N{U+}]/	-	sc	-	Syntax error in (?[...])
 /abc\N{def/	-	c	-	Missing right brace
 /\N{U+4AG3}/	-	c	-	Illegal hexadecimal digit
 /[\N{U+4AG3}]/	-	c	-	Illegal hexadecimal digit
@@ -1442,7 +1455,7 @@ abc\N	abc\n	n
 # figures it out.
 \N{U+}	-	c	-	Invalid hexadecimal number
 [\N{U+}]	-	c	-	Invalid hexadecimal number
-\N{U+4AG3}	-	c	-	Illegal hexadecimal digit
+\N{U+4AG3}	-	c	-	Invalid hexadecimal number
 [\N{U+4AG3}]	-	c	-	Invalid hexadecimal number
 abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 
@@ -1456,7 +1469,7 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 
 # Verify works in single quotish context; regex compiler delivers slightly different msg
 # \N{U+BEEF.BEAD} succeeds here, because can't completely hide it from the outside.
-\N{U+0xBEEF}	-	c	-	Illegal hexadecimal digit
+\N{U+0xBEEF}	-	c	-	Invalid hexadecimal number
 \c`	-	c	-	\"\\c`\" is more clearly written simply as \"\\ \"
 \c1	-	c	-	\"\\c1\" is more clearly written simply as \"q\"
 \cA	\001	y	$&	\1
@@ -1474,15 +1487,25 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 [a\o{400}]	\x{100}	y	$&	\x{100}
 [a\o{1000}]	\x{200}	y	$&	\x{200}
 
+# The below were inserting a NULL
+\87	87	y	$&	87
+a\87	a87	y	$&	a87
+a\97	a97	y	$&	a97
+
+
 # The below was inserting a NULL into the character class.
-[\8\9]	\000	n	-	-
-[\8\9]	8	y	$&	8
-[\8\9]	9	y	$&	9
+[\8\9]	\000	Sn	-	-
+[\8\9]	-	sc	$&	Unrecognized escape \\8 in character class
+[\8\9]	8	Sy	$&	8
+[\8\9]	9	Sy	$&	9
 
 # Verify that reads 1-3 octal digits, and that \_ works in char class
-[\0]	\000	y	$&	\000
-[\07]	\007	y	$&	\007
-[\07]	7\000	n	-	-
+[\0]	\000	Sy	$&	\000
+[\0]	-	sc	-	Need exactly 3 octal digits
+[\07]	\007	Sy	$&	\007
+[\07]	-	sc	-	Need exactly 3 octal digits
+[\07]	7\000	Sn	-	-
+[\07]	-	sc	-	Need exactly 3 octal digits
 [\006]	\006	y	$&	\006
 [\006]	6\000	n	-	-
 [\0005]	\0005	y	$&	\000
@@ -1524,7 +1547,7 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 # Normally 1E9E generates a multi-char fold, but not in inverted class;
 # See [perl #89750].  This makes sure that the simple fold gets generated
 # in that case, to DF.
-/[^\x{1E9E}]/i	\x{DF}	n	-	-
+/[^\x{1E9E}]/i	\x{DF}	Sn	-	-
 
 # RT #96354
 /^.*\d\H/	X1	n	-	-
@@ -1536,7 +1559,8 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 /^\p{L}/	\x{3400}	y	$&	\x{3400}
 
 # RT #89774
-/[s\xDF]/ui	\xDFs	ybT	$&	\xDFs
+/[s\xDF]a/ui	ssa	Sy	$&	ssa
+/[s\xDF]a/ui	sa	y	$&	sa
 
 # RT #99928
 /^\R\x0A$/	\x0D\x0A	n	-	-
@@ -1545,6 +1569,20 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 /ff/i	\x{FB01}\x{FB00}	y	$&	\x{FB00}
 /fi/i	\x{FB01}\x{FB00}	y	$&	\x{FB01}
 /fi/i	\x{FB00}\x{FB01}	y	$&	\x{FB01}
+#
+# Make sure we don't see code blocks where there aren't, and vice-versa
+(?#( (?{1+)a	a	y	-	-
+'a# (?{1+'x	a	y	-	-
+ab[(?{1]	ab1	y	-	-
+ab[(?{1\](?{2]	ab2	y	-	-
+ab(?{"["})cd	abcd	y	-	-
+ab(??{"[x]"})cd	abxcd	y	-	-
+ab\[(??{1})c	ab[1c	y	-	-
+ab\\[(??{1;})]c	ab\\;c	y	-	-
+ab\\\[(??{1})c	ab\\[1c	y	-	-
+ab[c\](??{"]d	abcd	y	-	-
+ab[c\\](??{"[x]"})d	ab\\xd	y	-	-
+ab[c\\\](??{"x"})]{3}d	ab\\](d	y	-	-
 
 # These test that doesn't cut-off matching too soon in the string for
 # multi-char folds
@@ -1595,11 +1633,120 @@ abc\N{def	-	c	-	\\N{NAME} must be resolved by the lexer
 /[[:word:]]/	\x{2c1}	y	-	-
 /[[:word:]]/	\x{2c2}	n	-	-
 
+# [perl #113400]
+/syntax OK\s+\z/si	t/bin/good.pl syntax OK\n	y	-	-
+
+/^(.*?)\s*\|\s*(?:\/\s*|)'(.+)'$/	text|'sec'	y	<$1><$2>	<text><sec>
+/^(foo|)bar$/	bar	y	<$&>	<bar>
+/^(foo||baz)bar$/	bar	y	<$&>	<bar>
+/^(foo||baz)bar$/	bazbar	y	<$1>	<baz>
+/^(foo||baz)bar$/	foobar	y	<$1>	<foo>
+
+/^(?:foo|)bar$/	bar	y	<$&>	<bar>
+/^(?:foo||baz)bar$/	bar	y	<$&>	<bar>
+/^(?:foo||baz)bar$/	bazbar	y	<$&>	<bazbar>
+/^(?:foo||baz)bar$/	foobar	y	<$&>	<foobar>
+
+/^(?i:foo|)bar$/	bar	y	<$&>	<bar>
+/^(?i:foo||baz)bar$/	bar	y	<$&>	<bar>
+/^(?i:foo||baz)bar$/	bazbar	y	<$&>	<bazbar>
+/^(?i:foo||baz)bar$/	foobar	y	<$&>	<foobar>
+
+# $^N, $+ on backtrackracking
+# BRANCH
+^(.)(?:(..)|B)[CX]	ABCDE	y	$^N-$+	A-A	-
+# TRIE
+^(.)(?:BC(.)|B)[CX]	ABCDE	y	$^N-$+	A-A	-
+# CURLYX
+^(.)(?:(.)+)*[BX]	ABCDE	y	$^N-$+	A-A	-
+# CURLYM
+^(.)(BC)*	ABCDE	y	$^N-$+	BC-BC	-
+^(.)(BC)*[BX]	ABCDE	y	$^N-$+	A-A	-
+# CURLYN
+^(.)(B)*.[DX]	ABCDE	y	$^N-$+	B-B	-
+^(.)(B)*.[CX]	ABCDE	y	$^N-$+	A-A	-
+
+# using 'return' in code blocks
+^(A)(?{"xyz"})B$	AB	y	$1-$^R	A-xyz	-
+^(A)(?{return "xyz"})B$	AB	y	$1-$^R	A-xyz	-
+^(A)((??{"xyz"}))$	Axyz	y	$1-$2	A-xyz	-
+^(A)((??{return "xyz"}))$	Axyz	y	$1-$2	A-xyz	-
+^(A)((?(?{1})abc|xyz))$	Aabc	y	$1-$2	A-abc	-
+^(A)((?(?{0})abc|xyz))$	Axyz	y	$1-$2	A-xyz	-
+^(A)((?(?{return 1})abc|xyz))$	Aabc	y	$1-$2	A-abc	-
+^(A)((?(?{return 0})abc|xyz))$	Axyz	y	$1-$2	A-xyz	-
+
+# pattern modifier flags should propagate into returned (??{}) pattern
+# p,d,l not tested
+
+/^(a)((??{"b"}))$/i	AB	y	$1-$2	A-B	-
+/^(A)((??{'B$'}))(\nC)$/m	AB\nC	y	$1-$2-$3	A-B-\nC	-
+/^(A)((??{'.'}))(B)$/s	A\nB	y	$1-$2-$3	A-\n-B	-
+/^(A) ((??{' .'}))(B)$/x	A B	y	$1-$2-$3	A- -B	-
+/^((??{'\d'}))$/a	\x{660}	n	-	-
+/^(??{"s"})$/i	\x{17F}	y	-	-
+/^(??{"s"})$/ia	\x{17F}	y	-	-
+/^(??{"s"})$/iaa	\x{17F}	n	-	-
+/^(??{'\w'})$/u	\x{AA}	y	-	-
+
+# #113670 ensure any captures to the right are invalidated when CURLY
+# and CURLYM backtrack
+
+^(?:(X)?(\d)|(X)?(\d\d))$	X12	y	$1-$2-$3-$4	--X-12
+^(?:(XX)?(\d)|(XX)?(\d\d))$	XX12	y	$1-$2-$3-$4	--XX-12
+
+# rt 113770
+\A(?>\[(?:(?:)(?:R){1}|T|V?|A)\])\z	[A]	y	$&	[A]
+# rt 114068
+/( [^z] $ [^z]+)/xm	aa\nbb\ncc\n	y	$1	a\nbb\ncc\n
+
 # [perl #114220]
 /[\h]/	\x{A0}	y	$&	\xA0
 /[\H]/	\x{BF}	y	$&	\xBF
 /[\H]/	\x{A0}	n	-	-
 /[\H]/	\x{A1}	y	$&	\xA1
 
+[^\n]+	\nb	y	$&	b
+[^\n]+	a\n	y	$&	a
+
+# /a has no effect on properties
+(?a:\p{Any})	\x{100}	y	$&	\x{100}
+(?aa:\p{Any})	\x{100}	y	$&	\x{100}
+
+\w	\x{200C}	y	$&	\x{200C}
+\W	\x{200C}	n	-	-
+\w	\x{200D}	y	$&	\x{200D}
+\W	\x{200D}	n	-	-
+
+/^(?d:\xdf|_)*_/i	\x{17f}\x{17f}_	y	$&	\x{17f}\x{17f}_
+#
+# check that @-, @+ count chars, not bytes; especially if beginning of
+# string is not copied
+
+(\x{100})	\x{2000}\x{2000}\x{2000}\x{100}	y	$-[0]:$-[1]:$+[0]:$+[1]	3:3:4:4
+
+^\R{2}$	\r\n\r\n	y	$&	\r\n\r\n
+
+/^\D{11}/a	\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}	n	-	-
+/^\S{11}/a	\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}	n	-	-
+/^\W{11}/a	\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}\x{10FFFF}	n	-	-
+
+# [ perl #114272]
+\Vn	\xFFn/	y	$&	\xFFn
+
+/(?l:a?\w)/	b	y	$&	b
+m?^xy\?$?	xy?	y	$&	xy?
 
 # vim: softtabstop=0 noexpandtab
+/[#]/	a#b	y	$&	#
+/[#]b/	a#b	y	$&	#b
+/[#]/x	a#b	y	$&	#
+/[#]b/x	a#b	y	$&	#b
+/[#](?{})/x	a#b	y	$&	#
+/[#](??{'b'})/x	a#b	y	$&	#b
+/(?#)(?{})b/	a#b	y	$&	b
+/(?#)(??{'b'})/	a#b	y	$&	b
+/[(?#](?{})b/	a#b	y	$&	#b
+/[(?#](??{'b'})/	a#b	y	$&	#b
+/(?#)(?{})b/x	a#b	y	$&	b
+/(?#)(??{'b'})/x	a#b	y	$&	b
diff --git a/gnu/usr.bin/perl/t/re/recompile.t b/gnu/usr.bin/perl/t/re/recompile.t
new file mode 100644
index 00000000000..63a70684be3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/re/recompile.t
@@ -0,0 +1,195 @@
+#!./perl
+
+# Check that we don't recompile runtime patterns when the pattern hasn't
+# changed
+#
+# Works by checking the debugging output of 'use re debug' and, if
+# available, -Dr. We use both to check that the different code paths
+# with Perl_foo() verses the my_foo() under ext/re/ don't cause any
+# changes.
+
+use strict;
+use warnings;
+
+$| = 1;
+
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib','.');
+    require './test.pl';
+    skip_all_if_miniperl("no dynamic loading on miniperl, no re");
+}
+
+
+plan tests => 38;
+
+my $results = runperl(
+			switches => [ '-Dr' ],
+			prog => '1',
+			stderr   => 1,
+		    );
+my $has_Dr = $results !~ /Recompile perl with -DDEBUGGING/;
+
+my $tmpfile = tempfile();
+
+
+# Check that a pattern triggers a regex compilation exactly N times,
+# using either -Dr or 'use re debug'
+# This is partially based on _fresh_perl() in test.pl
+
+sub _comp_n {
+    my ($use_Dr, $n, $prog, $desc) = @_;
+    open my $tf, ">$tmpfile" or die "Cannot open $tmpfile: $!";
+
+    my $switches = [];
+    if ($use_Dr) {
+	push @$switches, '-Dr';
+    }
+    else {
+	$prog = qq{use re qw(debug);\n$prog};
+    }
+
+    print $tf $prog;
+    close $tf or die "Cannot close $tmpfile: $!";
+    my $results = runperl(
+			switches => $switches,
+			progfile => $tmpfile,
+			stderr   => 1,
+		    );
+
+    my $status = $?;
+
+    my $count = () = $results =~ /Final program:/g;
+    if ($count == $n && !$status) {
+	pass($desc);
+    }
+    else {
+	fail($desc);
+        _diag "# COUNT:    $count EXPECTED $n\n";
+        _diag "# STATUS:   $status\n";
+        _diag "# SWITCHES: @$switches\n";
+        _diag "# PROG: \n$prog\n";
+	# this is verbose; uncomment for debugging
+        #_diag "# OUTPUT:\n------------------\n $results-------------------\n";
+    }
+}
+
+# Check that a pattern triggers a regex compilation exactly N times,
+
+sub comp_n {
+    my ($n, $prog, $desc) = @_;
+    if ($has_Dr) {
+	_comp_n(1, $n, $prog, "$desc -Dr");
+    }
+    else {
+	SKIP: {
+	    skip("-Dr not compiled in");
+	}
+    }
+    _comp_n(0, @_);
+}
+
+# Check that a pattern triggers a regex compilation exactly once.
+
+sub comp_1 {
+    comp_n(1, @_);
+}
+
+
+comp_1(<<'CODE', 'simple');
+"a" =~ /$_/ for qw(a a a);
+CODE
+
+comp_1(<<'CODE', 'simple qr');
+"a" =~ qr/$_/ for qw(a a a);
+CODE
+
+comp_1(<<'CODE', 'literal utf8');
+"a" =~ /$_/ for "\x{100}", "\x{100}", "\x{100}";
+CODE
+
+comp_1(<<'CODE', 'literal utf8 qr');
+"a" =~ qr/$_/ for "\x{100}", "\x{100}", "\x{100}";
+CODE
+
+comp_1(<<'CODE', 'longjmp literal utf8');
+my $x = chr(0x80);
+"a" =~ /$x$_/ for "\x{100}", "\x{100}", "\x{100}";
+CODE
+
+comp_1(<<'CODE', 'longjmp literal utf8 qr');
+my $x = chr(0x80);
+"a" =~ qr/$x$_/ for "\x{100}", "\x{100}", "\x{100}";
+CODE
+
+comp_1(<<'CODE', 'utf8');
+"a" =~ /$_/ for '\x{100}', '\x{100}', '\x{100}';
+CODE
+
+comp_1(<<'CODE', 'utf8 qr');
+"a" =~ qr/$_/ for '\x{100}', '\x{100}', '\x{100}';
+CODE
+
+comp_1(<<'CODE', 'longjmp utf8');
+my $x = chr(0x80);
+"a" =~ /$x$_/ for '\x{100}', '\x{100}', '\x{100}';
+CODE
+
+comp_1(<<'CODE', 'longjmp utf8');
+my $x = chr(0x80);
+"a" =~ qr/$x$_/ for '\x{100}', '\x{100}', '\x{100}';
+CODE
+
+comp_n(3, <<'CODE', 'mixed utf8');
+"a" =~ /$_/ for "\x{c4}\x{80}",  "\x{100}", "\x{c4}\x{80}";
+CODE
+
+comp_n(3, <<'CODE', 'mixed utf8 qr');
+"a" =~ qr/$_/ for "\x{c4}\x{80}",  "\x{100}", "\x{c4}\x{80}";
+CODE
+
+# note that that for runtime code, each pattern is compiled twice; the
+# second time to allow the parser to see the code.
+
+comp_n(6, <<'CODE', 'runtime code');
+my $x = '(?{1})';
+BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'"
+"a" =~ /a$_/ for $x, $x, $x;
+CODE
+
+comp_n(6, <<'CODE', 'runtime code qr');
+my $x = '(?{1})';
+BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'"
+"a" =~ qr/a$_/ for $x, $x, $x;
+CODE
+
+comp_n(4, <<'CODE', 'embedded code');
+my $x = qr/(?{1})/;
+"a" =~ /a$_/ for $x, $x, $x;
+CODE
+
+comp_n(4, <<'CODE', 'embedded code qr');
+my $x = qr/(?{1})/;
+"a" =~ qr/a$_/ for $x, $x, $x;
+CODE
+
+comp_n(7, <<'CODE', 'mixed code');
+my $x = qr/(?{1})/;
+my $y = '(?{1})';
+BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'"
+"a" =~ /a$x$_/ for $y, $y, $y;
+CODE
+
+comp_n(7, <<'CODE', 'mixed code qr');
+my $x = qr/(?{1})/;
+my $y = '(?{1})';
+BEGIN { $^H |= 0x00200000 } # lightweight "use re 'eval'"
+"a" =~ qr/a$x$_/ for $y, $y, $y;
+CODE
+
+comp_n(6, <<'CODE', 'embedded code qr');
+my $x = qr/a/i;
+my $y = qr/a/;
+"a" =~ qr/a$_/ for $x, $y, $x, $y;
+CODE
diff --git a/gnu/usr.bin/perl/t/re/reg_eval_scope.t b/gnu/usr.bin/perl/t/re/reg_eval_scope.t
index 00e7d99feca..7eddf87ed33 100644
--- a/gnu/usr.bin/perl/t/re/reg_eval_scope.t
+++ b/gnu/usr.bin/perl/t/re/reg_eval_scope.t
@@ -9,13 +9,7 @@ BEGIN {
     skip_all_if_miniperl("no dynamic loading on miniperl, no re");
 }
 
-plan 18;
-
-# Functions for turning to-do-ness on and off (as there are so many
-# to-do tests) 
-sub on { $::TODO = "(?{}) implementation is screwy" }
-sub off { undef $::TODO }
-
+plan 48;
 
 fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  my $x = 7; my $a = 4; my $b = 5;
@@ -23,8 +17,6 @@ fresh_perl_is <<'CODE', '781745', {}, '(?{}) has its own lexical scope';
  print $x,$a,$b;
 CODE
 
-on;
-
 fresh_perl_is <<'CODE',
  for my $x("a".."c") {
   $y = 1;
@@ -44,8 +36,6 @@ CODE
   {},
  'multiple (?{})s in loop with lexicals';
 
-off;
-
 fresh_perl_is <<'CODE', '781745', {}, 'run-time re-eval has its own scope';
  use re qw(eval);
  my $x = 7;  my $a = 4; my $b = 5;
@@ -88,32 +78,26 @@ fresh_perl_is <<'CODE', '178279371047857967101745', {},
 CODE
  'multiple (?{})s in "foo" =~ /$string/x';
 
-on;
-
 fresh_perl_is <<'CODE', '123123', {},
   for my $x(1..3) {
-   push @regexps = qr/(?{ print $x })a/;
+   push @regexps, qr/(?{ print $x })a/;
   }
  "a" =~ $_ for @regexps;
  "ba" =~ /b$_/ for @regexps;
 CODE
  'qr/(?{})/ is a closure';
 
-off;
-
 "a" =~ do { package foo; qr/(?{ $::pack = __PACKAGE__ })a/ };
 is $pack, 'foo', 'qr// inherits package';
 "a" =~ do { use re "/x"; qr/(?{ $::re = qr-- })a/ };
 is $re, '(?^x:)', 'qr// inherits pragmata';
 
-on;
-
+$::pack = '';
 "ba" =~ /b${\do { package baz; qr|(?{ $::pack = __PACKAGE__ })a| }}/;
 is $pack, 'baz', '/text$qr/ inherits package';
 "ba" =~ m+b${\do { use re "/i"; qr|(?{ $::re = qr-- })a| }}+;
 is $re, '(?^i:)', '/text$qr/ inherits pragmata';
 
-off;
 {
   use re 'eval';
   package bar;
@@ -126,38 +110,261 @@ is $pack, 'bar', '/$text/ containing (?{}) inherits package';
 }
 is $re, '(?^m:)', '/$text/ containing (?{}) inherits pragmata';
 
-on;
-
 fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{die})';
- eval { my $a=4; my $b=5; "a" =~ /(?{die})a/ }; print $a,$b"
+my $a=4; my $b=5;  eval { "a" =~ /(?{die})a/ }; print $a,$b;
+CODE
+
+fresh_perl_is <<'CODE', 'Y45', { stderr => 1 }, '(?{eval{die}})';
+my $a=4; my $b=5;
+"a" =~ /(?{eval { die; print "X" }; print "Y"; })a/; print $a,$b;
+CODE
+
+fresh_perl_is <<'CODE',
+    my $a=4; my $b=5;
+    sub f { "a" =~ /(?{print((caller(0))[3], "\n");})a/ };
+    f();
+    print $a,$b;
+CODE
+    "main::f\n45",
+    { stderr => 1 }, 'sub f {(?{caller})}';
+
+
+fresh_perl_is <<'CODE',
+    my $a=4; my $b=5;
+    sub f { print ((caller(0))[3], "-", (caller(1))[3], "-\n") };
+    "a" =~ /(?{f()})a/;
+    print $a,$b;
+CODE
+    "main::f--\n45",
+    { stderr => 1 }, 'sub f {caller} /(?{f()})/';
+
+
+fresh_perl_is <<'CODE',
+    my $a=4; my $b=5;
+    sub f {
+	"a" =~ /(?{print "X"; return; print "Y"; })a/;
+	print "Z";
+    };
+    f();
+    print $a,$b;
+CODE
+    "XZ45",
+    { stderr => 1 }, 'sub f {(?{return})}';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; "a" =~ /(?{last})a/; print $a,$b
+CODE
+    q{Can't "last" outside a loop block at - line 1.},
+    { stderr => 1 }, '(?{last})';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; "a" =~ /(?{for (1..4) {last}})a/; print $a,$b
+CODE
+    '45',
+    { stderr => 1 }, '(?{for {last}})';
+
+
+fresh_perl_is <<'CODE',
+for (1) {  my $a=4; my $b=5; "a" =~ /(?{last})a/ }; print $a,$b
+CODE
+    q{Can't "last" outside a loop block at - line 1.},
+    { stderr => 1 }, 'for (1) {(?{last})}';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; eval { "a" =~ /(?{last})a/ }; print $a,$b
+CODE
+    '45',
+    { stderr => 1 }, 'eval {(?{last})}';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; "a" =~ /(?{next})a/; print $a,$b
+CODE
+    q{Can't "next" outside a loop block at - line 1.},
+    { stderr => 1 }, '(?{next})';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; "a" =~ /(?{for (1,2,3) { next} })a/; print $a,$b
 CODE
+    '45',
+    { stderr => 1 }, '(?{for {next}})';
 
-SKIP: {
-    # The remaining TODO tests crash, which will display an error dialog
-    # on Windows that has to be manually dismissed.  We don't want this
-    # to happen for release builds: 5.14.x, 5.16.x etc.
-    # On UNIX, they produce ugly 'Aborted' shell output mixed in with the
-    # test harness output, so skip on all platforms.
-    skip "Don't run crashing TODO test on release build", 3
-	if $::TODO && (int($]*1000) & 1) == 0;
 
-    fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{last})';
-     {  my $a=4; my $b=5; "a" =~ /(?{last})a/ }; print $a,$b
+fresh_perl_is <<'CODE',
+for (1) {  my $a=4; my $b=5; "a" =~ /(?{next})a/ }; print $a,$b
+CODE
+    q{Can't "next" outside a loop block at - line 1.},
+    { stderr => 1 }, 'for (1) {(?{next})}';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5; eval { "a" =~ /(?{next})a/ }; print $a,$b
 CODE
-    fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{next})';
-     {  my $a=4; my $b=5; "a" =~ /(?{last})a/ }; print $a,$b
+    '45',
+    { stderr => 1 }, 'eval {(?{next})}';
+
+
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5;
+"a" =~ /(?{ goto FOO; print "X"; })a/;
+print "Y";
+FOO:
+print $a,$b
 CODE
-    fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{return})';
-     print sub {  my $a=4; my $b=5; "a" =~ /(?{return $a.$b})a/ }->();
+    q{Can't "goto" out of a pseudo block at - line 2.},
+    { stderr => 1 }, '{(?{goto})}';
+
+
+{
+    local $::TODO = "goto doesn't yet work in pseduo blocks";
+fresh_perl_is <<'CODE',
+my $a=4; my $b=5;
+"a" =~ /(?{ goto FOO; print "X"; FOO: print "Y"; })a/;
+print "Z";
+FOO;
+print $a,$b
 CODE
+    "YZ45",
+    { stderr => 1 }, '{(?{goto FOO; FOO:})}';
 }
 
-fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{goto})';
-  my $a=4; my $b=5; "a" =~ /(?{goto _})a/; die; _: print $a,$b
+# [perl #3590]
+fresh_perl_is <<'CODE', '', { stderr => 1 }, '(?{eval{die}})';
+"$_$_$_"; my $foo; # these consume pad entries and ensure a SEGV on opd perls
+"" =~ m{(?{exit(0)})};
 CODE
 
-off;
 
 # [perl #92256]
 { my $y = "a"; $y =~ /a(?{ undef *_ })/ }
 pass "undef *_ in a re-eval does not cause a double free";
+
+# make sure regexp warnings are reported on the right line
+# (we don't care what warning; the 32768 limit is just one
+# that was easy to reproduce) */
+{
+    use warnings;
+    my $w;
+    local $SIG{__WARN__} = sub { $w = "@_" };
+    my $qr = qr/(??{'a'})/;
+    my $filler = 1;
+    ("a" x 40_000) =~ /^$qr(ab*)+/; my $line = __LINE__;
+    like($w, qr/recursion limit.* line $line\b/, "warning on right line");
+}
+
+# on immediate exit from pattern with code blocks, make sure PL_curcop is
+# restored
+
+{
+    use re 'eval';
+
+    my $c = '(?{"1"})';
+    my $w = '';
+    my $l;
+
+    local $SIG{__WARN__} = sub { $w .= "@_" };
+    $l = __LINE__; "1" =~ /^1$c/x and warn "foo";
+    like($w, qr/foo.+line $l/, 'curcop 1');
+
+    $w = '';
+    $l = __LINE__; "4" =~ /^1$c/x or warn "foo";
+    like($w, qr/foo.+line $l/, 'curcop 2');
+
+    $c = '(??{"1"})';
+    $l = __LINE__; "1" =~ /^$c/x and warn "foo";
+    like($w, qr/foo.+line $l/, 'curcop 3');
+
+    $w = '';
+    $l = __LINE__; "4" =~ /^$c/x or warn "foo";
+    like($w, qr/foo.+line $l/, 'curcop 4');
+}
+
+# [perl #113928] caller behaving unexpectedly in re-evals
+#
+#   /(?{...})/ should be in the same caller scope as the surrounding code;
+# qr/(?{...})/ should be in an anon sub
+
+{
+
+    my $l;
+
+    sub callers {
+	my @c;
+	my $stack = '';
+	my $i = 1;
+	while (@c = caller($i++)) {
+	    $stack .= "($c[3]:" . ($c[2] - $l) . ')';
+	}
+	$stack;
+    }
+
+    $l = __LINE__;
+    my $c;
+    is (callers(), '', 'callers() null');
+    "" =~ /(?{ $c = callers() })/;
+    is ($c, '', 'callers() //');
+
+    $l = __LINE__;
+    sub m1 { "" =~ /(?{ $c = callers() })/; }
+    m1();
+    is ($c, '(main::m1:2)', 'callers() m1');
+
+    $l = __LINE__;
+    my $r1 = qr/(?{ $c = callers() })/;
+    "" =~ /$r1/;
+    is ($c, '(main::__ANON__:2)', 'callers() r1');
+
+    $l = __LINE__;
+    sub r1 { "" =~ /$r1/; }
+    r1();
+    is ($c, '(main::__ANON__:1)(main::r1:2)', 'callers() r1/r1');
+
+    $l = __LINE__;
+    sub c2 { $c = callers() }
+    my $r2 = qr/(?{ c2 })/;
+    "" =~ /$r2/;
+    is ($c, '(main::c2:2)(main::__ANON__:3)', 'callers() r2/c2');
+    sub r2 { "" =~ /$r2/; }
+    r2();
+    is ($c, '(main::c2:2)(main::__ANON__:5)(main::r2:6)', 'callers() r2/r2/c2');
+
+    $l = __LINE__;
+    sub c3 { $c = callers() }
+    my $r3 = qr/(?{ c3 })/;
+    my $c1;
+    "ABC" =~ /A(?{ $c1 = callers() })B${r3}C/;
+    is ($c, '(main::c3:2)(main::__ANON__:4)', 'callers() r3/c3');
+    is ($c1,'', 'callers() r3/c3 part 2');
+    sub r3 { "ABC" =~ /A(?{ $c1 = callers() })B${r3}C/; }
+    r3();
+    is ($c, '(main::c3:2)(main::__ANON__:7)(main::r3:8)', 'callers() r3/r3/c3');
+    is ($c1,'(main::r3:8)', 'callers() r3/r3/c3 part 2');
+
+}
+
+# [perl #113928] caller behaving unexpectedly in re-evals
+#
+# make sure __SUB__ within a code block returns something safe.
+# NB waht it actually returns is subject to change
+
+{
+
+    my $s;
+
+    sub f1 { /(?{ $s = CORE::__SUB__; })/ }
+    f1();
+    is ($s, \&f1, '__SUB__ direct');
+
+    my $r = qr/(?{ $s = CORE::__SUB__; })/;
+    sub f2 { "" =~ $r }
+    f2();
+    is ($s, \&f2, '__SUB__ qr');
+
+    sub f3 { "AB" =~ /A${r}B/ }
+    f3();
+    is ($s, \&f3, '__SUB__ qr multi');
+}
diff --git a/gnu/usr.bin/perl/t/re/reg_fold.t b/gnu/usr.bin/perl/t/re/reg_fold.t
index a4fe6fa63bc..9e97ddd2f91 100755
--- a/gnu/usr.bin/perl/t/re/reg_fold.t
+++ b/gnu/usr.bin/perl/t/re/reg_fold.t
@@ -12,10 +12,50 @@ use warnings;
 my @tests;
 
 my $file="../lib/unicore/CaseFolding.txt";
-open my $fh,"<",$file or die "Failed to read '$file': $!";
-while (<$fh>) {
+my @folds;
+use Unicode::UCD;
+
+# Use the Unicode data file if we are on an ASCII platform (which its data is
+# for), and it is in the modern format (starting in Unicode 3.1.0) and it is
+# available.  This avoids being affected by potential bugs introduced by other
+# layers of Perl
+if (ord('A') == 65
+    && pack("C*", split /\./, Unicode::UCD::UnicodeVersion()) ge v3.1.0
+    && open my $fh, "<", $file)
+{
+    @folds = <$fh>;
+}
+else {
+    my ($invlist_ref, $invmap_ref, undef, $default)
+                                    = Unicode::UCD::prop_invmap('Case_Folding');
+    for my $i (0 .. @$invlist_ref - 1 - 1) {
+        next if $invmap_ref->[$i] == $default;
+        my $adjust = -1;
+        for my $j ($invlist_ref->[$i] .. $invlist_ref->[$i+1] -1) {
+            $adjust++;
+
+            # Single-code point maps go to a 'C' type
+            if (! ref $invmap_ref->[$i]) {
+                push @folds, sprintf("%04X; C; %04X\n",
+                                     $j,
+                                     $invmap_ref->[$i] + $adjust);
+            }
+            else {  # Multi-code point maps go to 'F'.  prop_invmap()
+                    # guarantees that no adjustment is needed for these,
+                    # as the range will contain just one element
+                push @folds, sprintf("%04X; F; %s\n",
+                                    $j,
+                                    join " ", map { sprintf "%04X", $_ }
+                                                    @{$invmap_ref->[$i]});
+            }
+        }
+    }
+}
+
+for  (@folds) {
     chomp;
     my ($line,$comment)= split/\s+#\s+/, $_;
+    $comment = "" unless defined $comment;
     my ($cp,$type,@folded)=split/[\s;]+/,$line||'';
     next unless $type and ($type eq 'F' or $type eq 'C');
     my $fold_above_latin1 = grep { hex("0x$_") > 255 } @folded;
@@ -36,7 +76,11 @@ while (<$fh>) {
                 $lhs = $chr;
                 $rhs = "";
                 foreach my $rhs_char (@folded) {
-                    $rhs .= '[' if $charclass;
+
+                    # The colon is an unrelated character to the rest of the
+                    # class, and makes sure no optimization into an EXACTish
+                    # node occurs.
+                    $rhs .= '[:' if $charclass;
                     $rhs .=  $rhs_char;
                     $rhs .= ']' if $charclass;
                 }
@@ -111,11 +155,12 @@ for my $i (0 .. 255) {
 
 push @tests, qq[like chr(0x0430), qr/[=\x{0410}-\x{0411}]/i, 'Bug #71752 Unicode /i char in a range'];
 push @tests, qq[like 'a', qr/\\p{Upper}/i, "'a' =~ /\\\\p{Upper}/i"];
-push @tests, q[my $c = "\x{212A}"; my $p = qr/(?:^[\x{004B}_]+$)/i; utf8::upgrade($p); like $c, $p, 'Bug #78994: my $c = "\x{212A}"; my $p = qr/(?:^[\x{004B}_]+$)/i; utf8::upgrade($p); $c =~ $p'];
+push @tests, q[my $c = "\x{212A}"; my $p = qr/(?:^[K_]+$)/i; utf8::upgrade($p); like $c, $p, 'Bug #78994: my $c = "\x{212A}"; my $p = qr/(?:^[K_]+$)/i; utf8::upgrade($p); $c =~ $p'];
 
 use charnames ":full";
-push @tests, q[my $re1 = "\N{WHITE SMILING FACE}";like "\xE8", qr/[\w$re1]/, 'my $re = "\N{WHITE SMILING FACE}"; "\xE8" =~ qr/[\w$re]/'];
-push @tests, q[my $re2 = "\N{WHITE SMILING FACE}";like "\xE8", qr/\w|$re2/, 'my $re = "\N{WHITE SMILING FACE}"; "\xE8" =~ qr/\w|$re/'];
+my $e_grave = latin1_to_native("\xE8");
+push @tests, q[my $re1 = "\N{WHITE SMILING FACE}";like $e_grave, qr/[\w$re1]/, 'my $re = "\N{WHITE SMILING FACE}"; $e_grave =~ qr/[\w$re]/'];
+push @tests, q[my $re2 = "\N{WHITE SMILING FACE}";like $e_grave, qr/\w|$re2/, 'my $re = "\N{WHITE SMILING FACE}"; $e_grave =~ qr/\w|$re/'];
 
 eval join ";\n","plan tests=>". (scalar @tests), @tests, "1"
     or die $@;
diff --git a/gnu/usr.bin/perl/t/re/reg_mesg.t b/gnu/usr.bin/perl/t/re/reg_mesg.t
index d6b343b1c3a..2e936b7aa6f 100755
--- a/gnu/usr.bin/perl/t/re/reg_mesg.t
+++ b/gnu/usr.bin/perl/t/re/reg_mesg.t
@@ -15,12 +15,29 @@ use strict;
 ## arrays below. The {#} is a meta-marker -- it marks where the marker should
 ## go.
 ##
+## Returns empty string if that is what is expected.  Otherwise, handles
+## either a scalar, turning it into a single element array; or a ref to an
+## array, adjusting each element.  If called in array context, returns an
+## array, otherwise the join of all elements
+
 sub fixup_expect {
-    my $expect = shift;
-    $expect =~ s/{\#}/<-- HERE/;
-    $expect =~ s/{\#}/ <-- HERE /;
-    $expect .= " at ";
-    return $expect;
+    my $expect_ref = shift;
+    return if $expect_ref eq "";
+
+    my @expect;
+    if (ref $expect_ref) {
+        @expect = @$expect_ref;
+    }
+    else {
+        @expect = $expect_ref;
+    }
+
+    foreach my $element (@expect) {
+        $element =~ s/{\#}/in regex; marked by <-- HERE in/;
+        $element =~ s/{\#}/ <-- HERE /;
+        $element .= " at ";
+    }
+    return wantarray ? @expect : join "", @expect;
 }
 
 my $inf_m1 = ($Config::Config{reg_infty} || 32767) - 1;
@@ -31,119 +48,272 @@ my $inf_p1 = $inf_m1 + 2;
 ##
 my @death =
 (
- '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=foo=]{#}]/',
+ '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/',
 
  '/(?<= .*)/' =>  'Variable length lookbehind not implemented in regex m/(?<= .*)/',
 
  '/(?<= x{1000})/' => 'Lookbehind longer than 255 not implemented in regex m/(?<= x{1000})/',
 
- '/(?@)/' => 'Sequence (?@...) not implemented in regex; marked by {#} in m/(?@{#})/',
-
- '/(?{ 1/' => 'Sequence (?{...}) not terminated or not {}-balanced in regex; marked by {#} in m/(?{{#} 1/',
+ '/(?@)/' => 'Sequence (?@...) not implemented {#} m/(?@{#})/',
 
- '/(?(1x))/' => 'Switch condition not recognized in regex; marked by {#} in m/(?(1x{#}))/',
+ '/(?{ 1/' => 'Missing right curly or square bracket',
 
- '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches in regex; marked by {#} in m/(?(1)x|y|{#}z)/',
+ '/(?(1x))/' => 'Switch condition not recognized {#} m/(?(1x{#}))/',
 
- '/(?(x)y|x)/' => 'Unknown switch condition (?(x) in regex; marked by {#} in m/(?({#}x)y|x)/',
+ '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches {#} m/(?(1)x|y|{#}z)/',
 
- '/(?/' => 'Sequence (? incomplete in regex; marked by {#} in m/(?{#}/',
+ '/(?(x)y|x)/' => 'Unknown switch condition (?(x) {#} m/(?({#}x)y|x)/',
 
- '/(?;x/' => 'Sequence (?;...) not recognized in regex; marked by {#} in m/(?;{#}x/',
- '/(?<;x/' => 'Sequence (?<;...) not recognized in regex; marked by {#} in m/(?<;{#}x/',
+ '/(?/' => 'Sequence (? incomplete {#} m/(?{#}/',
 
- '/(?\ix/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}ix/',
- '/(?\mx/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}mx/',
- '/(?\:x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}:x/',
- '/(?\=x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}=x/',
- '/(?\!x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}!x/',
- '/(?\<=x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}<=x/',
- '/(?\<!x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}<!x/',
- '/(?\>x/' => 'Sequence (?\...) not recognized in regex; marked by {#} in m/(?\{#}>x/',
- '/(?^-i:foo)/' => 'Sequence (?^-...) not recognized in regex; marked by {#} in m/(?^-{#}i:foo)/',
- '/(?^-i)foo/' => 'Sequence (?^-...) not recognized in regex; marked by {#} in m/(?^-{#}i)foo/',
- '/(?^d:foo)/' => 'Sequence (?^d...) not recognized in regex; marked by {#} in m/(?^d{#}:foo)/',
- '/(?^d)foo/' => 'Sequence (?^d...) not recognized in regex; marked by {#} in m/(?^d{#})foo/',
- '/(?^lu:foo)/' => 'Regexp modifiers "l" and "u" are mutually exclusive in regex; marked by {#} in m/(?^lu{#}:foo)/',
- '/(?^lu)foo/' => 'Regexp modifiers "l" and "u" are mutually exclusive in regex; marked by {#} in m/(?^lu{#})foo/',
-'/(?da:foo)/' => 'Regexp modifiers "d" and "a" are mutually exclusive in regex; marked by {#} in m/(?da{#}:foo)/',
-'/(?lil:foo)/' => 'Regexp modifier "l" may not appear twice in regex; marked by {#} in m/(?lil{#}:foo)/',
-'/(?aaia:foo)/' => 'Regexp modifier "a" may appear a maximum of twice in regex; marked by {#} in m/(?aaia{#}:foo)/',
-'/(?i-l:foo)/' => 'Regexp modifier "l" may not appear after the "-" in regex; marked by {#} in m/(?i-l{#}:foo)/',
+ '/(?;x/' => 'Sequence (?;...) not recognized {#} m/(?;{#}x/',
+ '/(?<;x/' => 'Group name must start with a non-digit word character {#} m/(?<;{#}x/',
+ '/(?\ix/' => 'Sequence (?\...) not recognized {#} m/(?\{#}ix/',
+ '/(?\mx/' => 'Sequence (?\...) not recognized {#} m/(?\{#}mx/',
+ '/(?\:x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}:x/',
+ '/(?\=x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}=x/',
+ '/(?\!x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}!x/',
+ '/(?\<=x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}<=x/',
+ '/(?\<!x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}<!x/',
+ '/(?\>x/' => 'Sequence (?\...) not recognized {#} m/(?\{#}>x/',
+ '/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
+ '/(?^-i)foo/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i)foo/',
+ '/(?^d:foo)/' => 'Sequence (?^d...) not recognized {#} m/(?^d{#}:foo)/',
+ '/(?^d)foo/' => 'Sequence (?^d...) not recognized {#} m/(?^d{#})foo/',
+ '/(?^lu:foo)/' => 'Regexp modifiers "l" and "u" are mutually exclusive {#} m/(?^lu{#}:foo)/',
+ '/(?^lu)foo/' => 'Regexp modifiers "l" and "u" are mutually exclusive {#} m/(?^lu{#})foo/',
+'/(?da:foo)/' => 'Regexp modifiers "d" and "a" are mutually exclusive {#} m/(?da{#}:foo)/',
+'/(?lil:foo)/' => 'Regexp modifier "l" may not appear twice {#} m/(?lil{#}:foo)/',
+'/(?aaia:foo)/' => 'Regexp modifier "a" may appear a maximum of twice {#} m/(?aaia{#}:foo)/',
+'/(?i-l:foo)/' => 'Regexp modifier "l" may not appear after the "-" {#} m/(?i-l{#}:foo)/',
 
- '/((x)/' => 'Unmatched ( in regex; marked by {#} in m/({#}(x)/',
+ '/((x)/' => 'Unmatched ( {#} m/({#}(x)/',
 
- "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 in regex; marked by {#} in m/x{{#}$inf_p1}/",
+ "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 {#} m/x{{#}$inf_p1}/",
 
- '/x{3,1}/' => 'Can\'t do {n,m} with n > m in regex; marked by {#} in m/x{3,1}{#}/',
 
- '/x**/' => 'Nested quantifiers in regex; marked by {#} in m/x**{#}/',
+ '/x**/' => 'Nested quantifiers {#} m/x**{#}/',
 
- '/x[/' => 'Unmatched [ in regex; marked by {#} in m/x[{#}/',
+ '/x[/' => 'Unmatched [ {#} m/x[{#}/',
 
- '/*/', => 'Quantifier follows nothing in regex; marked by {#} in m/*{#}/',
+ '/*/', => 'Quantifier follows nothing {#} m/*{#}/',
 
- '/\p{x/' => 'Missing right brace on \p{} in regex; marked by {#} in m/\p{{#}x/',
+ '/\p{x/' => 'Missing right brace on \p{} {#} m/\p{{#}x/',
 
- '/[\p{x]/' => 'Missing right brace on \p{} in regex; marked by {#} in m/[\p{{#}x]/',
+ '/[\p{x]/' => 'Missing right brace on \p{} {#} m/[\p{{#}x]/',
 
- '/(x)\2/' => 'Reference to nonexistent group in regex; marked by {#} in m/(x)\2{#}/',
+ '/(x)\2/' => 'Reference to nonexistent group {#} m/(x)\2{#}/',
 
  'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/',
 
- '/\x{1/' => 'Missing right brace on \x{} in regex; marked by {#} in m/\x{{#}1/',
-
- '/[\x{X]/' => 'Missing right brace on \x{} in regex; marked by {#} in m/[\x{{#}X]/',
-
- '/[[:barf:]]/' => 'POSIX class [:barf:] unknown in regex; marked by {#} in m/[[:barf:]{#}]/',
-
- '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions in regex; marked by {#} in m/[[=barf=]{#}]/',
-
- '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions in regex; marked by {#} in m/[[.barf.]{#}]/',
-  
- '/[z-a]/' => 'Invalid [] range "z-a" in regex; marked by {#} in m/[z-a{#}]/',
-
- '/\p/' => 'Empty \p{} in regex; marked by {#} in m/\p{#}/',
-
- '/\P{}/' => 'Empty \P{} in regex; marked by {#} in m/\P{{#}}/',
+ '/\x{1/' => 'Missing right brace on \x{} {#} m/\x{1{#}/',
+ '/\x{X/' => 'Missing right brace on \x{} {#} m/\x{{#}X/',
+
+ '/[\x{X]/' => 'Missing right brace on \x{} {#} m/[\x{{#}X]/',
+ '/[\x{A]/' => 'Missing right brace on \x{} {#} m/[\x{A{#}]/',
+
+ '/\o{1/' => 'Missing right brace on \o{ {#} m/\o{1{#}/',
+ '/\o{X/' => 'Missing right brace on \o{ {#} m/\o{{#}X/',
+
+ '/[\o{X]/' => 'Missing right brace on \o{ {#} m/[\o{{#}X]/',
+ '/[\o{7]/' => 'Missing right brace on \o{ {#} m/[\o{7{#}]/',
+
+ '/[[:barf:]]/' => 'POSIX class [:barf:] unknown {#} m/[[:barf:]{#}]/',
+
+ '/[[=barf=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=barf=]{#}]/',
+
+ '/[[.barf.]]/' => 'POSIX syntax [. .] is reserved for future extensions {#} m/[[.barf.]{#}]/',
+
+ '/[z-a]/' => 'Invalid [] range "z-a" {#} m/[z-a{#}]/',
+
+ '/\p/' => 'Empty \p{} {#} m/\p{#}/',
+
+ '/\P{}/' => 'Empty \P{} {#} m/\P{{#}}/',
+ '/(?[[[:word]]])/' => "Unmatched ':' in POSIX class {#} m/(?[[[:word{#}]]])/",
+ '/(?[[:word]])/' => "Unmatched ':' in POSIX class {#} m/(?[[:word{#}]])/",
+ '/(?[[[:digit: ])/' => "Unmatched '[' in POSIX class {#} m/(?[[[:digit:{#} ])/",
+ '/(?[[:digit: ])/' => "Unmatched '[' in POSIX class {#} m/(?[[:digit:{#} ])/",
+ '/(?[[[::]]])/' => "POSIX class [::] unknown {#} m/(?[[[::]{#}]])/",
+ '/(?[[[:w:]]])/' => "POSIX class [:w:] unknown {#} m/(?[[[:w:]{#}]])/",
+ '/(?[[:w:]])/' => "POSIX class [:w:] unknown {#} m/(?[[:w:]{#}])/",
+ '/(?[a])/' =>  'Unexpected character {#} m/(?[a{#}])/',
+ '/(?[\t])/l' => '(?[...]) not valid in locale {#} m/(?[{#}\t])/',
+ '/(?[ + \t ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/(?[ +{#} \t ])/',
+ '/(?[ \cK - ( + \t ) ])/' => 'Unexpected binary operator \'+\' with no preceding operand {#} m/(?[ \cK - ( +{#} \t ) ])/',
+ '/(?[ \cK ( \t ) ])/' => 'Unexpected \'(\' with no preceding operator {#} m/(?[ \cK ({#} \t ) ])/',
+ '/(?[ \cK \t ])/' => 'Operand with no preceding operator {#} m/(?[ \cK \t{#} ])/',
+ '/(?[ \0004 ])/' => 'Need exactly 3 octal digits {#} m/(?[ \0004 {#}])/',
+ '/(?[ \05 ])/' => 'Need exactly 3 octal digits {#} m/(?[ \05 {#}])/',
+ '/(?[ \o{1038} ])/' => 'Non-octal character {#} m/(?[ \o{1038{#}} ])/',
+ '/(?[ \o{} ])/' => 'Number with no digits {#} m/(?[ \o{}{#} ])/',
+ '/(?[ \x{defg} ])/' => 'Non-hex character {#} m/(?[ \x{defg{#}} ])/',
+ '/(?[ \xabcdef ])/' => 'Use \\x{...} for more than two hex characters {#} m/(?[ \xabc{#}def ])/',
+ '/(?[ \x{} ])/' => 'Number with no digits {#} m/(?[ \x{}{#} ])/',
+ '/(?[ \cK + ) ])/' => 'Unexpected \')\' {#} m/(?[ \cK + ){#} ])/',
+ '/(?[ \cK + ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ \cK + {#}])/',
+ '/(?[ \p{foo} ])/' => 'Property \'foo\' is unknown {#} m/(?[ \p{foo}{#} ])/',
+ '/(?[ \p{ foo = bar } ])/' => 'Property \'foo = bar\' is unknown {#} m/(?[ \p{ foo = bar }{#} ])/',
+ '/(?[ \8 ])/' => 'Unrecognized escape \8 in character class {#} m/(?[ \8{#} ])/',
+ '/(?[ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ]/',
+ '/(?[ [ \t ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ \t ]/',
+ '/(?[ \t ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ \t ] ]/',
+ '/(?[ [ ] ]/' => 'Syntax error in (?[...]) in regex m/(?[ [ ] ]/',
+ '/(?[ \t + \e # This was supposed to be a comment ])/' => 'Syntax error in (?[...]) in regex m/(?[ \t + \e # This was supposed to be a comment ])/',
+ '/(?[ ])/' => 'Incomplete expression within \'(?[ ])\' {#} m/(?[ {#}])/',
+ 'm/(?[[a-\d]])/' => 'False [] range "a-\d" {#} m/(?[[a-\d{#}]])/',
+ 'm/(?[[\w-x]])/' => 'False [] range "\w-" {#} m/(?[[\w-{#}x]])/',
+ 'm/(?[[a-\pM]])/' => 'False [] range "a-\pM" {#} m/(?[[a-\pM{#}]])/',
+ 'm/(?[[\pM-x]])/' => 'False [] range "\pM-" {#} m/(?[[\pM-{#}x]])/',
+ 'm/(?[[\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]])/' => '\N{} in character class restricted to one character {#} m/(?[[\N{U+100.300{#}}]])/',
+ 'm/(?[ \p{Digit} & (?(?[ \p{Thai} | \p{Lao} ]))])/' => 'Sequence (?(...) not recognized {#} m/(?[ \p{Digit} & (?({#}?[ \p{Thai} | \p{Lao} ]))])/',
+ 'm/(?[ \p{Digit} & (?:(?[ \p{Thai} | \p{Lao} ]))])/' => 'Expecting \'(?flags:(?[...\' {#} m/(?[ \p{Digit} & (?{#}:(?[ \p{Thai} | \p{Lao} ]))])/',
+ 'm/\o{/' => 'Missing right brace on \o{ {#} m/\o{{#}/',
+ 'm/\o/' => 'Missing braces on \o{} {#} m/\o{#}/',
+ 'm/\o{}/' => 'Number with no digits {#} m/\o{}{#}/',
+ 'm/[\o{]/' => 'Missing right brace on \o{ {#} m/[\o{{#}]/',
+ 'm/[\o]/' => 'Missing braces on \o{} {#} m/[\o{#}]/',
+ 'm/[\o{}]/' => 'Number with no digits {#} m/[\o{}{#}]/',
+ 'm/(?^-i:foo)/' => 'Sequence (?^-...) not recognized {#} m/(?^-{#}i:foo)/',
 );
+# Tests involving a user-defined charnames translator are in pat_advanced.t
+
+# In the following arrays of warnings, the value can be an array of things to
+# expect.  If the empty string, it means no warning should be raised.
 
 ##
-## Key-value pairs of code/error of code that should have non-fatal warnings.
+## Key-value pairs of code/error of code that should have non-fatal regexp warnings.
 ##
 my @warning = (
-    'm/\b*/' => '\b* matches null string many times in regex; marked by {#} in m/\b*{#}/',
-
-    'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes in regex; marked by {#} in m/[:blank:]{#}/',
+    'm/\b*/' => '\b* matches null string many times {#} m/\b*{#}/',
+
+    'm/[:blank:]/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:blank:]{#}/',
+
+    "m'[\\y]'"     => 'Unrecognized escape \y in character class passed through {#} m/[\y{#}]/',
+
+    'm/[a-\d]/' => 'False [] range "a-\d" {#} m/[a-\d{#}]/',
+    'm/[\w-x]/' => 'False [] range "\w-" {#} m/[\w-{#}x]/',
+    'm/[a-\pM]/' => 'False [] range "a-\pM" {#} m/[a-\pM{#}]/',
+    'm/[\pM-x]/' => 'False [] range "\pM-" {#} m/[\pM-{#}x]/',
+    "m'\\y'"     => 'Unrecognized escape \y passed through {#} m/\y{#}/',
+    '/x{3,1}/'   => 'Quantifier {n,m} with n > m can\'t match {#} m/x{3,1}{#}/',
+    '/\08/' => '\'\08\' resolved to \'\o{0}8\' {#} m/\08{#}/',
+    '/\018/' => '\'\018\' resolved to \'\o{1}8\' {#} m/\018{#}/',
+    '/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/',
+    '/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/',
+    '/\87/' => 'Unrecognized escape \8 passed through {#} m/\8{#}7/',
+    '/a\87/' => 'Unrecognized escape \8 passed through {#} m/a\8{#}7/',
+    '/a\97/' => 'Unrecognized escape \9 passed through {#} m/a\9{#}7/',
+    '/(?=a)*/' => '(?=a)* matches null string many times {#} m/(?=a)*{#}/',
+    'my $x = \'\m\'; qr/a$x/' => 'Unrecognized escape \m passed through {#} m/a\m{#}/',
+    '/\q/' => 'Unrecognized escape \q passed through {#} m/\q{#}/',
+    '/\q{/' => 'Unrecognized escape \q{ passed through {#} m/\q{{#}/',
+    '/(?=a){1,3}/' => 'Quantifier unexpected on zero-length expression {#} m/(?=a){1,3}{#}/',
+    '/\_/' => "",
+    '/[\_\0]/' => "",
+    '/[\07]/' => "",
+    '/[\006]/' => "",
+    '/[\0005]/' => "",
+    '/[\8\9]/' => ['Unrecognized escape \8 in character class passed through {#} m/[\8{#}\9]/',
+                   'Unrecognized escape \9 in character class passed through {#} m/[\8\9{#}]/',
+                  ],
+    '/[:alpha:]/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:alpha:]{#}/',
+    '/[:zog:]/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:zog:]{#}/',
+    '/[.zog.]/' => 'POSIX syntax [. .] belongs inside character classes {#} m/[.zog.]{#}/',
+    '/[a-b]/' => "",
+    '/[a-\d]/' => 'False [] range "a-\d" {#} m/[a-\d{#}]/',
+    '/[\d-b]/' => 'False [] range "\d-" {#} m/[\d-{#}b]/',
+    '/[\s-\d]/' => 'False [] range "\s-" {#} m/[\s-{#}\d]/',
+    '/[\d-\s]/' => 'False [] range "\d-" {#} m/[\d-{#}\s]/',
+    '/[a-[:digit:]]/' => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]/',
+    '/[[:digit:]-b]/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]/',
+    '/[[:alpha:]-[:digit:]]/' => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]/',
+    '/[[:digit:]-[:alpha:]]/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]/',
+    '/[a\zb]/' => 'Unrecognized escape \z in character class passed through {#} m/[a\z{#}b]/',
+    '/(?c)/' => 'Useless (?c) - use /gc modifier {#} m/(?c{#})/',
+    '/(?-c)/' => 'Useless (?-c) - don\'t use /gc modifier {#} m/(?-c{#})/',
+    '/(?g)/' => 'Useless (?g) - use /g modifier {#} m/(?g{#})/',
+    '/(?-g)/' => 'Useless (?-g) - don\'t use /g modifier {#} m/(?-g{#})/',
+    '/(?o)/' => 'Useless (?o) - use /o modifier {#} m/(?o{#})/',
+    '/(?-o)/' => 'Useless (?-o) - don\'t use /o modifier {#} m/(?-o{#})/',
+    '/(?g-o)/' => [ 'Useless (?g) - use /g modifier {#} m/(?g{#}-o)/',
+                    'Useless (?-o) - don\'t use /o modifier {#} m/(?g-o{#})/',
+                  ],
+    '/(?g-c)/' => [ 'Useless (?g) - use /g modifier {#} m/(?g{#}-c)/',
+                    'Useless (?-c) - don\'t use /gc modifier {#} m/(?g-c{#})/',
+                  ],
+      # (?c) means (?g) error won't be thrown
+     '/(?o-cg)/' => [ 'Useless (?o) - use /o modifier {#} m/(?o{#}-cg)/',
+                      'Useless (?-c) - don\'t use /gc modifier {#} m/(?o-c{#}g)/',
+                    ],
+    '/(?ogc)/' => [ 'Useless (?o) - use /o modifier {#} m/(?o{#}gc)/',
+                    'Useless (?g) - use /g modifier {#} m/(?og{#}c)/',
+                    'Useless (?c) - use /gc modifier {#} m/(?ogc{#})/',
+                  ],
+);
 
-    "m'[\\y]'"     => 'Unrecognized escape \y in character class passed through in regex; marked by {#} in m/[\y{#}]/',
+my @experimental_regex_sets = (
+    '/(?[ \t ])/' => 'The regex_sets feature is experimental {#} m/(?[{#} \t ])/',
+);
 
-    'm/[a-\d]/' => 'False [] range "a-\d" in regex; marked by {#} in m/[a-\d{#}]/',
-    'm/[\w-x]/' => 'False [] range "\w-" in regex; marked by {#} in m/[\w-{#}x]/',
-    'm/[a-\pM]/' => 'False [] range "a-\pM" in regex; marked by {#} in m/[a-\pM{#}]/',
-    'm/[\pM-x]/' => 'False [] range "\pM-" in regex; marked by {#} in m/[\pM-{#}x]/',
-    "m'\\y'"     => 'Unrecognized escape \y passed through in regex; marked by {#} in m/\y{#}/',
+my @deprecated = (
+    '/a\b{cde/' => '"\b{" is deprecated; use "\b\{" or "\b[{]" instead {#} m/a\{#}b{cde/',
+    '/a\B{cde/' => '"\B{" is deprecated; use "\B\{" or "\B[{]" instead {#} m/a\{#}B{cde/',
+    'use utf8; /(?x)\\/' => 'Escape literal pattern white space under /x {#} m/(?x)\{#}\/',
+    '/((?# This is a comment in the middle of a token)?:foo)/' => 'In \'(?...)\', splitting the initial \'(?\' is deprecated {#} m/((?# This is a comment in the middle of a token)?{#}:foo)/',
+    '/((?# This is a comment in the middle of a token)*FAIL)/' => 'In \'(*VERB...)\', splitting the initial \'(*\' is deprecated {#} m/((?# This is a comment in the middle of a token)*{#}FAIL)/',
 );
 
 while (my ($regex, $expect) = splice @death, 0, 2) {
     my $expect = fixup_expect($expect);
+    no warnings 'experimental::regex_sets';
     # skip the utf8 test on EBCDIC since they do not die
     next if $::IS_EBCDIC && $regex =~ /utf8/;
 
     warning_is(sub {
 		   $_ = "x";
 		   eval $regex;
-		   like($@, qr/\Q$expect/);
-	       }, undef, "$regex died without any other warnings");
+		   like($@, qr/\Q$expect/, $regex);
+	       }, undef, "... and died without any other warnings");
 }
 
-while (my ($regex, $expect) = splice @warning, 0, 2) {
-    my $expect = fixup_expect($expect);
-    warning_like(sub {
-		     $_ = "x";
-		     eval $regex;
-		     is($@, '', "$regex did not die");
-		 }, qr/\Q$expect/);
+foreach my $ref (\@warning, \@experimental_regex_sets, \@deprecated) {
+    my $warning_type = ($ref == \@warning)
+                       ? 'regexp'
+                       : ($ref == \@deprecated)
+                         ? 'regexp, deprecated'
+                         : 'experimental::regex_sets';
+    while (my ($regex, $expect) = splice @$ref, 0, 2) {
+        my @expect = fixup_expect($expect);
+        {
+            $_ = "x";
+            no warnings;
+            eval $regex;
+        }
+        if (is($@, "", "$regex did not die")) {
+            my @got = capture_warnings(sub {
+                                    $_ = "x";
+                                    eval $regex });
+            my $count = @expect;
+            if (! is(scalar @got, scalar @expect, "... and gave expected number ($count) of warnings")) {
+                if (@got < @expect) {
+                    $count = @got;
+                    note "Expected warnings not gotten:\n\t" . join "\n\t", @expect[$count .. $#expect];
+                }
+                else {
+                    note "Unexpected warnings gotten:\n\t" . join("\n\t", @got[$count .. $#got]);
+                }
+            }
+            foreach my $i (0 .. $count - 1) {
+                if (like($got[$i], qr/\Q$expect[$i]/, "... and gave expected warning[$i]")) {
+                    ok (0 == capture_warnings(sub {
+                                    $_ = "x";
+                                    eval "no warnings '$warning_type'; $regex;" }
+                                ),
+                    "... and turning off '$warning_type' warnings suppressed it");
+                }
+            }
+        }
+    }
 }
 
 done_testing();
diff --git a/gnu/usr.bin/perl/t/re/reg_pmod.t b/gnu/usr.bin/perl/t/re/reg_pmod.t
index 301aeefc6df..106c0dcf3ef 100755
--- a/gnu/usr.bin/perl/t/re/reg_pmod.t
+++ b/gnu/usr.bin/perl/t/re/reg_pmod.t
@@ -11,39 +11,71 @@ use warnings;
 
 our @tests = (
     # /p      Pattern   PRE     MATCH   POST
-    [ '/p',   "456",    "123-", "456",  "-789"],
-    [ '(?p)', "456",    "123-", "456",  "-789"],
-    [ '',     "(456)",  "123-", "456",  "-789"],
-    [ '',     "456",    undef,  undef,  undef ],
+    [ '/p',   "345",    "012-", "345",  "-6789"],
+    # these not supported under 5.18.x
+    #[ '/$r/p',"345",    "012-", "345",  "-6789"],
+    [ '(?p)', "345",    "012-", "345",  "-6789"],
+    [ '(?p:)',"345",    "012-", "345",  "-6789"],
+    [ '',     "(345)",  undef,  undef,  undef ],
+    [ '',     "345",    undef,  undef,  undef ],
 );
 
-plan tests => 4 * @tests + 2;
+plan tests => 14 * @tests + 4;
 my $W = "";
 
 $SIG{__WARN__} = sub { $W.=join("",@_); };
 sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }
 
-$_ = '123-456-789';
 foreach my $test (@tests) {
     my ($p, $pat,$l,$m,$r) = @$test;
-    my $test_name = $p eq '/p'   ? "/$pat/p"
-                  : $p eq '(?p)' ? "/(?p)$pat/"
-                  :                "/$pat/";
-
-    #
-    # Cannot use if/else due to the scope invalidating ${^MATCH} and friends.
-    #
-    my $ok = ok $p eq '/p'   ? /$pat/p
-              : $p eq '(?p)' ? /(?p)$pat/
-              :                /$pat/
-              => $test_name;
-    SKIP: {
-        skip "/$pat/$p failed to match", 3
-            unless $ok;
-        is(${^PREMATCH},  $l,_u "$test_name: ^PREMATCH",$l);
-        is(${^MATCH},     $m,_u "$test_name: ^MATCH",$m );
-        is(${^POSTMATCH}, $r,_u "$test_name: ^POSTMATCH",$r );
+    my $qr = qr/$pat/;
+    for my $sub (0,1) {
+	my $test_name = $p eq '/p'   ? "/$pat/p"
+		      : $p eq '/$r/p'? $p
+		      : $p eq '(?p)' ? "/(?p)$pat/"
+		      : $p eq '(?p:)'? "/(?p:$pat)/"
+		      :                "/$pat/";
+	$test_name = "s$test_name" if $sub;
+
+	#
+	# Cannot use if/else due to the scope invalidating ${^MATCH} and friends.
+	#
+	$_ = '012-345-6789';
+	my $ok =
+		$sub ?
+			(   $p eq '/p'   ? s/$pat/abc/p
+			  : $p eq '/$r/p'? s/$qr/abc/p
+			  : $p eq '(?p)' ? s/(?p)$pat/abc/
+			  : $p eq '(?p:)'? s/(?p:$pat)/abc/
+			  :                s/$pat/abc/
+			)
+		     :
+			(   $p eq '/p'   ? /$pat/p
+			  : $p eq '/$r/p'? /$qr/p
+			  : $p eq '(?p)' ? /(?p)$pat/
+			  : $p eq '(?p:)'? /(?p:$pat)/
+			  :                /$pat/
+			);
+	ok $ok, $test_name;
+	SKIP: {
+	    skip "/$pat/$p failed to match", 6
+		unless $ok;
+	    is(${^PREMATCH},  $l,_u "$test_name: ^PREMATCH",$l);
+	    is(${^MATCH},     $m,_u "$test_name: ^MATCH",$m );
+	    is(${^POSTMATCH}, $r,_u "$test_name: ^POSTMATCH",$r );
+	    is(length ${^PREMATCH}, length $l, "$test_name: ^PREMATCH length");
+	    is(length ${^MATCH},    length $m, "$test_name: ^MATCH length");
+	    is(length ${^POSTMATCH},length $r, "$test_name: ^POSTMATCH length");
+	}
     }
 }
 is($W,"","No warnings should be produced");
 ok(!defined ${^MATCH}, "No /p in scope so ^MATCH is undef");
+
+#RT 117135
+
+{
+    my $m;
+    ok("a"=~ /(?p:a(?{ $m = ${^MATCH} }))/, '(?{})');
+    is($m, 'a', '(?{}) ^MATCH');
+}
diff --git a/gnu/usr.bin/perl/t/re/regex_sets.t b/gnu/usr.bin/perl/t/re/regex_sets.t
new file mode 100644
index 00000000000..b70e7ec0c2d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/re/regex_sets.t
@@ -0,0 +1,90 @@
+#!./perl
+
+# This tests (?[...]).  XXX These are just basic tests, as full ones would be
+# best done with an infrastructure change to allow getting out the inversion
+# list of the constructed set and then comparing it character by character
+# with the expected result.
+
+use strict;
+use warnings;
+
+$| = 1;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = ('../lib','.');
+    require './test.pl';
+}
+
+use utf8;
+no warnings 'experimental::regex_sets';
+
+like("a", qr/(?[ [a]      # This is a comment
+                    ])/, 'Can ignore a comment');
+like("a", qr/(?[ [a]      # [[:notaclass:]]
+                    ])/, 'A comment isn\'t parsed');
+unlike("\x85", qr/(?[ \t ])/, 'NEL is white space');
+unlike("\x85", qr/(?[ [\t] ])/, '... including within nested []');
+like("\x85", qr/(?[ \t + \ ])/, 'can escape NEL to match');
+like("\x85", qr/(?[ [\] ])/, '... including within nested []');
+like("\t", qr/(?[ \t + \ ])/, 'can do basic union');
+like("\cK", qr/(?[ \s ])/, '\s matches \cK');
+unlike("\cK", qr/(?[ \s - \cK ])/, 'can do basic subtraction');
+like(" ", qr/(?[ \s - \cK ])/, 'can do basic subtraction');
+like(":", qr/(?[ [:] ])/, '[:] is not a posix class');
+unlike("\t", qr/(?[ ! \t ])/, 'can do basic complement');
+like("\t", qr/(?[ ! [ ^ \t ] ])/, 'can do basic complement');
+unlike("\r", qr/(?[ \t ])/, '\r doesn\'t match \t ');
+like("\r", qr/(?[ ! \t ])/, 'can do basic complement');
+like("0", qr/(?[ [:word:] & [:digit:] ])/, 'can do basic intersection');
+unlike("A", qr/(?[ [:word:] & [:digit:] ])/, 'can do basic intersection');
+like("0", qr/(?[[:word:]&[:digit:]])/, 'spaces around internal [] aren\'t required');
+
+like("a", qr/(?[ [a] | [b] ])/, '| means union');
+like("b", qr/(?[ [a] | [b] ])/, '| means union');
+unlike("c", qr/(?[ [a] | [b] ])/, '| means union');
+
+like("a", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works');
+unlike("b", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works');
+like("c", qr/(?[ [ab] ^ [bc] ])/, 'basic symmetric difference works');
+
+like("2", qr/(?[ ( ( \pN & ( [a] + [2] ) ) ) ])/, 'Nesting parens and grouping');
+unlike("a", qr/(?[ ( ( \pN & ( [a] + [2] ) ) ) ])/, 'Nesting parens and grouping');
+
+unlike("\x{17f}", qr/(?[ [k] + \p{Blk=ASCII} ])/i, '/i doesn\'t affect \p{}');
+like("\N{KELVIN SIGN}", qr/(?[ [k] + \p{Blk=ASCII} ])/i, '/i does affect literals');
+
+my $thai_or_lao = qr/(?[ \p{Thai} + \p{Lao} ])/;
+my $thai_or_lao_digit = qr/(?[ \p{Digit} & $thai_or_lao ])/;
+like("\N{THAI DIGIT ZERO}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+unlike(chr(ord("\N{THAI DIGIT ZERO}") - 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+like("\N{THAI DIGIT NINE}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+unlike(chr(ord("\N{THAI DIGIT NINE}") + 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+like("\N{LAO DIGIT ZERO}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+unlike(chr(ord("\N{LAO DIGIT ZERO}") - 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+like("\N{LAO DIGIT NINE}", $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+unlike(chr(ord("\N{LAO DIGIT NINE}") + 1), $thai_or_lao_digit, 'embedded qr/(?[ ])/ works');
+
+my $ascii_word = qr/(?[ \w ])/a;
+my $ascii_digits_plus_all_of_arabic = qr/(?[ \p{Digit} & $ascii_word + \p{Arabic} ])/;
+like("9", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for ASCII in the set");
+unlike("A", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for ASCII not in the set");
+unlike("\N{BENGALI DIGIT ZERO}", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for non-ASCII not in either set");
+unlike("\N{BENGALI LETTER A}", $ascii_digits_plus_all_of_arabic, "/a, then interpolating and intersection works for non-ASCII in one set");
+like("\N{ARABIC LETTER HAMZA}", $ascii_digits_plus_all_of_arabic, "interpolation and intersection is left-associative");
+like("\N{EXTENDED ARABIC-INDIC DIGIT ZERO}", $ascii_digits_plus_all_of_arabic, "interpolation and intersection is left-associative");
+
+my $kelvin = qr/(?[ \N{KELVIN SIGN} ])/;
+my $fold = qr/(?[ $kelvin ])/i;
+like("\N{KELVIN SIGN}", $kelvin, '"\N{KELVIN SIGN}" matches compiled qr/(?[ \N{KELVIN SIGN} ])/');
+unlike("K", $fold, "/i on outer (?[ ]) doesn't leak to interpolated one");
+unlike("k", $fold, "/i on outer (?[ ]) doesn't leak to interpolated one");
+
+my $kelvin_fold = qr/(?[ \N{KELVIN SIGN} ])/i;
+my $still_fold = qr/(?[ $kelvin_fold ])/;
+like("K", $still_fold, "/i on interpolated (?[ ]) is retained in outer without /i");
+like("k", $still_fold, "/i on interpolated (?[ ]) is retained in outer without /i");
+
+done_testing();
+
+1;
diff --git a/gnu/usr.bin/perl/t/re/regex_sets_compat.t b/gnu/usr.bin/perl/t/re/regex_sets_compat.t
new file mode 100644
index 00000000000..27eb309af0d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/re/regex_sets_compat.t
@@ -0,0 +1,15 @@
+#!./perl
+
+# This tests that the (?[...]) feature doesn't introduce unexpected
+# differences from regular bracketed character classes.  It just sets a flag
+# and calls regexp.t which will run through its test suite, modifiying the
+# tests to use (?[...]) instead wherever the test uses [].
+
+BEGIN { $regex_sets = 1; }
+for $file ('./re/regexp.t', './t/re/regexp.t', ':re:regexp.t') {
+    if (-r $file) {
+	do $file or die $@;
+	exit;
+    }
+}
+die "Cannot find ./re/regexp.t or ./t/re/regexp.t\n";
diff --git a/gnu/usr.bin/perl/t/re/regexp.t b/gnu/usr.bin/perl/t/re/regexp.t
index 5a08863dc8b..21cae1d46f0 100755
--- a/gnu/usr.bin/perl/t/re/regexp.t
+++ b/gnu/usr.bin/perl/t/re/regexp.t
@@ -18,6 +18,8 @@
 #	B	test exposes a known bug in Perl, should be skipped
 #	b	test exposes a known bug in Perl, should be skipped if noamp
 #	t	test exposes a bug with threading, TODO if qr_embed_thr
+#       s       test should only be run for regex_sets_compat.t
+#       S       test should not be run for regex_sets_compat.t
 #
 # Columns 4 and 5 are used only if column 3 contains C<y> or C<c>.
 #
@@ -67,7 +69,8 @@ sub _comment {
 use strict;
 use warnings FATAL=>"all";
 use vars qw($bang $ffff $nulnul); # used by the tests
-use vars qw($qr $skip_amp $qr_embed $qr_embed_thr); # set by our callers
+use vars qw($qr $skip_amp $qr_embed $qr_embed_thr $regex_sets); # set by our callers
+
 
 
 if (!defined $file) {
@@ -96,24 +99,210 @@ foreach (@tests) {
         next;
     }
     chomp;
-    s/\\n/\n/g;
+    s/\\n/\n/g unless $regex_sets;
     my ($pat, $subject, $result, $repl, $expect, $reason) = split(/\t/,$_,6);
     $reason = '' unless defined $reason;
     my $input = join(':',$pat,$subject,$result,$repl,$expect);
     # the double '' below keeps simple syntax highlighters from going crazy
     $pat = "'$pat'" unless $pat =~ /^[:''\/]/; 
     $pat =~ s/(\$\{\w+\})/$1/eeg;
-    $pat =~ s/\\n/\n/g;
+    $pat =~ s/\\n/\n/g unless $regex_sets;
     $subject = eval qq("$subject"); die $@ if $@;
     $expect  = eval qq("$expect"); die $@ if $@;
     $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
     my $todo_qr = $qr_embed_thr && ($result =~ s/t//);
     my $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//));
     ++$skip if $result =~ s/M// && !defined &DynaLoader::boot_DynaLoader;
+    if ($result =~ s/ ( [Ss] ) //x) {
+        if (($1 eq 'S' && $regex_sets) || ($1 eq 's' && ! $regex_sets)) {
+            $skip++;
+            $reason = "Test not valid for $0";
+        }
+    }
     $reason = 'skipping $&' if $reason eq  '' && $skip_amp;
     $result =~ s/B//i unless $skip;
     my $todo= $result =~ s/T// ? " # TODO" : "";
-    
+    if (! $skip && $regex_sets) {
+
+        # If testing regex sets, change the [bracketed] classes into
+        # (?[bracketed]).
+
+        if ($pat !~ / \[ /x) {
+
+            $skip++;
+            $reason = "Pattern doesn't contain [brackets]";
+        }
+        else { # Use non-regex features of Perl to accomplish this.
+            my $modified = "";
+            my $in_brackets = 0;
+
+            # Go through the pattern character-by-character.  We also add
+            # blanks around each token to test the /x parts of (?[ ])
+            my $pat_len = length($pat);
+      CHAR: for (my $i = 0; $i < $pat_len; $i++) {
+                my $curchar = substr($pat, $i, 1);
+                if ($curchar eq '\\') {
+                    $modified .= " " if $in_brackets;
+                    $modified .= $curchar;
+                    $i++;
+
+                    # Get the character the backslash is escaping
+                    $curchar = substr($pat, $i, 1);
+                    $modified .= $curchar;
+
+                    # If the character following that is a '{}', treat the
+                    # entire amount as a single token
+                    if ($i < $pat_len -1 && substr($pat, $i+1, 1) eq '{') {
+                        my $j = index($pat, '}', $i+2);
+                        if ($j < 0) {
+                            last unless $in_brackets;
+                            if ($result eq 'c') {
+                                $skip++;
+                                $reason = "Can't handle compilation errors with unmatched '{'";
+                            }
+                            else {
+                                print "not ok $test # Problem in $0; original = '$pat'; mod = '$modified'\n";
+                                next TEST;
+                            }
+                        }
+                        $modified .= substr($pat, $i+1, $j - $i);
+                        $i = $j;
+                    }
+                    elsif ($curchar eq 'x') {
+
+                        # \x without brackets is supposed to be followed by 2
+                        # hex digits.  Take up to 2, and then add a blank
+                        # after the last one.  This avoids getting errors from
+                        # (?[ ]) for run-ons, like \xabc
+                        my $j = $i + 1;
+                        for (; $j < $i + 3 && $j < $pat_len; $j++) {
+                            my $curord = ord(substr($pat, $j, 1));
+                            if (!(($curord >= ord("A") && $curord <= ord("F"))
+                                 || ($curord >= ord("a") && $curord <= ord("f"))
+                                 || ($curord >= ord("0") && $curord <= ord("9"))))
+                            {
+                                $j++;
+                                last;
+                            }
+                        }
+                        $j--;
+                        $modified .= substr($pat, $i + 1, $j - $i) . " ";
+                        $i = $j;
+                    }
+                    elsif (ord($curchar) >= ord('0')
+                           && (ord($curchar) <= ord('7')))
+                    {
+                        # Similarly, octal constants have up to 3 digits.
+                        my $j = $i + 1;
+                        for (; $j < $i + 3 && $j < $pat_len; $j++) {
+                            my $curord = ord(substr($pat, $j, 1));
+                            if (! ($curord >= ord("0") &&  $curord <= ord("7"))) {
+                                $j++;
+                                last;
+                            }
+                        }
+                        $j--;
+                        $modified .= substr($pat, $i + 1, $j - $i);
+                        $i = $j;
+                    }
+
+                    next;
+                } # End of processing a backslash sequence
+
+                if (! $in_brackets  # Skip (?{ })
+                    && $curchar eq '('
+                    && $i < $pat_len - 2
+                    && substr($pat, $i+1, 1) eq '?'
+                    && substr($pat, $i+2, 1) eq '{')
+                {
+                    $skip++;
+                    $reason = "Pattern contains '(?{'";
+                    last;
+                }
+
+                # Closing ']'
+                if ($curchar eq ']' && $in_brackets) {
+                    $modified .= " ] ])";
+                    $in_brackets = 0;
+                    next;
+                }
+
+                # A regular character.
+                if ($curchar ne '[') {
+                    if (! $in_brackets) {
+                        $modified .= $curchar;
+                    }
+                    else {
+                        $modified .= " $curchar ";
+                    }
+                    next;
+                }
+
+                # Here is a '['; If not in a bracketed class, treat as the
+                # beginning of one.
+                if (! $in_brackets) {
+                    $in_brackets = 1;
+                    $modified .= "(?[ [ ";
+
+                    # An immediately following ']' or '^]' is not the ending
+                    # of the class, but is to be treated literally.
+                    if ($i < $pat_len - 1
+                        && substr($pat, $i+1, 1) eq ']')
+                    {
+                        $i ++;
+                        $modified .= " ] ";
+                    }
+                    elsif ($i < $pat_len - 2
+                            && substr($pat, $i+1, 1) eq '^'
+                            && substr($pat, $i+2, 1) eq ']')
+                    {
+                        $i += 2;
+                        $modified .= " ^ ] ";
+                    }
+                    next;
+                }
+
+                # Here is a plain '[' within [ ].  Could mean wants to
+                # match a '[', or it could be a posix class that has a
+                # corresponding ']'.  Absorb either
+
+                $modified .= ' [';
+                last if $i >= $pat_len - 1;
+
+                $i++;
+                $curchar = substr($pat, $i, 1);
+                if ($curchar =~ /[:=.]/) {
+                    for (my $j = $i + 1; $j < $pat_len; $j++) {
+                        next unless substr($pat, $j, 1) eq ']';
+                        last if $j - $i < 2;
+                        if (substr($pat, $j - 1, 1) eq $curchar) {
+                            # Here, is a posix class
+                            $modified .= substr($pat, $i, $j - $i + 1) . " ";
+                            $i = $j;
+                            next CHAR;
+                        }
+                    }
+                }
+
+                # Here wasn't a posix class, just process normally
+                $modified .= " $curchar ";
+            }
+
+            if ($in_brackets && ! $skip) {
+                if ($result eq 'c') {
+                    $skip++;
+                    $reason = "Can't figure out where to put the (?[ and ]) since is a compilation error";
+                }
+                else {
+                    print "not ok $test # Problem in $0; original = '$pat'; mod = '$modified'\n";
+                    next TEST;
+                }
+            }
+
+            # Use our modified pattern instead of the original
+            $pat = $modified;
+        }
+    }
 
     for my $study ('', 'study $subject', 'utf8::upgrade($subject)',
 		   'utf8::upgrade($subject); study $subject') {
@@ -155,6 +344,7 @@ EOFCODE
                 \$got = "$repl";
 EOFCODE
         }
+        $code = "no warnings 'experimental::regex_sets';$code" if $regex_sets;
         #$code.=qq[\n\$expect="$expect";\n];
         #use Devel::Peek;
         #die Dump($code) if $pat=~/\\h/ and $subject=~/\x{A0}/;
@@ -166,14 +356,14 @@ EOFCODE
 	    eval $code;
 	}
 	chomp( my $err = $@ );
-	if ($result eq 'c') {
+	if ( $skip ) {
+	    print "ok $test # skipped", length($reason) ? ".  $reason" : '', "\n";
+	    next TEST;
+	}
+	elsif ($result eq 'c') {
 	    if ($err !~ m!^\Q$expect!) { print "not ok $test$todo (compile) $input => '$err'\n"; next TEST }
 	    last;  # no need to study a syntax error
 	}
-	elsif ( $skip ) {
-	    print "ok $test # skipped", length($reason) ? " $reason" : '', "\n";
-	    next TEST;
-	}
 	elsif ( $todo_qr ) {
 	    print "not ok $test # TODO", length($reason) ? " - $reason" : '', "\n";
 	    next TEST;
@@ -187,6 +377,7 @@ EOFCODE
 	else {
 	    if (!$match || $got ne $expect) {
 	        eval { require Data::Dumper };
+                no warnings "utf8"; # But handle should be utf8
 		if ($@ || !defined &DynaLoader::boot_DynaLoader) {
 		    # Data::Dumper will load on miniperl, but fail when used in
 		    # anger as it tries to load B. I'd prefer to keep the
diff --git a/gnu/usr.bin/perl/t/re/regexp_unicode_prop.t b/gnu/usr.bin/perl/t/re/regexp_unicode_prop.t
index 3e08afcc4ce..fb1b154bff9 100755
--- a/gnu/usr.bin/perl/t/re/regexp_unicode_prop.t
+++ b/gnu/usr.bin/perl/t/re/regexp_unicode_prop.t
@@ -188,19 +188,17 @@ sub match {
 
     my ($str, $name);
 
-    given ($char) {
-        when (/^\\/) {
-            $str  = eval qq ["$char"];
-            $name =      qq ["$char"];
-        }
-        when (/^0x([0-9A-Fa-f]+)$/) {
-            $str  =  chr hex $1;
-            $name = "chr ($char)";
-        }
-        default {
-            $str  =      $char;
-            $name = qq ["$char"];
-        }
+    if ($char =~ /^\\/) {
+        $str  = eval qq ["$char"];
+        $name =      qq ["$char"];
+    }
+    elsif ($char =~ /^0x([0-9A-Fa-f]+)$/) {
+        $str  =  chr hex $1;
+        $name = "chr ($char)";
+    }
+    else {
+        $str  =      $char;
+        $name = qq ["$char"];
     }
 
     undef $@;
diff --git a/gnu/usr.bin/perl/t/re/rxcode.t b/gnu/usr.bin/perl/t/re/rxcode.t
index eb144f9807c..16bc4b7dc18 100755
--- a/gnu/usr.bin/perl/t/re/rxcode.t
+++ b/gnu/usr.bin/perl/t/re/rxcode.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 38;
+plan tests => 39;
 
 $^R = undef;
 like( 'a',  qr/^a(?{1})(?:b(?{2}))?/, 'a =~ ab?' );
@@ -84,3 +84,10 @@ cmp_ok( scalar(@var), '==', 0, '..still nothing pushed (package)' );
     ok( 'abbb' =~ /^a(?{36})(?:b(?{37})|c(?{38}))+/, 'abbbb =~ a(?:b|c)+' );
     ok( $^R == 37, '$^R == 37' ) or print "# \$^R=$^R\n";
 }
+
+# Broken temporarily by the jumbo re-eval rewrite in 5.17.1; fixed in .6
+{
+    use re 'eval';
+    $x = "(?{})";
+    is eval { "a" =~ /a++(?{})+$x/x } || $@, '1', '/a++(?{})+$code_block/'
+}
diff --git a/gnu/usr.bin/perl/t/re/subst.t b/gnu/usr.bin/perl/t/re/subst.t
index 8fa649dee26..8acd54f7d32 100755
--- a/gnu/usr.bin/perl/t/re/subst.t
+++ b/gnu/usr.bin/perl/t/re/subst.t
@@ -4,10 +4,10 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require Config; import Config;
+    require './test.pl';
 }
 
-require './test.pl';
-plan( tests => 189 );
+plan( tests => 206 );
 
 $_ = 'david';
 $a = s/david/rules/r;
@@ -746,6 +746,8 @@ fresh_perl_is( '$_="abcef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'a
     # when substituted with a UTF8 replacement string, due to
     # magic getting called multiple times, and pointers now pointing
     # to stale/freed strings
+    # The original fix for this caused infinite loops for non- or cow-
+    # strings, so we test those, too.
     package FOO;
     my $fc;
     sub TIESCALAR { bless [ "abcdefgh" ] }
@@ -757,6 +759,35 @@ fresh_perl_is( '$_="abcef"; s/bc|(.)\G(.)/$1 ? "[$1-$2]" : "XX"/ge; print' => 'a
     $s =~ s/..../\x{101}/;
     ::is($fc, 1, "tied UTF8 stuff FETCH count");
     ::is("$s", "\x{101}efgh", "tied UTF8 stuff");
+
+    ::watchdog(300);
+    $fc = 0;
+    $s = *foo;
+    $s =~ s/..../\x{101}/;
+    ::is($fc, 1, '$tied_glob =~ s/non-utf8/utf8/ fetch count');
+    ::is("$s", "\x{101}::foo", '$tied_glob =~ s/non-utf8/utf8/ result');
+    $fc = 0;
+    $s = *foo;
+    $s =~ s/(....)/\x{101}/g;
+    ::is($fc, 1, '$tied_glob =~ s/(non-utf8)/utf8/g fetch count');
+    ::is("$s", "\x{101}\x{101}o",
+         '$tied_glob =~ s/(non-utf8)/utf8/g result');
+    $fc = 0;
+    $s = "\xff\xff\xff\xff\xff";
+    $s =~ s/..../\x{101}/;
+    ::is($fc, 1, '$tied_latin1 =~ s/non-utf8/utf8/ fetch count');
+    ::is("$s", "\x{101}\xff", '$tied_latin1 =~ s/non-utf8/utf8/ result');
+    $fc = 0;
+    { package package_name; tied($s)->[0] = __PACKAGE__ };
+    $s =~ s/..../\x{101}/;
+    ::is($fc, 1, '$tied_cow =~ s/non-utf8/utf8/ fetch count');
+    ::is("$s", "\x{101}age_name", '$tied_cow =~ s/non-utf8/utf8/ result');
+    $fc = 0;
+    $s = \1;
+    $s =~ s/..../\x{101}/;
+    ::is($fc, 1, '$tied_ref =~ s/non-utf8/utf8/ fetch count');
+    ::like("$s", qr/^\x{101}AR\(0x.*\)\z/,
+           '$tied_ref =~ s/non-utf8/utf8/ result');
 }
 
 # RT #97954
@@ -798,4 +829,60 @@ is(*bam =~ s/\*//rg, 'main::bam', 'Can s///rg a tyepglob');
  tie my $kror, cowBug =>;
  $kror =~ s/(?:)/""/e;
 }
-pass("s/// on tied var returning a cow")
+pass("s/// on tied var returning a cow");
+
+# a test for 6502e08109cd003b2cdf39bc94ef35e52203240b
+# previously this would segfault
+
+{
+    my $s = "abc";
+    eval { $s =~ s/(.)/die/e; };
+    like($@, qr/Died at/, "s//die/e");
+}
+
+
+# Test problems with constant replacement optimisation
+# [perl #26986] logop in repl resulting in incorrect optimisation
+"g" =~ /(.)/;
+@l{'a'..'z'} = 'A'..':';
+$_ = "hello";
+{ s/(.)/$l{my $a||$1}/g }
+is $_, "HELLO",
+  'logop in s/// repl does not result in "constant" repl optimisation';
+# Aliases to match vars
+"g" =~ /(.)/;
+$_ = "hello";
+{
+    local *a = *1;
+    s/(.)\1/$a/g;
+}
+is $_, 'helo', 's/pat/$alias_to_match_var/';
+"g" =~ /(.)/;
+$_ = "hello";
+{
+    local *a = *1;
+    s/e(.)\1/a$a/g;
+}
+is $_, 'halo', 's/pat/$alias_to_match_var/';
+# Last-used pattern containing re-evals that modify "constant" rhs
+{
+    local *a;
+    $x = "hello";
+    $x =~ /(?{*a = \"a"})./;
+    undef *a;
+    $x =~ s//$a/g;
+    is $x, 'aaaaa',
+	'last-used pattern disables constant repl optimisation';
+}
+
+
+$_ = "\xc4\x80";
+$a = "";
+utf8::upgrade $a;
+$_ =~ s/$/$a/;
+is $_, "\xc4\x80", "empty utf8 repl does not result in mangled utf8";
+
+$@ = "\x{30cb}eval 18";
+$@ =~ s/eval \d+/eval 11/;
+is $@, "\x{30cb}eval 11",
+  'loading utf8 tables does not interfere with matches against $@';
diff --git a/gnu/usr.bin/perl/t/run/dtrace.pl b/gnu/usr.bin/perl/t/run/dtrace.pl
new file mode 100644
index 00000000000..d81cc0710eb
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/dtrace.pl
@@ -0,0 +1 @@
+42
diff --git a/gnu/usr.bin/perl/t/run/dtrace.t b/gnu/usr.bin/perl/t/run/dtrace.t
index 625e4039077..49bda6643ab 100644
--- a/gnu/usr.bin/perl/t/run/dtrace.t
+++ b/gnu/usr.bin/perl/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
 use warnings;
 use IPC::Open2;
 
-plan(tests => 5);
+plan(tests => 9);
 
 dtrace_like(
     '1',
@@ -62,7 +62,7 @@ dtrace_like(
     'phase changes of a simple script',
 );
 
-# this code taken from t/op/magic_phase.t which tests all of the
+# this code taken from t/opbasic/magic_phase.t which tests all of the
 # transitions of ${^GLOBAL_PHASE}. instead of printing (which will
 # interact nondeterministically with the DTrace output), we increment
 # an unused variable for side effects
@@ -117,6 +117,40 @@ PHASES
      'make sure sub-entry and phase-change interact well',
 );
 
+dtrace_like(<< 'PERL_SCRIPT',
+    my $tmp = "foo";
+    $tmp =~ s/f/b/;
+    chop $tmp;
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    op-entry { printf("op-entry <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        qr/op-entry <subst>/,
+        qr/op-entry <schop>/,
+    ],
+    'basic op probe',
+);
+
+dtrace_like(<< 'PERL_SCRIPT',
+    use strict;
+    require HTTP::Tiny;
+    do "run/dtrace.pl";
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    loading-file { printf("loading-file <%s>\n", copyinstr(arg0)) }
+    loaded-file  { printf("loaded-file <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        # the original test made sure that each file generated a loading-file then a loaded-file,
+        # but that had a race condition when the kernel would push the perl process onto a different
+        # CPU, so the DTrace output would appear out of order
+        qr{loading-file <strict\.pm>.*loading-file <HTTP/Tiny\.pm>.*loading-file <run/dtrace\.pl>}s,
+        qr{loaded-file <strict\.pm>.*loaded-file <HTTP/Tiny\.pm>.*loaded-file <run/dtrace\.pl>}s,
+    ],
+    'loading-file, loaded-file probes',
+);
+
 sub dtrace_like {
     my $perl     = shift;
     my $probes   = shift;
@@ -152,6 +186,11 @@ sub dtrace_like {
     die "Unexpected error from DTrace: $result"
         if $child_exit_status != 0;
 
-    like($result, $expected, $name);
+    if (ref($expected) eq 'ARRAY') {
+        like($result, $_, $name) for @$expected;
+    }
+    else {
+        like($result, $expected, $name);
+    }
 }
 
diff --git a/gnu/usr.bin/perl/t/run/flib/broken.pm b/gnu/usr.bin/perl/t/run/flib/broken.pm
new file mode 100644
index 00000000000..18f4d45bd78
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/flib/broken.pm
@@ -0,0 +1,8 @@
+package broken;
+
+use strict;
+use warnings;
+
+$x = 1;
+
+1;
diff --git a/gnu/usr.bin/perl/t/run/fresh_perl.t b/gnu/usr.bin/perl/t/run/fresh_perl.t
index 9c76a64f468..376ceafc48f 100644
--- a/gnu/usr.bin/perl/t/run/fresh_perl.t
+++ b/gnu/usr.bin/perl/t/run/fresh_perl.t
@@ -81,7 +81,7 @@ $array[128]=1
 ########
 $x=0x0eabcd; print $x->ref;
 EXPECT
-Can't call method "ref" without a package or object reference at - line 1.
+Can't locate object method "ref" via package "961485" (perhaps you forgot to load "961485"?) at - line 1.
 ########
 chop ($str .= <DATA>);
 ########
@@ -349,15 +349,12 @@ sub foo { local $_ = shift; @_ = split; @_ }
 @x = foo(' x  y  z ');
 print "you die joe!\n" unless "@x" eq 'x y z';
 ########
-/(?{"{"})/	# Check it outside of eval too
+"A" =~ /(?{"{"})/	# Check it outside of eval too
 EXPECT
-Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1.
 ########
 /(?{"{"}})/	# Check it outside of eval too
 EXPECT
-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.
+Sequence (?{...}) not terminated with ')' at - line 1.
 ########
 BEGIN { @ARGV = qw(a b c d e) }
 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
@@ -825,3 +822,55 @@ eval {
 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/locale.t b/gnu/usr.bin/perl/t/run/locale.t
index 7bbb0a9d39c..d01e3bca98b 100644
--- a/gnu/usr.bin/perl/t/run/locale.t
+++ b/gnu/usr.bin/perl/t/run/locale.t
@@ -64,7 +64,11 @@ my $original_locale = setlocale(LC_NUMERIC);
 
 my ($base, $different, $difference);
 for ("C", @locales) { # prefer C for the base if available
-    use locale;
+    BEGIN {
+        if($Config{d_setlocale}) {
+            require locale; import locale;
+        }
+    }
     setlocale(LC_NUMERIC, $_) or next;
     my $in = 4.2; # avoid any constant folding bugs
     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
@@ -113,14 +117,15 @@ format STDOUT =
 @.#
 4.179
 .
-{ use locale; write; }
+{ require locale; import locale; write; }
 EOF
 	    "too late to look at the locale at write() time");
         }
 
         {
 	    fresh_perl_is(<<'EOF', $difference, {},
-use locale; format STDOUT =
+use locale;
+format STDOUT =
 @.#
 4.179
 .
@@ -134,7 +139,11 @@ EOF
         # do not let "use 5.000" affect the locale!
         # this test is to prevent regression of [rt.perl.org #105784]
         fresh_perl_is(<<"EOF",
-            use locale;
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
             use POSIX;
             my \$i = 0.123;
             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
@@ -163,7 +172,7 @@ EOF
 	local $ENV{LC_NUMERIC} = $_;
 	local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 	fresh_perl_is(<<'EOF', "$difference "x4, {},
-	    use locale;
+        use locale;
 	    use POSIX qw(locale_h);
 	    setlocale(LC_NUMERIC, "");
 	    my $in = 4.2;
diff --git a/gnu/usr.bin/perl/t/run/mad.t b/gnu/usr.bin/perl/t/run/mad.t
new file mode 100644
index 00000000000..83023c53ef0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/mad.t
@@ -0,0 +1,46 @@
+#!./perl
+#
+# Tests for Perl mad environment
+#
+# $PERL_XMLDUMP
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    require './test.pl';
+    skip_all_without_config('mad');
+}
+
+use File::Path;
+use File::Spec;
+
+my $tempdir = tempfile;
+
+mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
+unshift @INC, '../../lib';
+my $cleanup = 1;
+
+END {
+    if ($cleanup) {
+	rmtree($tempdir);
+    }
+}
+
+plan tests => 4;
+
+{
+    delete local $ENV{$_} for keys %ENV;
+    my $fn = File::Spec->catfile(File::Spec->curdir(), "withoutT.xml");
+    $ENV{PERL_XMLDUMP} = $fn;
+    fresh_perl_is('print q/hello/', '', {}, 'mad without -T');
+    ok(-f $fn, "xml file created without -T as expected");
+}
+
+{
+    delete local $ENV{$_} for keys %ENV;
+    my $fn = File::Spec->catfile(File::Spec->curdir(), "withT.xml");
+    fresh_perl_is('print q/hello/', 'hello', { switches => [ "-T" ] },
+		  'mad with -T');
+    ok(!-e $fn, "no xml file created with -T as expected");
+}
diff --git a/gnu/usr.bin/perl/t/run/noswitch.t b/gnu/usr.bin/perl/t/run/noswitch.t
index a902c1fff7d..ff562534cdb 100644
--- a/gnu/usr.bin/perl/t/run/noswitch.t
+++ b/gnu/usr.bin/perl/t/run/noswitch.t
@@ -1,12 +1,16 @@
 #!./perl
 
 BEGIN {
-    print "1..3\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 3);
 }
-print "ok 1\n";
-print <>;
-print "ok 3\n";
+
+pass("first test");
+is( scalar <>, "ok 2\n", "read from aliased DATA filehandle");
+pass("last test");
 
 __DATA__
-ok 2 - read from aliased DATA filehandle
+ok 2
diff --git a/gnu/usr.bin/perl/t/run/runenv.t b/gnu/usr.bin/perl/t/run/runenv.t
index cea25904148..b3df796dd1e 100644
--- a/gnu/usr.bin/perl/t/run/runenv.t
+++ b/gnu/usr.bin/perl/t/run/runenv.t
@@ -12,7 +12,7 @@ BEGIN {
     skip_all_without_config('d_fork');
 }
 
-plan tests => 84;
+plan tests => 104;
 
 my $STDOUT = tempfile();
 my $STDERR = tempfile();
@@ -53,7 +53,7 @@ sub runperl_and_capture {
     }
     open STDOUT, '>', $STDOUT or exit $FAILURE_CODE;
     open STDERR, '>', $STDERR and do { exec $PERL, @$args };
-    # it didn't_work:
+    # it did not work:
     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
     exit $FAILURE_CODE;
   }
@@ -63,8 +63,21 @@ sub try {
   my ($env, $args, $stdout, $stderr) = @_;
   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
   local $::Level = $::Level + 1;
-  is ($stdout, $actual_stdout);
-  is ($stderr, $actual_stderr);
+  my @envpairs = ();
+  for my $k (sort keys %$env) {
+    push @envpairs, "$k => $env->{$k}";
+  }
+  my $label = join(',' => (@envpairs, @$args));
+  if (ref $stdout) {
+    ok ( $actual_stdout =~/$stdout/, $label . ' stdout' );
+  } else {
+    is ( $actual_stdout, $stdout, $label . ' stdout' );
+  }
+  if (ref $stderr) {
+    ok ( $actual_stderr =~/$stderr/, $label . ' stderr' );
+  } else {
+    is ( $actual_stderr, $stderr, $label . ' stderr' );
+  }
 }
 
 #  PERL5OPT    Command-line options (switches).  Switches in
@@ -191,6 +204,77 @@ try({PERL5LIB => "foo",
     '',
     '');
 
+try({PERL_HASH_SEED_DEBUG => 1},
+    ['-e','1'],
+    '',
+    qr/HASH_FUNCTION =/);
+
+try({PERL_HASH_SEED_DEBUG => 1},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED =/);
+
+# special case, seed "0" implies disabled hash key traversal randomization
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+# check that setting it to a different value with the same logical value
+# triggers the normal "deterministic mode".
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 1/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12345678/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12000000/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12345678/);
+
+# Test that PERL_PERTURB_KEYS works as expected.  We check that we get the same
+# results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run.
+my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_');
+for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively
+    my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ),
+    my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]);
+    if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) {
+        my $seed = $1;
+        my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]);
+        if ( $mode == 1 ) {
+            isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key");
+        } else {
+            is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash");
+        }
+        is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS");
+    }
+}
+
 # Tests for S_incpush_use_sep():
 
 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
diff --git a/gnu/usr.bin/perl/t/run/script.t b/gnu/usr.bin/perl/t/run/script.t
index 83d733abd23..2553e0045bc 100755
--- a/gnu/usr.bin/perl/t/run/script.t
+++ b/gnu/usr.bin/perl/t/run/script.t
@@ -4,17 +4,16 @@ BEGIN {
     chdir 't';
     @INC = '../lib';
     require './test.pl';	# for which_perl() etc
+    plan(3);
 }
 
 my $Perl = which_perl();
 
 my $filename = tempfile();
 
-print "1..3\n";
-
 $x = `$Perl -le "print 'ok';"`;
 
-if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
+is($x, "ok\n", "Got expected 'perl -le' output");
 
 open(try,">$filename") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
@@ -22,8 +21,8 @@ close try or die "Could not close: $!";
 
 $x = `$Perl $filename`;
 
-if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
+is($x, "ok\n", "Got expected output of command from script");
 
 $x = `$Perl <$filename`;
 
-if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
+is($x, "ok\n", "Got expected output of command read from script");
diff --git a/gnu/usr.bin/perl/t/run/switch0.t b/gnu/usr.bin/perl/t/run/switch0.t
index 9919e1231a2..94d5bd2df7a 100644
--- a/gnu/usr.bin/perl/t/run/switch0.t
+++ b/gnu/usr.bin/perl/t/run/switch0.t
@@ -1,3 +1,11 @@
 #!./perl -0
-print "1..1\n";
-print ord $/ == 0 ? "ok 1\n" : "not ok 1\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 1;
+
+is(ord $/, 0, '$/ set to 0 via switch');
diff --git a/gnu/usr.bin/perl/t/run/switchF.t b/gnu/usr.bin/perl/t/run/switchF.t
index a6e9031d0c8..dcf44094dd8 100644
--- a/gnu/usr.bin/perl/t/run/switchF.t
+++ b/gnu/usr.bin/perl/t/run/switchF.t
@@ -1,11 +1,16 @@
 #!./perl -anFx+
 
 BEGIN {
-    print "1..2\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 2);
 }
-print "@F";
+my $index = $F[-1];
+chomp $index;
+is($index, $., "line $.");
 
 __DATA__
 okx1
-okxxx2
+okx3xx2
diff --git a/gnu/usr.bin/perl/t/run/switchF1.t b/gnu/usr.bin/perl/t/run/switchF1.t
index f94c159544a..70fe638acbd 100755
--- a/gnu/usr.bin/perl/t/run/switchF1.t
+++ b/gnu/usr.bin/perl/t/run/switchF1.t
@@ -1,4 +1,8 @@
 #!perl -w
+
+# This test file does not use test.pl because of the involved way in which it
+# generates its TAP output.
+
 print "1..5\n";
 
 my $file = "Run_switchF1.pl";
@@ -14,10 +18,10 @@ BEGIN {
 print "@F";
 
 __DATA__
-okx1
-okq2
-ok\3
-ok'4
+okx1x- use of alternate delimiter (lower case letter) in -F
+okq2q- use of alternate delimiter (lower case letter) in -F
+ok\3\- use of alternate delimiter (backslash) in -F
+ok'4'- use of alternate delimiter (apostrophe) in -F
 EOT
 
 # 2 of the characters toke.c used to use to quote the split parameter:
@@ -26,6 +30,8 @@ $prog =~ s/QQ/\x01\x80/;
 print F $prog;
 close F or die "Close $file: $!";
 
-print system ($^X, $file) ? "not ok 5\n" : "ok 5\n";
+$count = 5;
+$result = "ok $count - complete test of alternate delimiters in -F\n";
+print system ($^X, $file) ? "not $result" : $result;
 
 unlink $file or die "Unlink $file: $!";
diff --git a/gnu/usr.bin/perl/t/run/switchI.t b/gnu/usr.bin/perl/t/run/switchI.t
index 27f78a60779..7fb222bb219 100644
--- a/gnu/usr.bin/perl/t/run/switchI.t
+++ b/gnu/usr.bin/perl/t/run/switchI.t
@@ -11,11 +11,12 @@ my $Is_VMS   = $^O eq 'VMS';
 my $lib;
 
 $lib = 'Bla';
-ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
+ok do { grep { $_ eq $lib } @INC[0..($#INC-1)] }, 'Identified entry in @INC';
 SKIP: {
   skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
   $lib = 'Foo::Bar';
-  ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
+  ok do { grep { $_ eq $lib } @INC[0..($#INC-1)] },
+    'Identified entry in @INC with double colons';
 }
 
 $lib = 'Bla2';
diff --git a/gnu/usr.bin/perl/t/run/switchM.t b/gnu/usr.bin/perl/t/run/switchM.t
new file mode 100644
index 00000000000..72e8908b01b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/switchM.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+use strict;
+
+require './test.pl';
+
+plan(2);
+
+like(runperl(switches => ['-Irun/flib', '-Mbroken'], stderr => 1),
+     qr/^Global symbol "\$x" requires explicit package name at run\/flib\/broken.pm line 6\./,
+     "Ensure -Irun/flib produces correct filename in warnings");
+
+like(runperl(switches => ['-Irun/flib/', '-Mbroken'], stderr => 1),
+     qr/^Global symbol "\$x" requires explicit package name at run\/flib\/broken.pm line 6\./,
+     "Ensure -Irun/flib/ produces correct filename in warnings");
diff --git a/gnu/usr.bin/perl/t/run/switcha.t b/gnu/usr.bin/perl/t/run/switcha.t
index ec2f0ccc066..16c7917b0ee 100644
--- a/gnu/usr.bin/perl/t/run/switcha.t
+++ b/gnu/usr.bin/perl/t/run/switcha.t
@@ -1,11 +1,14 @@
 #!./perl -na
 
 BEGIN {
-    print "1..2\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
-    $i = 0;
+    plan(tests => 2);
 }
-print "$F[1] ",++$i,"\n";
+chomp;
+is($F[1], 'ok', "testing split of string '$_'");
 
 __DATA__
 not ok
diff --git a/gnu/usr.bin/perl/t/run/switchd.t b/gnu/usr.bin/perl/t/run/switchd.t
index eadcd94053d..4334262616e 100644
--- a/gnu/usr.bin/perl/t/run/switchd.t
+++ b/gnu/usr.bin/perl/t/run/switchd.t
@@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; }
 
 # This test depends on t/lib/Devel/switchd*.pm.
 
-plan(tests => 7);
+plan(tests => 10);
 
 my $r;
 
@@ -35,19 +35,25 @@ __SWDTEST__
 		 progfile => $filename,
 		 args => ['3'],
 		);
-    like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 1');
     $r = runperl(
 		 switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
 		 progfile => $filename,
 		 args => ['4'],
 		);
-    like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 2');
     $r = runperl(
 		 switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
 		 progfile => $filename,
 		 args => ['4'],
 		);
-    like($r, qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 3');
 }
 
 # [perl #71806]
@@ -110,3 +116,50 @@ like(
   qr "ok\r?\n",
  'No crash when calling orphaned subroutine via goto &',
 );
+
+# test when DB::DB is seen but not defined [perl #114990]
+like(
+  runperl(
+    switches => [ '-Ilib', '-d:nodb' ],
+    prog     => [ '1' ],
+    stderr   => 1,
+  ),
+  qr/^No DB::DB routine defined/,
+  "No crash when *DB::DB exists but not &DB::DB",
+);
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    prog     => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
+    stderr   => 1,
+  ),
+  qr/^No DB::DB routine defined/,
+  "No crash when &DB::DB exists but isn't actually defined",
+);
+
+# [perl #115742] Recursive DB::DB clobbering its own pad
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    progs    => [ split "\n", <<'='
+     BEGIN {
+      $^P = 0x22;
+     }
+     package DB;
+     sub DB {
+      my $x = 42;
+      return if $__++;
+      $^D |= 1 << 30; # allow recursive calls
+      main::foo();
+      print $x//q-u-, qq-\n-;
+     }
+     package main;
+     chop;
+     sub foo { chop; }
+=
+    ],
+    stderr   => 1,
+  ),
+  qr/42/,
+  "Recursive DB::DB does not clobber its own pad",
+);
diff --git a/gnu/usr.bin/perl/t/run/switches.t b/gnu/usr.bin/perl/t/run/switches.t
index 57ae32474d7..f1b923461d9 100644
--- a/gnu/usr.bin/perl/t/run/switches.t
+++ b/gnu/usr.bin/perl/t/run/switches.t
@@ -11,9 +11,11 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan(tests => 112);
+plan(tests => 115);
 
 use Config;
+use Errno qw(EACCES EISDIR);
+use POSIX qw(setlocale LC_ALL);
 
 # 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 
@@ -107,6 +109,25 @@ SWTEST
     );
 }
 
+{
+    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': $!";
+}
+
 # Tests for -l
 
 $r = runperl(
@@ -350,6 +371,26 @@ __EOF__
     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
@@ -363,12 +404,12 @@ is( $r, "Hello, world!\n", "-E say" );
 
 
 $r = runperl(
-    switches	=> [ '-E', '"undef ~~ undef and say q(Hello, world!)"']
+    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"']
 );
 is( $r, "Hello, world!\n", "-E ~~" );
 
 $r = runperl(
-    switches	=> [ '-E', '"given(undef) {when(undef) { say q(Hello, world!)"}}']
+    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
 );
 is( $r, "Hello, world!\n", "-E given" );
 
diff --git a/gnu/usr.bin/perl/t/run/switchn.t b/gnu/usr.bin/perl/t/run/switchn.t
index bca9a66e76c..6ad4a7265f0 100644
--- a/gnu/usr.bin/perl/t/run/switchn.t
+++ b/gnu/usr.bin/perl/t/run/switchn.t
@@ -1,15 +1,19 @@
 #!./perl -n
 
 BEGIN {
-    print "1..3\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 3);
 }
 
 END {
-    print "ok 3\n";
+    pass("Final test");
 }
 
-print;
+chomp;
+is("ok ".$., $_, "Checking line $.");
 
 s/^/not /;
 
diff --git a/gnu/usr.bin/perl/t/run/switchp.t b/gnu/usr.bin/perl/t/run/switchp.t
index 1d1fe1485f5..ab1ae902854 100644
--- a/gnu/usr.bin/perl/t/run/switchp.t
+++ b/gnu/usr.bin/perl/t/run/switchp.t
@@ -1,16 +1,19 @@
 #!./perl -p
 
+# This test file does not use test.pl because of the involved way in which it
+# generates its TAP output.
+
 BEGIN {
     print "1..3\n";
     *ARGV = *DATA;
 }
 
 END {
-    print "ok 3\n";
+    print "ok 3 - -p switch tested\n";
 }
 
 s/^not //;
 
 __DATA__
-not ok 1
-not ok 2
+not ok 1 - -p switch first iteration
+not ok 2 - -p switch second iteration
diff --git a/gnu/usr.bin/perl/t/run/switchx.aux b/gnu/usr.bin/perl/t/run/switchx.aux
index 0db6103ee26..b59df4a0ed8 100644
--- a/gnu/usr.bin/perl/t/run/switchx.aux
+++ b/gnu/usr.bin/perl/t/run/switchx.aux
@@ -19,9 +19,9 @@ still not perl
 
 print "1..7";
 if (-f 'run/switchx.aux') {
-    print "ok 1";
+    print "ok 1 - Test file exists";
 }
-print "ok 2";
+print "ok 2 - Test file utilized";
 # other tests are in switchx2.aux
 
 __END__
diff --git a/gnu/usr.bin/perl/t/run/switchx2.aux b/gnu/usr.bin/perl/t/run/switchx2.aux
index c1fb6ee65dc..6d54a2d202c 100644
--- a/gnu/usr.bin/perl/t/run/switchx2.aux
+++ b/gnu/usr.bin/perl/t/run/switchx2.aux
@@ -21,10 +21,10 @@ if [[ -z $FOO ]]; then echo 'not ok 1'; fi
 # These lines get executed
 my $test = $ARGV[0];
 if (-f 'switchx.t') {
-    print("ok $test");
+    print("ok $test - perl -l option tested");
 }
 $test++;
-print "ok $test";
+print "ok $test - Second test file utilized";
 
 __END__
 
diff --git a/gnu/usr.bin/perl/t/test.pl b/gnu/usr.bin/perl/t/test.pl
index b33c634fef2..e141b9174f1 100644
--- a/gnu/usr.bin/perl/t/test.pl
+++ b/gnu/usr.bin/perl/t/test.pl
@@ -109,6 +109,16 @@ sub _comment {
            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";
@@ -123,14 +133,9 @@ sub skip_all_if_miniperl {
 }
 
 sub skip_all_without_dynamic_extension {
-    my $extension = shift;
+    my ($extension) = @_;
     skip_all("no dynamic loading on miniperl, no $extension") if is_miniperl();
-    unless (eval {require Config; 1}) {
-	warn "test.pl had problems loading Config: $@";
-	return;
-    }
-    $extension =~ s!::!/!g;
-    return if ($Config::Config{extensions} =~ /\b$extension\b/);
+    return if &_have_dynamic_extension;
     skip_all("$extension was not built");
 }
 
@@ -153,9 +158,9 @@ sub skip_all_without_config {
 }
 
 sub find_git_or_skip {
-    my ($found_dir, $reason);
+    my ($source_dir, $reason);
     if (-d '.git') {
-	$found_dir = 1;
+	$source_dir = '.';
     } elsif (-l 'MANIFEST' && -l 'AUTHORS') {
 	my $where = readlink 'MANIFEST';
 	die "Can't readling MANIFEST: $!" unless defined $where;
@@ -163,16 +168,20 @@ sub find_git_or_skip {
 	    unless $where =~ s!/MANIFEST\z!!;
 	if (-d "$where/.git") {
 	    # Looks like we are in a symlink tree
-	    chdir $where or die "Can't chdir '$where': $!";
-	    note("Found source tree at $where");
-	    $found_dir = 1;
+	    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;
 	}
     }
-    if ($found_dir) {
+    if ($source_dir) {
 	my $version_string = `git --version`;
 	if (defined $version_string
 	      && $version_string =~ /\Agit version (\d+\.\d+\.\d+)(.*)/) {
-	    return if eval "v$1 ge v1.5.0";
+	    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 {
@@ -185,6 +194,12 @@ sub find_git_or_skip {
     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 ".
@@ -444,6 +459,13 @@ 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;
@@ -475,7 +497,10 @@ sub eq_hash {
     # Force a hash recompute if this perl's internals can cache the hash key.
     $key = "" . $key;
     if (exists $orig->{$key}) {
-      if ($orig->{$key} ne $value) {
+      if (
+        defined $orig->{$key} != defined $value
+        || (defined $value && $orig->{$key} ne $value)
+      ) {
         _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
                      " now ", _qq($value), "\n";
         $fail = 1;
@@ -740,6 +765,44 @@ sub unlink_all {
     $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 }
 
@@ -747,25 +810,23 @@ END { unlink_all keys %tmpfiles }
 $::tempfile_regexp = 'tmp\d+[A-Z][A-Z]?';
 
 # Avoid ++, avoid ranges, avoid split //
-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);
+my $tempfile_count = 0;
 sub tempfile {
-    my $count = 0;
-    do {
-	my $temp = $count;
+    while(1){
 	my $try = "tmp$$";
-	do {
-	    $try = $try . $letters[$temp % 26];
-	    $temp = int ($temp / 26);
-	} while $temp;
+        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 (!-e $try && !$tmpfiles{$try}) {
+	if (!$tmpfiles{$try} && !-e $try) {
 	    # We have a winner
 	    $tmpfiles{$try} = 1;
 	    return $try;
 	}
-	$count = $count + 1;
-    } while $count < 26 * 26;
+    }
     die "Can't find temporary file name starting 'tmp$$'";
 }
 
@@ -783,8 +844,8 @@ sub _fresh_perl {
     # 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;
+    $runperl_args->{progfile} ||= $tmpfile;
+    $runperl_args->{stderr}     = 1 unless exists $runperl_args->{stderr};
 
     open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
 
@@ -883,7 +944,8 @@ sub fresh_perl_like {
 # Each program is source code to run followed by an "EXPECT" line, followed
 # by the expected output.
 #
-# The code to run may contain (note the '# ' on each):
+# 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
@@ -892,9 +954,6 @@ sub fresh_perl_like {
 # The expected output may contain:
 #   OPTION list of options
 #   OPTIONS list of options
-#   PREFIX
-#     indicates that the supplied output is only a prefix to the
-#     expected output
 #
 # The possible options for OPTION may be:
 #   regex - the expected output is a regular expression
@@ -904,6 +963,9 @@ sub fresh_perl_like {
 # 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.
 
@@ -923,6 +985,7 @@ sub run_multiple_progs {
 
     my $tmpfile = tempfile();
 
+  PROGRAM:
     for (@prgs){
 	unless (/\n/) {
 	    print "# From $_\n";
@@ -949,13 +1012,22 @@ sub run_multiple_progs {
 		$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) ;
+	    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"
diff --git a/gnu/usr.bin/perl/t/test_pl/_num_to_alpha.t b/gnu/usr.bin/perl/t/test_pl/_num_to_alpha.t
new file mode 100644
index 00000000000..01aed339481
--- /dev/null
+++ b/gnu/usr.bin/perl/t/test_pl/_num_to_alpha.t
@@ -0,0 +1,44 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+}
+
+is( _num_to_alpha(-1), undef, 'Returns undef for negative numbers');
+is( _num_to_alpha( 0), 'A', "Starts at 'A'");
+is( _num_to_alpha( 1), 'B');
+
+is( _num_to_alpha(26 - 1), 'Z', 'Last single letter return value');
+is( _num_to_alpha(26    ), 'AA', 'First double letter return value');
+is( _num_to_alpha(26 + 1), 'AB');
+
+is( _num_to_alpha(26 + 26 - 2), 'AY');
+is( _num_to_alpha(26 + 26 - 1), 'AZ');
+is( _num_to_alpha(26 + 26    ), 'BA');
+is( _num_to_alpha(26 + 26 + 1), 'BB');
+
+is( _num_to_alpha(26 ** 2 - 1), 'YZ');
+is( _num_to_alpha(26 ** 2    ), 'ZA');
+is( _num_to_alpha(26 ** 2 + 1), 'ZB');
+
+is( _num_to_alpha(26 ** 2 + 26 - 1), 'ZZ', 'Last double letter return value');
+is( _num_to_alpha(26 ** 2 + 26    ), 'AAA', 'First triple letter return value');
+is( _num_to_alpha(26 ** 2 + 26 + 1), 'AAB');
+
+is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 - 1 ), 'ZZZ', 'Last triple letter return value');
+is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26     ), 'AAAA', 'First quadruple letter return value');
+is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 + 1 ), 'AAAB');
+
+note('Testing limit capabilities');
+
+is( _num_to_alpha(26 - 1 , 1), 'Z', 'Largest return value for one letter');
+is( _num_to_alpha(26     , 1), undef); # AA
+
+is( _num_to_alpha(26 ** 2 + 26 - 1 , 2 ), 'ZZ', 'Largest return value for two letters');
+is( _num_to_alpha(26 ** 2 + 26     , 2 ), undef); # AAA
+
+is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26 - 1 , 3 ), 'ZZZ', 'Largest return value for three letters');
+is( _num_to_alpha(26 ** 3 + 26 ** 2 + 26     , 3 ), undef); # AAAA
+
+done_testing();
diff --git a/gnu/usr.bin/perl/t/test_pl/tempfile.t b/gnu/usr.bin/perl/t/test_pl/tempfile.t
new file mode 100644
index 00000000000..51937c4ad6d
--- /dev/null
+++ b/gnu/usr.bin/perl/t/test_pl/tempfile.t
@@ -0,0 +1,60 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+}
+use strict;
+
+my $prefix = 'tmp'.$$;
+
+sub skip_files{
+    my($skip,$to,$next) = @_;
+    my($last,$check);
+    my $cmp = $prefix . $to;
+
+    for( 1..$skip ){
+        $check = tempfile();
+        $last = $_;
+        if( $check eq $cmp && $_ != $skip ){
+            # let the next test pass
+            last;
+        }
+    }
+
+    my $common_mess = "skip $skip filenames to $to so that the next one will end with $next";
+    if( $last == $skip ){
+        if( $check eq $cmp ){
+            pass( $common_mess );
+        }else{
+            my($alpha) = $check =~ /\Atmp\d+([A-Z][A-Z]?)\Z/;
+            fail( $common_mess, "only skipped to $alpha" )
+        }
+    }else{
+        fail( $common_mess, "only skipped $last files" );
+    }
+}
+
+note("skipping the first filename because it is taken for use by _fresh_perl()");
+
+is( tempfile(), "${prefix}B");
+is( tempfile(), "${prefix}C");
+
+skip_files(22,'Y','Z');
+
+is( tempfile(), "${prefix}Z", 'Last single letter filename');
+is( tempfile(), "${prefix}AA", 'First double letter filename');
+
+skip_files(24,'AY','AZ');
+
+is( tempfile(), "${prefix}AZ");
+is( tempfile(), "${prefix}BA");
+
+skip_files(26 * 24 + 24,'ZY','ZZ');
+
+is( tempfile(), "${prefix}ZZ", 'Last available filename');
+ok( !eval{tempfile()}, 'Should bail after Last available filename' );
+my $err = "$@";
+like( $err, qr{^Can't find temporary file name starting}, 'check error string' );
+
+done_testing();
diff --git a/gnu/usr.bin/perl/t/uni/case.pl b/gnu/usr.bin/perl/t/uni/case.pl
index 8bd115b4792..08df6706db9 100644
--- a/gnu/usr.bin/perl/t/uni/case.pl
+++ b/gnu/usr.bin/perl/t/uni/case.pl
@@ -1,11 +1,16 @@
 require "test.pl";
+use strict;
+use warnings;
 
 sub unidump {
     join " ", map { sprintf "%04X", $_ } unpack "U*", $_[0];
 }
 
 sub casetest {
-    my ($already_run, $base, $spec, @funcs) = @_;
+    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
@@ -20,18 +25,33 @@ sub casetest {
 		    },
 		   )} @funcs;
 
-    my $file = "../lib/unicore/To/$base.pl";
-    my $simple = do $file or die $@;
+    use Unicode::UCD 'prop_invmap';
+
+    # Get the case mappings
+    my ($invlist_ref, $invmap_ref, undef, $default) = prop_invmap($base);
     my %simple;
-    for my $i (split(/\n/, $simple)) {
-	my ($k, $v) = split(' ', $i);
-
-        # Add the simple mapping to the simples test list, except the input
-        # may include code points that the specials override, so don't add
-        # those to the test list.  The specials keys are the code points,
-        # encoded in utf8,, but without the utf8 flag on, so pack with C0.
-	$simple{$k} = $v unless exists $spec->{pack("C0U", hex $k)};
+
+    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]};
+        }
     }
+
     my %seen;
 
     for my $i (sort keys %simple) {
@@ -39,17 +59,12 @@ sub casetest {
     }
     print "# ", scalar keys %simple, " simple mappings\n";
 
-    my $both;
-
-    for my $i (sort keys %$spec) {
+    for my $i (sort keys %spec) {
 	if (++$seen{$i} == 2) {
 	    warn sprintf "$base: $i seen twice\n";
-	    $both++;
 	}
     }
-    print "# ", scalar keys %$spec, " special mappings\n";
-
-    exit(1) if $both;
+    print "# ", scalar keys %spec, " special mappings\n";
 
     my %none;
     for my $i (map { ord } split //,
@@ -62,101 +77,43 @@ sub casetest {
     my $tests = 
         $already_run +
 	((scalar keys %simple) +
-	 (scalar keys %$spec) +
+	 (scalar keys %spec) +
 	 (scalar keys %none)) * @funcs;
 
     my $test = $already_run + 1;
 
     for my $i (sort keys %simple) {
 	my $w = $simple{$i};
-	my $c = pack "U0U", hex $i;
+	my $c = pack "U0U", $i;
 	foreach my $func (@funcs) {
 	    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++;
+	    is( $d, pack("U0U", $simple{$i}), "$i -> $e ($w)" );
 	}
     }
 
-    for my $i (sort keys %$spec) {
-	my $w = unidump($spec->{$i});
-	if (ord('A') == 193 && $i eq "\x8A\x73") {
-	    $w = '0178'; # It's a Latin small Y with diaeresis and not a Latin small letter sharp 's'.
-	}
-	my $u = unpack "C0U", $i;
-	my $h = sprintf "%04X", $u;
-	my $c = chr($u); $c .= chr(0x100); chop $c;
+    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);
-	    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 ($h =~ /^(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 # $h -> $e ($w)\n";
-		$test++;
+            is( $w, $e, "$h -> $e ($w)" );
 	}
     }
 
     for my $i (sort { $a <=> $b } keys %none) {
+	my $c = pack "U0U", $i;
 	my $w = $i = sprintf "%04X", $i;
-	my $c = pack "U0U", hex $i;
 	foreach my $func (@funcs) {
 	    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++;
+            is( $d, $c, "$i -> $e ($w)" );
 	}
     }
 
-    print "1..$tests\n";
+    done_testing();
 }
 
 1;
diff --git a/gnu/usr.bin/perl/t/uni/chr.t b/gnu/usr.bin/perl/t/uni/chr.t
index 33283e779a8..9445d32a7ba 100644
--- a/gnu/usr.bin/perl/t/uni/chr.t
+++ b/gnu/usr.bin/perl/t/uni/chr.t
@@ -8,7 +8,8 @@ BEGIN {
 }
 
 use strict;
-plan (tests => 6);
+plan (tests => 8);
+no warnings 'deprecated';
 use encoding 'johab';
 
 ok(chr(0x7f) eq "\x7f");
@@ -19,4 +20,13 @@ for my $i (127, 128, 255) {
     ok(chr($i) eq pack('C', $i));
 }
 
+# [perl #83048]
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= $_[0] };
+    my $chr = chr(-1);
+    is($chr, "\x{fffd}", "invalid values become REPLACEMENT CHARACTER");
+    like($w, qr/^Invalid negative number \(-1\) in chr at /, "with a warning");
+}
+
 __END__
diff --git a/gnu/usr.bin/perl/t/uni/greek.t b/gnu/usr.bin/perl/t/uni/greek.t
index 1737a679fa4..5326ab94ad7 100644
--- a/gnu/usr.bin/perl/t/uni/greek.t
+++ b/gnu/usr.bin/perl/t/uni/greek.t
@@ -9,6 +9,7 @@ BEGIN {
 
 plan tests => 72;
 
+no warnings 'deprecated';
 use encoding "greek"; # iso 8859-7
 
 # U+0391, \xC1, \301, GREEK CAPITAL LETTER ALPHA
diff --git a/gnu/usr.bin/perl/t/uni/labels.t b/gnu/usr.bin/perl/t/uni/labels.t
index 3d7d476ae95..3fa9d38c216 100644
--- a/gnu/usr.bin/perl/t/uni/labels.t
+++ b/gnu/usr.bin/perl/t/uni/labels.t
@@ -15,7 +15,7 @@ use feature qw 'unicode_strings evalbytes';
 
 use charnames qw( :full );
 
-plan(9);
+plan(10);
 
 ＬＡＢＥＬ: {
     pass("Sanity check, UTF-8 labels don't throw a syntax error.");
@@ -54,11 +54,13 @@ SKIP: {
     like $@, qr/Label not found for "next Ｅ" at/u, "next's error is UTF-8 clean";
 }
 
-my $d = 4;
+my $d = 2;
 LÁBEL: {
+    my $e = $@;
     my $prog = "redo L\N{LATIN CAPITAL LETTER A WITH ACUTE}BEL";
 
-    if ($d % 2) {
+    if ($d == 1) {
+        is $e, '', "redo UTF8 works";
         utf8::downgrade($prog);
     }
     if ($d--) {
@@ -68,8 +70,8 @@ LÁBEL: {
     }
 }
 
-is $@, '', "redo to downgradeable labels works";
-is $d, -1, "Latin-1 labels reachable regardless of UTF-8ness";
+like $@, qr/Unrecognized character/, "redo to downgradeable labels";
+is $d, 0, "Latin-1 labels are reachable";
 
 {
     no warnings;
diff --git a/gnu/usr.bin/perl/t/uni/latin2.t b/gnu/usr.bin/perl/t/uni/latin2.t
index 152747139ed..6e7d980aec3 100644
--- a/gnu/usr.bin/perl/t/uni/latin2.t
+++ b/gnu/usr.bin/perl/t/uni/latin2.t
@@ -9,6 +9,7 @@ BEGIN {
 
 plan tests => 94;
 
+no warnings 'deprecated';
 use encoding "latin2"; # iso 8859-2
 
 # U+00C1, \xC1, \301, LATIN CAPITAL LETTER A WITH ACUTE
diff --git a/gnu/usr.bin/perl/t/uni/lower.t b/gnu/usr.bin/perl/t/uni/lower.t
index 5ab4cdd74e1..5b706af0d84 100644
--- a/gnu/usr.bin/perl/t/uni/lower.t
+++ b/gnu/usr.bin/perl/t/uni/lower.t
@@ -5,6 +5,6 @@ BEGIN {
 }
 
 casetest(0, # No extra tests run here,
-	"Lower", \%utf8::ToSpecLower,
+	"Lowercase_Mapping",
 	 sub { lc $_[0] }, sub { my $a = ""; lc ($_[0] . $a) },
 	 sub { lcfirst $_[0] }, sub { my $a = ""; lcfirst ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/parser.t b/gnu/usr.bin/perl/t/uni/parser.t
index 79e4612c65d..009ad357386 100644
--- a/gnu/usr.bin/perl/t/uni/parser.t
+++ b/gnu/usr.bin/perl/t/uni/parser.t
@@ -7,7 +7,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan (tests => 47);
+plan (tests => 48);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -145,3 +145,10 @@ eval q{ Ｆｏｏ::$bar };
 like( $@, qr/Bad name after Ｆｏｏ::/, 'Bad name after Ｆｏｏ::' );
 eval q{ Ｆｏｏ''bar };
 like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' );
+
+{
+    no warnings 'utf8';
+    my $malformed_to_be = "\x{c0}\x{a0}";   # Overlong sequence
+    CORE::evalbytes "use charnames ':full'; use utf8; my \$x = \"\\N{abc$malformed_to_be}\"";
+    like( $@, qr/Malformed UTF-8 character immediately after '\\N\{abc' at .* within string/, 'Malformed UTF-8 input to \N{}');
+}
diff --git a/gnu/usr.bin/perl/t/uni/readline.t b/gnu/usr.bin/perl/t/uni/readline.t
index ef2106dfd21..495172ca98c 100644
--- a/gnu/usr.bin/perl/t/uni/readline.t
+++ b/gnu/usr.bin/perl/t/uni/readline.t
@@ -21,7 +21,7 @@ like($@, 'Modification of a read-only value attempted', '[perl #19566]');
   my $file = tempfile();
   open Ạ,'+>',$file; $a = 3;
   is($a .= <Ạ>, 3, '#21628 - $a .= <A> , A eof');
-  close A; $a = 4;
+  close Ạ; $a = 4;
   is($a .= <Ạ>, 4, '#21628 - $a .= <A> , A closed');
 }
 
diff --git a/gnu/usr.bin/perl/t/uni/stash.t b/gnu/usr.bin/perl/t/uni/stash.t
index 168b93c8742..7d24e5178a2 100644
--- a/gnu/usr.bin/perl/t/uni/stash.t
+++ b/gnu/usr.bin/perl/t/uni/stash.t
@@ -266,11 +266,8 @@ plan( tests => 58 );
         'ref() returns the same thing when an object’s stash is moved';
         ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
         'objects stringify the same way when their stashes are moved';
-        {
-            local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-            ::is eval '__PACKAGE__', 'rìle',
+        ::is eval '__PACKAGE__', 'rìle',
             '__PACKAGE__ returns the same when the current stash is moved';
-        }
     
         # Now detach it completely from the symtab, making it effect-
         # ively anonymous
@@ -283,11 +280,8 @@ plan( tests => 58 );
         'ref() returns the same thing when an object’s stash is detached';
         ::like "$obj", qr "^rìle=ARRAY\(0x[\da-f]+\)\z",
         'objects stringify the same way when their stashes are detached';
-        {
-            local $::TODO =  $Config{useithreads} ? "fails under threads" : undef;
-            ::is eval '__PACKAGE__', 'rìle',
+        ::is eval '__PACKAGE__', 'rìle',
             '__PACKAGE__ returns the same when the current stash is detached';
-        }
     }
     
     # Setting the name during undef %stash:: should have no effect.
diff --git a/gnu/usr.bin/perl/t/uni/title.t b/gnu/usr.bin/perl/t/uni/title.t
index 3d2eb3e2519..2d6dcb77ef3 100644
--- a/gnu/usr.bin/perl/t/uni/title.t
+++ b/gnu/usr.bin/perl/t/uni/title.t
@@ -5,5 +5,5 @@ BEGIN {
 }
 
 casetest(0, # No extra tests run here,
-	"Title", \%utf8::ToSpecTitle, sub { ucfirst $_[0] },
+	"Titlecase_Mapping", sub { ucfirst $_[0] },
 	 sub { my $a = ""; ucfirst ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/universal.t b/gnu/usr.bin/perl/t/uni/universal.t
index 8f158e90b81..626c30f8576 100644
--- a/gnu/usr.bin/perl/t/uni/universal.t
+++ b/gnu/usr.bin/perl/t/uni/universal.t
@@ -119,6 +119,7 @@ ok $a->can("slèèp");
 
 {
     package Pìckùp;
+    no warnings "deprecated";
     use UNIVERSAL qw( isa can VERSION );
 
     ::ok isa "Pìckùp", UNIVERSAL;
diff --git a/gnu/usr.bin/perl/t/uni/upper.t b/gnu/usr.bin/perl/t/uni/upper.t
index b343a1fc20a..315680c11b6 100644
--- a/gnu/usr.bin/perl/t/uni/upper.t
+++ b/gnu/usr.bin/perl/t/uni/upper.t
@@ -7,6 +7,6 @@ BEGIN {
 is(uc("\x{3B1}\x{345}\x{301}"), "\x{391}\x{301}\x{399}", 'Verify moves YPOGEGRAMMENI');
 
 casetest( 1,	# extra tests already run
-	"Upper", \%utf8::ToSpecUpper,
+	"Uppercase_Mapping",
 	 sub { uc $_[0] },
 	 sub { my $a = ""; uc ($_[0] . $a) });
diff --git a/gnu/usr.bin/perl/t/uni/variables.t b/gnu/usr.bin/perl/t/uni/variables.t
new file mode 100644
index 00000000000..cee681fd08a
--- /dev/null
+++ b/gnu/usr.bin/perl/t/uni/variables.t
@@ -0,0 +1,229 @@
+#!./perl
+
+# Checks if the parser behaves correctly in edge case
+# (including weird syntax errors)
+
+BEGIN {
+    require './test.pl';
+}
+
+use 5.016;
+use utf8;
+use open qw( :utf8 :std );
+no warnings qw(misc reserved);
+
+plan (tests => 65869);
+
+# ${single:colon} should not be valid syntax
+{
+    no strict;
+
+    local $@;
+    eval "\${\x{30cd}single:\x{30cd}colon} = 1";
+    like($@,
+         qr/syntax error .* near "\x{30cd}single:/,
+         '${\x{30cd}single:\x{30cd}colon} should not be valid syntax'
+        );
+
+    local $@;
+    no utf8;
+    evalbytes '${single:colon} = 1';
+    like($@,
+         qr/syntax error .* near "single:/,
+         '...same with ${single:colon}'
+        );
+}
+
+# ${yadda'etc} and ${yadda::etc} should both work under strict
+{
+    local $@;
+    eval q<use strict; ${flark::fleem}>;
+    is($@, '', q<${package::var} works>);
+
+    local $@;
+    eval q<use strict; ${fleem'flark}>;
+    is($@, '', q<...as does ${package'var}>);
+}
+
+# The first character in ${...} should respect the rules
+{
+   local $@;
+   use utf8;
+   eval '${☭asd} = 1';
+   like($@, qr/\QUnrecognized character/, q(the first character in ${...} isn't special))
+}
+
+# Checking that at least some of the special variables work
+for my $v (qw( ^V ; < > ( ) {^GLOBAL_PHASE} ^W _ 1 4 0 [ ] ! @ / \ = )) {
+    local $@;
+    evalbytes "\$$v;";
+    is $@, '', "No syntax error for \$$v";
+
+    local $@;
+    eval "use utf8; \$$v;";
+    is $@, '', "No syntax error for \$$v under use utf8";
+}
+
+# Checking if the Latin-1 range behaves as expected, and that the behavior is the
+# same whenever under strict or not.
+for ( 0x80..0xff ) {
+    no warnings 'closure';
+    my $chr = chr;
+    my $esc = sprintf("%X", ord $chr);
+    utf8::downgrade($chr);
+    if ($chr !~ /\p{XIDS}/u) {
+        is evalbytes "no strict; \$$chr = 10",
+            10,
+            sprintf("\\x%02x, part of the latin-1 range, is legal as a length-1 variable", $_);
+
+        utf8::upgrade($chr);
+        local $@;
+        eval "no strict; use utf8; \$$chr = 1";
+        like $@,
+            qr/\QUnrecognized character \x{\E\L$esc/,
+            sprintf("..but is illegal as a length-1 variable under use utf8", $_);
+    }
+    else {
+        {
+            no utf8;
+            local $@;
+            evalbytes "no strict; \$$chr = 1";
+            is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, latin-1, no utf8, no strict, is a valid length-1 variable", $_));
+
+            local $@;
+            evalbytes "use strict; \$$chr = 1";
+            is($@,
+                '',
+                sprintf("\\x%02x under no utf8 does not have to be required under strict, even though it matches XIDS", $_)
+            );
+
+            local $@;
+            evalbytes "\$a$chr = 1";
+            like($@,
+                qr/Unrecognized character /,
+                sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
+            );
+
+            local $@;
+            evalbytes "\$a$chr = 1";
+            like($@,
+                qr/Unrecognized character /,
+                sprintf("...but under no utf8, it's not allowed in two-or-more character variables")
+            );
+        }
+        {
+            use utf8;
+            my $u = $chr;
+            utf8::upgrade($u);
+            local $@;
+            eval "no strict; \$$u = 1";
+            is($@, '', sprintf("\\x%02x, =~ \\p{XIDS}, UTF-8, use utf8, no strict, is a valid length-1 variable", $_));
+
+            local $@;
+            eval "use strict; \$$u = 1";
+            like($@,
+                qr/Global symbol "\$$u" requires explicit package name/,
+                sprintf("\\x%02x under utf8 has to be required under strict", $_)
+            );
+        }
+    }
+}
+
+{
+    use utf8;
+    my $ret = eval "my \$c\x{327} = 100; \$c\x{327}"; # c + cedilla
+    is($@, '', "ASCII character + combining character works as a variable name");
+    is($ret, 100, "...and returns the correct value");
+}
+
+# From Tom Christiansen's 'highly illegal variable names are now accidentally legal' mail
+for my $chr (
+      "\N{EM DASH}", "\x{F8FF}", "\N{POUND SIGN}", "\N{SOFT HYPHEN}",
+      "\N{THIN SPACE}", "\x{11_1111}", "\x{DC00}", "\N{COMBINING DIAERESIS}",
+      "\N{COMBINING ENCLOSING CIRCLE BACKSLASH}",
+   )
+{
+   no warnings 'non_unicode';
+   my $esc = sprintf("%x", ord $chr);
+   local $@;
+   eval "\$$chr = 1; \$$chr";
+   like($@,
+        qr/\QUnrecognized character \x{$esc};/,
+        "\\x{$esc} is illegal for a length-one identifier"
+       );
+}
+
+for my $i (0x100..0xffff) {
+   my $chr = chr($i);
+   my $esc = sprintf("%x", $i);
+   local $@;
+   eval "my \$$chr = q<test>; \$$chr;";
+   if ( $chr =~ /^\p{_Perl_IDStart}$/ ) {
+      is($@, '', sprintf("\\x{%04x} is XIDS, works as a length-1 variable", $i));
+   }
+   else {
+      like($@,
+           qr/\QUnrecognized character \x{$esc};/,
+           "\\x{$esc} isn't XIDS, illegal as a length-1 variable",
+          )
+   }
+}
+
+{
+    # Bleadperl v5.17.9-109-g3283393 breaks ZEFRAM/Module-Runtime-0.013.tar.gz
+    # https://rt.perl.org/rt3/Public/Bug/Display.html?id=117101
+    no strict;
+
+    local $@;
+    eval <<'EOP';
+    q{$} =~ /(.)/;
+    is($$1, $$, q{$$1 parses as ${$1}});
+
+    $doof = "test";
+    $test = "Got here";
+    $::{+$$} = *doof;
+
+    is( $$$$1, $test, q{$$$$1 parses as ${${${$1}}}} );
+EOP
+    is($@, '', q{$$1 parses correctly});
+
+    for my $chr ( q{@}, "\N{U+FF10}", "\N{U+0300}" ) {
+        my $esc = sprintf("\\x{%x}", ord $chr);
+        local $@;
+        eval <<"    EOP";
+            \$$chr = q{\$};
+            \$\$$chr;
+    EOP
+
+        like($@,
+             qr/syntax error|Unrecognized character/,
+             qq{\$\$$esc is a syntax error}
+        );
+    }
+}
+
+{
+    # bleadperl v5.17.9-109-g3283393 breaks JEREMY/File-Signature-1.009.tar.gz
+    # https://rt.perl.org/rt3/Ticket/Display.html?id=117145
+    local $@;
+    my $var = 10;
+    eval ' ${  var  }';
+
+    is(
+        $@,
+        '',
+        '${  var  } works under strict'
+    );
+
+    {
+        no strict;
+        for my $var ( '$', "\7LOBAL_PHASE", "^GLOBAL_PHASE", "^V" ) {
+            eval "\${ $var}";
+            is($@, '', "\${ $var} works" );
+            eval "\${$var }";
+            is($@, '', "\${$var } works" );
+            eval "\${ $var }";
+            is($@, '', "\${ $var } works" );
+        }
+    }
+}
diff --git a/gnu/usr.bin/perl/t/win32/fs.t b/gnu/usr.bin/perl/t/win32/fs.t
new file mode 100644
index 00000000000..35d3617edcc
--- /dev/null
+++ b/gnu/usr.bin/perl/t/win32/fs.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+    eval 'use Errno';
+    die $@ if $@ and !is_miniperl();
+}
+
+plan tests => 4;
+
+my $tmpfile1 = tempfile();
+my $tmpfile2 = tempfile();
+
+# RT #112272
+ok(!link($tmpfile1, $tmpfile2),
+   "Cannot link to unknown file");
+is(0+$!, &Errno::ENOENT, "check errno is ENOENT");
+open my $fh, ">", $tmpfile1
+    or skip("Cannot create test link src", 2);
+close $fh;
+open my $fh, ">", $tmpfile2
+    or skip("Cannot create test link target", 2);
+close $fh;
+ok(!link($tmpfile1, $tmpfile2),
+   "Cannot link to existing file");
+is(0+$!, &Errno::EEXIST, "check for EEXIST");
diff --git a/gnu/usr.bin/perl/t/win32/runenv.t b/gnu/usr.bin/perl/t/win32/runenv.t
index a833c1a0f68..b2d78959b0a 100644
--- a/gnu/usr.bin/perl/t/win32/runenv.t
+++ b/gnu/usr.bin/perl/t/win32/runenv.t
@@ -73,8 +73,8 @@ sub try {
   my ($env, $args, $stdout, $stderr) = @_;
   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
   local $::Level = $::Level + 1;
-  is ($stdout, $actual_stdout);
-  is ($stderr, $actual_stderr);
+  is $actual_stdout, $stdout;
+  is $actual_stderr, $stderr;
 }
 
 #  PERL5OPT    Command-line options (switches).  Switches in
diff --git a/gnu/usr.bin/perl/t/x2p/s2p.t b/gnu/usr.bin/perl/t/x2p/s2p.t
index 9707a8b3672..0a0716da0c2 100644
--- a/gnu/usr.bin/perl/t/x2p/s2p.t
+++ b/gnu/usr.bin/perl/t/x2p/s2p.t
@@ -627,6 +627,19 @@ 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",
@@ -815,6 +828,8 @@ 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;
author	afresh1 <afresh1@openbsd.org>	2014-03-24 14:58:42 +0000
committer	afresh1 <afresh1@openbsd.org>	2014-03-24 14:58:42 +0000
commit	91f110e064cd7c194e59e019b83bb7496c1c84d4 (patch)
tree	3e8e577405dba7e94b43cbf21c22f21aaa5ab949 /gnu/usr.bin/perl/t
parent	do not call purge_task every 10 secs, it is only needed once at startup and (diff)
download	wireguard-openbsd-91f110e064cd7c194e59e019b83bb7496c1c84d4.tar.xz wireguard-openbsd-91f110e064cd7c194e59e019b83bb7496c1c84d4.zip