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
index 970440b..6b8745f 100644 (file)
--- a/t/op/anonsub.t
+++ b/t/op/anonsub.t
@@ -1,83 +1,38 @@
-#!./perl
-
-# Note : we're not using t/test.pl here, because we would need
-# fresh_perl_is, and fresh_perl_is uses a closure -- a special
-# case of what this program tests for.
+#!./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..", 6 + scalar @prgs, "\n";
-
-$tmpfile = "asubtmp000";
-1 while -f ++$tmpfile;
-END { if ($tmpfile) { 1 while unlink $tmpfile; } }
+run_multiple_progs('', \*DATA);
 
-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 or die "Could not close: $!";
-    my $results = $Is_VMS ?
-               `$^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";
+foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
+    eval $code;
+    like($@, qr/^Illegal declaration of anonymous subroutine at/,
+        "'$code' is illegal");
 }
 
-sub test_invalid_decl {
-    my ($code,$todo) = @_;
-    $todo //= '';
+{
+    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;
-    if ($@ =~ /^Illegal declaration of anonymous subroutine at/) {
-       print "ok ", ++$i, " - '$code' is illegal$todo\n";
-    } else {
-       print "not ok ", ++$i, " - '$code' is illegal$todo\n# GOT: $@";
-    }
+    like($@, qr/^Illegal declaration of anonymous subroutine at/,
+        "'$code' is illegal");
 }
 
-test_invalid_decl('sub;');
-test_invalid_decl('sub ($) ;');
-test_invalid_decl('{ $x = sub }');
-test_invalid_decl('sub ($) && 1');
-test_invalid_decl('sub ($) : lvalue;',' # TODO');
-
 eval "sub #foo\n{print 1}";
-if ($@ eq '') {
-    print "ok ", ++$i, "\n";
-} else {
-    print "not ok ", ++$i, "\n# GOT: $@";
-}
+is($@, '');
+
+done_testing();
 
 __END__
 sub X {
@@ -129,3 +84,10 @@ 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.