Epigraph for 5.29.8
[perl.git] / t / op / anonsub.t
1 #!./perl -w
2
3 chdir 't' if -d 't';
4 require './test.pl';
5 set_up_inc('../lib');
6
7 use strict;
8
9 $|=1;
10
11 run_multiple_progs('', \*DATA);
12
13 foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
14     eval $code;
15     like($@, qr/^Illegal declaration of anonymous subroutine at/,
16          "'$code' is illegal");
17 }
18
19 {
20     local $::TODO;
21     $::TODO = 'RT #17589 not completely resolved';
22     # Here's a patch. It makes "sub;" and similar report an error immediately
23     # from the lexer. However the solution is not complete, it doesn't
24     # handle the case "sub ($) : lvalue;" (marked as a TODO test), because
25     # it's handled by the lexer in separate tokens, hence more difficult to
26     # work out.
27     my $code = 'sub ($) : lvalue;';
28     eval $code;
29     like($@, qr/^Illegal declaration of anonymous subroutine at/,
30          "'$code' is illegal");
31 }
32
33 eval "sub #foo\n{print 1}";
34 is($@, '');
35
36 done_testing();
37
38 __END__
39 sub X {
40     my $n = "ok 1\n";
41     sub { print $n };
42 }
43 my $x = X();
44 undef &X;
45 $x->();
46 EXPECT
47 ok 1
48 ########
49 sub X {
50     my $n = "ok 1\n";
51     sub {
52         my $dummy = $n; # eval can't close on $n without internal reference
53         eval 'print $n';
54         die $@ if $@;
55     };
56 }
57 my $x = X();
58 undef &X;
59 $x->();
60 EXPECT
61 ok 1
62 ########
63 sub X {
64     my $n = "ok 1\n";
65     eval 'sub { print $n }';
66 }
67 my $x = X();
68 die $@ if $@;
69 undef &X;
70 $x->();
71 EXPECT
72 ok 1
73 ########
74 sub X;
75 sub X {
76     my $n = "ok 1\n";
77     eval 'sub Y { my $p = shift; $p->() }';
78     die $@ if $@;
79     Y(sub { print $n });
80 }
81 X();
82 EXPECT
83 ok 1
84 ########
85 print sub { return "ok 1\n" } -> ();
86 EXPECT
87 ok 1
88 ########
89 # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
90 sub __ANON__ { print "42\n" }
91 undef &{$x=sub{}};
92 $x->();
93 EXPECT
94 Undefined subroutine called at - line 4.
95 ########
96 # NAME anon constant clobbering __ANON__
97 sub __ANON__ { "42\n" }
98 print __ANON__;
99 sub(){3};
100 EXPECT
101 42
102 ########
103 # NAME undef &anon giving it a freed GV
104 $_ = sub{};
105 delete $::{__ANON__};
106 undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1
107            # so now SvTYPE(CvGV(anon)) is 0xff == freed
108 if (!eval { require B }) { # miniperl, presumably
109     print "__ANON__\n";
110 } else {
111     print B::svref_2object($_)->GV->NAME, "\n";
112 }
113 EXPECT
114 __ANON__