fix /test_bootstrap.t under -DPERL_NO_COW

[perl5.git] / t / op / anonsub.t

diff --git a/t/op/anonsub.t b/t/op/anonsub.t
old mode 100755 (executable)
new mode 100644 (file)
index 0e4c404..6b8745f
--- a/t/op/anonsub.t
+++ b/t/op/anonsub.t
@@ -1,56 +1,39 @@
-#!./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";
@@ -97,3 +80,14 @@ sub X {
 X();
 EXPECT
 ok 1
+########
+print sub { return "ok 1\n" } -> ();
+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 4.