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
CommitLineData
4c7c9f9a 1#!./perl -w
904d85c5 2
282f25c9
JH
3chdir 't' if -d 't';
4@INC = '../lib';
4c7c9f9a 5require './test.pl';
4c7c9f9a 6use strict;
282f25c9
JH
7
8$|=1;
9
4c7c9f9a 10run_multiple_progs('', \*DATA);
282f25c9 11
4c7c9f9a
NC
12foreach my $code ('sub;', 'sub ($) ;', '{ $x = sub }', 'sub ($) && 1') {
13 eval $code;
14 like($@, qr/^Illegal declaration of anonymous subroutine at/,
15 "'$code' is illegal");
282f25c9
JH
16}
17
4c7c9f9a
NC
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;';
904d85c5 27 eval $code;
4c7c9f9a
NC
28 like($@, qr/^Illegal declaration of anonymous subroutine at/,
29 "'$code' is illegal");
904d85c5
RGS
30}
31
904d85c5 32eval "sub #foo\n{print 1}";
4c7c9f9a
NC
33is($@, '');
34
35done_testing();
904d85c5 36
282f25c9
JH
37__END__
38sub X {
39 my $n = "ok 1\n";
40 sub { print $n };
41}
42my $x = X();
43undef &X;
44$x->();
45EXPECT
46ok 1
47########
48sub 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}
56my $x = X();
57undef &X;
58$x->();
59EXPECT
60ok 1
61########
62sub X {
63 my $n = "ok 1\n";
64 eval 'sub { print $n }';
65}
66my $x = X();
67die $@ if $@;
68undef &X;
69$x->();
70EXPECT
71ok 1
72########
73sub X;
74sub X {
75 my $n = "ok 1\n";
76 eval 'sub Y { my $p = shift; $p->() }';
77 die $@ if $@;
78 Y(sub { print $n });
79}
80X();
81EXPECT
82ok 1
16920d4e 83########
16920d4e
RB
84print sub { return "ok 1\n" } -> ();
85EXPECT
86ok 1
2c374370
FC
87########
88# [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
12f98b43 89sub __ANON__ { print "42\n" }
2c374370
FC
90undef &{$x=sub{}};
91$x->();
92EXPECT
12f98b43 93Undefined subroutine called at - line 4.
172a6a76
FC
94########
95# NAME anon constant clobbering __ANON__
96sub __ANON__ { "42\n" }
97print __ANON__;
98sub(){3};
99EXPECT
10042
7fcb4126
FC
101########
102# NAME undef &anon giving it a freed GV
103$_ = sub{};
104delete $::{__ANON__};
105undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1
106 # so now SvTYPE(CvGV(anon)) is 0xff == freed
107if (!eval { require B }) { # miniperl, presumably
108 print "__ANON__\n";
109} else {
110 print B::svref_2object($_)->GV->NAME, "\n";
111}
112EXPECT
113__ANON__