This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix assertion failure with undef &my_sub/&anon
[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.
94 ########
95 # NAME anon constant clobbering __ANON__
96 sub __ANON__ { "42\n" }
97 print __ANON__;
98 sub(){3};
99 EXPECT
100 42
101 ########
102 # NAME undef &anon giving it a freed GV
103 $_ = sub{};
104 delete $::{__ANON__};
105 undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1
106            # so now SvTYPE(CvGV(anon)) is 0xff == freed
107 if (!eval { require B }) { # miniperl, presumably
108     print "__ANON__\n";
109 } else {
110     print B::svref_2object($_)->GV->NAME, "\n";
111 }
112 EXPECT
113 __ANON__