6 files changed, 394 insertions, 6 deletions
diff --git a/gnu/usr.bin/perl/t/lib/CannotParse.pm b/gnu/usr.bin/perl/t/lib/CannotParse.pm
new file mode 100644
index 00000000000..a84195f4473
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/CannotParse.pm
@@ -0,0 +1,2 @@
+# a module that fails parsing
+-
diff --git a/gnu/usr.bin/perl/t/lib/croak/pp_ctl b/gnu/usr.bin/perl/t/lib/croak/pp_ctl
index b1e754c356b..de0221b57d3 100644
--- a/gnu/usr.bin/perl/t/lib/croak/pp_ctl
+++ b/gnu/usr.bin/perl/t/lib/croak/pp_ctl
@@ -51,3 +51,11 @@ use 5.01;
 default{}
 EXPECT
 Can't "default" outside a topicalizer at - line 2.
+########
+# NAME croak with read only $@
+eval '"a" =~ /${*@=\_})/';
+die;
+# this would previously recurse infinitely in the eval
+EXPECT
+Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1.
+	...propagated at - line 2.
diff --git a/gnu/usr.bin/perl/t/lib/croak/regcomp b/gnu/usr.bin/perl/t/lib/croak/regcomp
index 0ba705e9159..a203f136fd6 100644
--- a/gnu/usr.bin/perl/t/lib/croak/regcomp
+++ b/gnu/usr.bin/perl/t/lib/croak/regcomp
@@ -4,28 +4,28 @@ __END__
 qr/\N{U+7FFFFFFFFFFFFFFF}/;
 qr/\N{U+1_0000_0000_0000_0000}/;
 EXPECT
-Use of code point 0x1_0000_0000_0000_0000 is not allowed; the permissible max is 0x7fffffffffffffff in regex; marked by <-- HERE in m/\N{U+1_0000_0000_0000_0000 <-- HERE }/ at - line 2.
+Use of code point 0x1_0000_0000_0000_0000 is not allowed; the permissible max is 0x7FFFFFFFFFFFFFFF in regex; marked by <-- HERE in m/\N{U+1_0000_0000_0000_0000 <-- HERE }/ at - line 2.
 ########
 # NAME \N{U+too large} on 32-bit machine
 # SKIP ? use Config; $Config{uvsize} > 4 && "Not 32 bit"
 qr/\N{U+7FFFFFFF}/;
 qr/\N{U+1_0000_0000}/;
 EXPECT
-Use of code point 0x1_0000_0000 is not allowed; the permissible max is 0x7fffffff in regex; marked by <-- HERE in m/\N{U+1_0000_0000 <-- HERE }/ at - line 2.
+Use of code point 0x1_0000_0000 is not allowed; the permissible max is 0x7FFFFFFF in regex; marked by <-- HERE in m/\N{U+1_0000_0000 <-- HERE }/ at - line 2.
 ########
 # NAME \N{U+100.too large} on 64-bit machine
 # SKIP ? use Config; $Config{uvsize} < 8 && "Not 64 bit"
 qr/\N{U+100.7FFFFFFFFFFFFFFF}/;
 qr/\N{U+100.1_0000_0000_0000_0000}/;
 EXPECT
-Use of code point 0x1_0000_0000_0000_0000 is not allowed; the permissible max is 0x7fffffffffffffff in regex; marked by <-- HERE in m/\N{U+100.1_0000_0000_0000_0000 <-- HERE }/ at - line 2.
+Use of code point 0x1_0000_0000_0000_0000 is not allowed; the permissible max is 0x7FFFFFFFFFFFFFFF in regex; marked by <-- HERE in m/\N{U+100.1_0000_0000_0000_0000 <-- HERE }/ at - line 2.
 ########
 # NAME \N{U+100.too large} on 32-bit machine
 # SKIP ? use Config; $Config{uvsize} > 4 && "Not 32 bit"
 qr/\N{U+100.7FFFFFFF}/;
 qr/\N{U+100.1_0000_0000}/;
 EXPECT
-Use of code point 0x1_0000_0000 is not allowed; the permissible max is 0x7fffffff in regex; marked by <-- HERE in m/\N{U+100.1_0000_0000 <-- HERE }/ at - line 2.
+Use of code point 0x1_0000_0000 is not allowed; the permissible max is 0x7FFFFFFF in regex; marked by <-- HERE in m/\N{U+100.1_0000_0000 <-- HERE }/ at - line 2.
 ########
 # NAME \N{U+.}
 my $p00="\\N{U+.}"; qr/$p00/;
