-#!./perl
+#!./perl -w
chdir 't' if -d 't';
@INC = '../lib';
-$Is_VMS = $^O eq 'VMS';
-$Is_MSWin32 = $^O eq 'MSWin32';
-$Is_MacOS = $^O eq 'MacOS';
-$Is_NetWare = $^O eq 'NetWare';
-$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
+require './test.pl';
+use strict;
$|=1;
-undef $/;
-@prgs = split "\n########\n", <DATA>;
-print "1..", scalar @prgs, "\n";
+run_multiple_progs('', \*DATA);
-$tmpfile = "asubtmp000";
-1 while -f ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
+ eval $code;
+ like($@, qr/^Illegal declaration of anonymous subroutine at/,
+ "'$code' is illegal");
+}
-for (@prgs){
- my $switch = "";
- if (s/^\s*(-\w+)//){
- $switch = $1;
- }
- my($prog,$expected) = split(/\nEXPECT\n/, $_);
- open TEST, ">$tmpfile";
- print TEST "$prog\n";
- close TEST;
- my $results = $Is_VMS ?
- `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
- $Is_MSWin32 ?
- `.\\perl -I../lib $switch $tmpfile 2>&1` :
- $Is_MacOS ?
- `$^X -I::lib $switch $tmpfile` :
- $Is_NetWare ?
- `perl -I../lib $switch $tmpfile 2>&1` :
- `./perl $switch $tmpfile 2>&1`;
- my $status = $?;
- $results =~ s/\n+$//;
- # allow expected output to be written as if $prog is on STDIN
- $results =~ s/runltmp\d+/-/g;
- $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
- $expected =~ s/\n+$//;
- if ($results ne $expected) {
- print STDERR "PROG: $switch\n$prog\n";
- print STDERR "EXPECTED:\n$expected\n";
- print STDERR "GOT:\n$results\n";
- print "not ";
- }
- print "ok ", ++$i, "\n";
+{
+ local $::TODO;
+ $::TODO = 'RT #17589 not completely resolved';
+ # Here's a patch. It makes "sub;" and similar report an error immediately
+ # from the lexer. However the solution is not complete, it doesn't
+ # handle the case "sub ($) : lvalue;" (marked as a TODO test), because
+ # it's handled by the lexer in separate tokens, hence more difficult to
+ # work out.
+ my $code = 'sub ($) : lvalue;';
+ eval $code;
+ like($@, qr/^Illegal declaration of anonymous subroutine at/,
+ "'$code' is illegal");
}
+eval "sub #foo\n{print 1}";
+is($@, '');
+
+done_testing();
+
__END__
sub X {
my $n = "ok 1\n";
EXPECT
ok 1
########
-package;
print sub { return "ok 1\n" } -> ();
EXPECT
ok 1