Add 'indirect' feature that can be turned off to disable indirect object syntax

Co-authored-by: Tony Cook <tony@develop-help.com>

2 files changed, 142 insertions, 0 deletions

diff --git a/t/lib/feature/indirect b/t/lib/feature/indirect
new file mode 100644
index 0000000000..cd96f899b1
--- /dev/null
+++ b/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/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat
index 96494d2640..758b4b4940 100644
--- a/t/porting/known_pod_issues.dat
+++ b/t/porting/known_pod_issues.dat
@@ -150,6 +150,7 @@ HTML::StripScripts
 HTTP::Lite
 iconv(1)
 iconv(3)
+indirect
 inetd(8)
 invoker
 IO::Compress