@@ -63,6 +63,12 @@ my $p00="[\\x59\\N{U+.}]"; qr/$p00/ui;
 EXPECT
 Invalid hexadecimal number in \N{U+...} in regex; marked by <-- HERE in m/[\x59\N{U+. <-- HERE }]/ at - line 1.
 ########
+# NAME \N{U+...} leading underscore not allowed, medial is allowed
+my $p00='\N{U+FF_FF}'; qr/$p00/;
+$p00='\N{U+_FF}'; qr/$p00/;
+EXPECT
+Invalid hexadecimal number in \N{U+...} in regex; marked by <-- HERE in m/\N{U+_ <-- HERE FF}/ at - line 2.
+########
 # NAME ${^RE_COMPILE_RECURSION_LIMIT} [perl #131551]
 BEGIN { ${^RE_COMPILE_RECURSION_LIMIT} = ${^RE_COMPILE_RECURSION_LIMIT} = 2; }
 qr/(a)/;
@@ -70,3 +76,111 @@ qr/((a))/;
 EXPECT
 Too many nested open parens in regex; marked by <-- HERE in m/(( <-- HERE a))/ at - line 3.
 ########
+# NAME \K not permitted in lookahead
+qr/(?=a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=a\K <-- HERE a)a/ at - line 1.
+########
+# NAME \K not permitted in lookahead (alpha)
+no warnings 'experimental::alpha_assertions';
+qr/(*positive_lookahead:a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(*positive_lookahead:a\K <-- HERE a)a/ at - line 2.
+########
+# NAME \K not permitted in negative lookahead
+qr/(?!a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?!a\K <-- HERE a)a/ at - line 1.
+########
+# NAME \K not permitted in negative lookahead (alpha)
+no warnings 'experimental::alpha_assertions';
+qr/(*negative_lookahead:a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(*negative_lookahead:a\K <-- HERE a)a/ at - line 2.
+########
+# NAME \K not permitted in lookbehind
+qr/(?<=a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?<=a\K <-- HERE a)a/ at - line 1.
+########
+# NAME \K not permitted in lookbehind (alpha)
+no warnings 'experimental::alpha_assertions';
+qr/(*positive_lookbehind:a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(*positive_lookbehind:a\K <-- HERE a)a/ at - line 2.
+########
+# NAME \K not permitted in negative lookbehind
+qr/(?<!a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?<!a\K <-- HERE a)a/ at - line 1.
+########
+# NAME \K not permitted in negative lookbehind (alpha)
+no warnings 'experimental::alpha_assertions';
+qr/(*negative_lookbehind:a\Ka)a/;
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(*negative_lookbehind:a\K <-- HERE a)a/ at - line 2.
+########
+# NAME \K nesting in lookahead after lookahead
+qr{(?=(?=x)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=(?=x)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K nesting in lookahead after negative lookahead
+qr{(?=(?!y)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=(?!y)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K nesting in lookahead in negative lookahead
+qr{(?=(?!y\K)x)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=(?!y\K <-- HERE )x)x/ at - line 1.
+########
+# NAME \K nesting in lookahead in lookahead
+qr{(?=(?=x\K)x)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=(?=x\K <-- HERE )x)x/ at - line 1.
+########
+# NAME \K nesting in lookbehind after lookbehind
+qr{(?<=(?<=x)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?<=(?<=x)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K nesting in lookahead after lookbehind
+qr{(?=(?<=x)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?=(?<=x)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K nesting in lookbehind after lookahead
+qr{(?<=(?=x)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?<=(?=x)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K nesting in negative lookbehind after lookahead
+qr{(?<!(?=x)x\K)x};
+EXPECT
+\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/(?<!(?=x)x\K <-- HERE )x/ at - line 1.
+########
+# NAME \K is permitted after the lookahead GH#18123
+qr/(?=(?=x)x)\K/;
+qr/(?!(?=x)x)\K/;
+qr/(?=(?!x)x)\K/;
+qr/(?!(?!x)x)\K/;
+qr/(?<=(?=x)x)\K/;
+qr/(?<!(?=x)x)\K/;
+qr/(?<=(?!x)x)\K/;
+qr/(?<!(?!x)x)\K/;
+qr/(?=(?<=x)x)\K/;
+qr/(?!(?<=x)x)\K/;
+qr/(?=(?<!x)x)\K/;
+qr/(?!(?<!x)x)\K/;
+qr/(?<=(?<=x)x)\K/;
+qr/(?<!(?<=x)x)\K/;
+qr/(?<=(?<!x)x)\K/;
+qr/(?<!(?<!x)x)\K/;
+EXPECT
+OPTIONS nonfatal
+########
+# NAME numeric parsing buffer overflow in numeric.c
+0=~/\p{nV:-0}/
+EXPECT
+Can't find Unicode property definition "nV:-0" in regex; marked by <-- HERE in m/\p{nV:-0} <-- HERE / at - line 1.
diff --git a/gnu/usr.bin/perl/t/lib/feature/bits b/gnu/usr.bin/perl/t/lib/feature/bits
new file mode 100644
index 00000000000..227f852c2c6
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/bits
@@ -0,0 +1,45 @@
+Test specifically for things that cop_features broke
+
+__END__
+# NAME check clearing $^H clears the bits
+use feature 'say';
+BEGIN { %^H = () }
+say "Fail";
+EXPECT
+String found where operator expected at - line 3, near "say "Fail""
+	(Do you need to predeclare say?)
+syntax error at - line 3, near "say "Fail""
+Execution of - aborted due to compilation errors.
+########
+# NAME check copying $^H restores the bits
+use feature 'say';
+say "Hello";
+BEGIN { our %work = %^H; }
+no feature 'say';
+BEGIN { %^H = our %work }
+say "Goodbye";
+EXPECT
+Hello
+Goodbye
+########
+# NAME check deleting entries (via feature.pm) clears the bits
+use feature 'say';
+say "Hello";
+no feature 'say';
+say "Goodbye";
+EXPECT
+String found where operator expected at - line 4, near "say "Goodbye""
+	(Do you need to predeclare say?)
+syntax error at - line 4, near "say "Goodbye""
+Execution of - aborted due to compilation errors.
+########
+# NAME check deleting entries (bypass feature.pm) clears the bits
+use feature 'say';
+say "Hello";
+BEGIN { delete $^H{feature_say}; }
+say "Goodbye";
+EXPECT
+String found where operator expected at - line 4, near "say "Goodbye""
+	(Do you need to predeclare say?)
+syntax error at - line 4, near "say "Goodbye""
+Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/lib/feature/indirect b/gnu/usr.bin/perl/t/lib/feature/indirect
new file mode 100644
index 00000000000..cd96f899b1c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/feature/indirect
@@ -0,0 +1,141 @@
+Test no feature indirect.
+
+__END__
+# NAME feature indirect
+use feature 'say';
+package Foo {
+  sub new { bless {}, shift }
+}
+# various indirect object look-alikes
+my $foox = "foox";
+print STDERR "Hello\n";
+printf STDERR "Test%s\n", "x";
+say STDERR "Hello";
+exec $foox "foo", "bar";
+system $foox "foo", "bar";
+my $x = new Foo;
+no feature "indirect";
+print STDERR "Hello\n";
+printf STDERR "Test%s\n", "x";
+say STDERR "Hello";
+exec $foox "foo", "bar";
+system $foox "foo", "bar";
+my $y = new Foo;
+EXPECT
+OPTIONS fatal
+Bareword found where operator expected at - line 19, near "new Foo"
+	(Do you need to predeclare new?)
+syntax error at - line 19, near "new Foo"
+Execution of - aborted due to compilation errors.
+########
+# NAME METHOD BLOCK
+use feature 'say';
+package Foo {
+  sub new { bless {}, shift }
+}
+# make sure this works (either way)
+my $st = STDOUT;
+print { $st } "Foo\n";
+say { $st } "Foo";
+
+# make sure this continues to work by default
+my $class = "Foo";
+my $x = new { $class };
+
+use feature "indirect";
+
+# and with it explicitly enabled
+
+print { $st } "Foo\n";
+say { $st } "Foo";
+
+my $y = new { $class };
+
+
+no feature "indirect";
+
+# and only the indirect now fails
+print { $st } "Foo\n";
+say { $st } "Foo";
+my $z = new { $class };
+
+EXPECT
+OPTIONS fatal
+syntax error at - line 29, near "new { "
+Execution of - aborted due to compilation errors.
+########
+# NAME METHOD SCALAR
+use feature 'say';
+package Foo {
+  sub new { bless {}, shift }
+}
+# make sure this works (either way)
+my $st = STDOUT;
+print $st "Foo\n";
+say $st "Foo";
+
+# make sure this continues to work by default
+my $class = "Foo";
+my $x = new $class;
+
+use feature "indirect";
+
+# and with it explicitly enabled
+
+print $st "Foo\n";
+say $st "Foo";
+
+my $y = new $class;
+
+
+no feature "indirect";
+
+# and only the indirect now fails
+print $st "Foo\n";
+say $st "Foo";
+my $z = new $class;
+
+EXPECT
+OPTIONS fatal
+Scalar found where operator expected at - line 29, near "new $class"
+	(Do you need to predeclare new?)
+syntax error at - line 29, near "new $class"
+Execution of - aborted due to compilation errors.
+########
+# NAME FUNCMETH SCALAR
+use feature 'say';
+package Foo {
+  sub new { bless {}, shift }
+}
+# make sure this works (either way)
+my $st = STDOUT;
+print $st ("Foo\n");
+say $st ("Foo");
+
+# make sure this continues to work by default
+my $class = "Foo";
+my $x = new $class ();
+
+use feature "indirect";
+
+# and with it explicitly enabled
+
+print $st ("Foo\n");
+say $st ("Foo");
+
+my $y = new $class ();
+
+
+no feature "indirect";
+
+# and only the indirect now fails
+print $st ("Foo\n");
+say $st ("Foo");
+my $z = new $class ();
+
+EXPECT
+OPTIONS fatal
+Scalar found where operator expected at - line 29, near "new $class"
+	(Do you need to predeclare new?)
+syntax error at - line 29, near "new $class "
+Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/lib/warnings/gv b/gnu/usr.bin/perl/t/lib/warnings/gv
index 2a2dcf45470..2caf2d36b58 100644
--- a/gnu/usr.bin/perl/t/lib/warnings/gv
+++ b/gnu/usr.bin/perl/t/lib/warnings/gv
@@ -16,7 +16,6 @@ __END__
 use warnings 'syntax' ;
 @ISA = qw(Fred); joe()
 EXPECT
-Can't locate package Fred for @main::ISA at - line 3.
 Undefined subroutine &main::joe called at - line 3.
 ########
 # gv.c
@@ -26,6 +25,86 @@ EXPECT
 Undefined subroutine &main::joe called at - line 3.
 ########
 # gv.c
+use warnings 'syntax' ;
+@ISA = qw(Fred); __PACKAGE__->joe()
+EXPECT
+While trying to resolve method call main->joe() can not locate package "Fred" yet it is mentioned in @main::ISA (perhaps you forgot to load "Fred"?) at - line 3.
+Can't locate object method "joe" via package "main" at - line 3.
+########
+# gv.c
+no warnings 'syntax' ;
+@ISA = qw(Fred); __PACKAGE__->joe()
+EXPECT
+Can't locate object method "joe" via package "main" at - line 3.
+########
+# gv.c
+use warnings 'syntax' ;
+{
+    package AA;    # this is a deliberate error
+#   package A;     # should be this
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+While trying to resolve method call C->foo() can not locate package "A" yet it is mentioned in @C::ISA (perhaps you forgot to load "A"?) at - line 18.
+I'm in B's foo
+########
+# gv.c
+no warnings 'syntax' ;
+{
+    package AA;    # this is a deliberate error
+#   package A;     # should be this
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+I'm in B's foo
+########
+# gv.c
+use warnings 'syntax' ;
+{
+#   package AA;    # this would be an error
+    package A;     # the right thing
+    sub foo {
+       print STDERR "I'm in A's foo\n";
+    }
+}
+{
+   package B;
+   sub foo {
+       print STDERR "I'm in B's foo\n";
+   }
+}
+@C::ISA = qw(A B);
+$a = bless [], 'C';
+$a->foo();
+__END__
+EXPECT
+I'm in A's foo
+########
+# gv.c
 $a = ${^ENCODING};
 $a = ${^E_NCODING};
 ${^E_NCODING} = 1; # We pretend this variable never existed.
@@ -38,7 +117,6 @@ use open qw( :utf8 :std );
 package Ｙ;
 @ISA = qw(Fred); joe()
 EXPECT
-Can't locate package Fred for @Ｙ::ISA at - line 6.
 Undefined subroutine &Ｙ::joe called at - line 6.
 ########
 # gv.c