This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
anonsub.t: Improve test for [perl #71154]
[perl5.git] / t / op / anonsub.t
1 #!./perl -w
2
3 chdir 't' if -d 't';
4 @INC = '../lib';
5 require './test.pl';
6 use strict;
7
8 $|=1;
9
10 run_multiple_progs('', \*DATA);
11
12 foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
13     eval $code;
14     like($@, qr/^Illegal declaration of anonymous subroutine at/,
15          "'$code' is illegal");
16 }
17
18 {
19     local $::TODO;
20     $::TODO = 'RT #17589 not completely resolved';
21     # Here's a patch. It makes "sub;" and similar report an error immediately
22     # from the lexer. However the solution is not complete, it doesn't
23     # handle the case "sub ($) : lvalue;" (marked as a TODO test), because
24     # it's handled by the lexer in separate tokens, hence more difficult to
25     # work out.
26     my $code = 'sub ($) : lvalue;';
27     eval $code;
28     like($@, qr/^Illegal declaration of anonymous subroutine at/,
29          "'$code' is illegal");
30 }
31
32 eval "sub #foo\n{print 1}";
33 is($@, '');
34
35 done_testing();
36
37 __END__
38 sub X {
39     my $n = "ok 1\n";
40     sub { print $n };
41 }
42 my $x = X();
43 undef &X;
44 $x->();
45 EXPECT
46 ok 1
47 ########
48 sub X {
49     my $n = "ok 1\n";
50     sub {
51         my $dummy = $n; # eval can't close on $n without internal reference
52         eval 'print $n';
53         die $@ if $@;
54     };
55 }
56 my $x = X();
57 undef &X;
58 $x->();
59 EXPECT
60 ok 1
61 ########
62 sub X {
63     my $n = "ok 1\n";
64     eval 'sub { print $n }';
65 }
66 my $x = X();
67 die $@ if $@;
68 undef &X;
69 $x->();
70 EXPECT
71 ok 1
72 ########
73 sub X;
74 sub X {
75     my $n = "ok 1\n";
76     eval 'sub Y { my $p = shift; $p->() }';
77     die $@ if $@;
78     Y(sub { print $n });
79 }
80 X();
81 EXPECT
82 ok 1
83 ########
84 print sub { return "ok 1\n" } -> ();
85 EXPECT
86 ok 1
87 ########
88 # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
89 sub __ANON__ { print "42\n" }
90 undef &{$x=sub{}};
91 $x->();
92 EXPECT
93 Undefined subroutine called at - line 4.