xref: /openbsd/gnu/usr.bin/perl/t/op/anonsub.t (revision 3cab2bb3) 
1#!./perl -w
2
3chdir 't' if -d 't';
4require './test.pl';
5set_up_inc('../lib');
6
7use strict;
8
9$|=1;
10
11run_multiple_progs('', \*DATA);
12
13foreach 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
33eval "sub #foo\n{print 1}";
34is($@, '');
35
36done_testing();
37
38__END__
39sub X {
40    my $n = "ok 1\n";
41    sub { print $n };
42}
43my $x = X();
44undef &X;
45$x->();
46EXPECT
47ok 1
48########
49sub 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}
57my $x = X();
58undef &X;
59$x->();
60EXPECT
61ok 1
62########
63sub X {
64    my $n = "ok 1\n";
65    eval 'sub { print $n }';
66}
67my $x = X();
68die $@ if $@;
69undef &X;
70$x->();
71EXPECT
72ok 1
73########
74sub X;
75sub X {
76    my $n = "ok 1\n";
77    eval 'sub Y { my $p = shift; $p->() }';
78    die $@ if $@;
79    Y(sub { print $n });
80}
81X();
82EXPECT
83ok 1
84########
85print sub { return "ok 1\n" } -> ();
86EXPECT
87ok 1
88########
89# [perl #71154] undef &$code makes $code->() die with: Not a CODE reference
90sub __ANON__ { print "42\n" }
91undef &{$x=sub{}};
92$x->();
93EXPECT
94Undefined subroutine called at - line 4.
95########
96# NAME anon constant clobbering __ANON__
97sub __ANON__ { "42\n" }
98print __ANON__;
99sub(){3};
100EXPECT
10142
102########
103# NAME undef &anon giving it a freed GV
104$_ = sub{};
105delete $::{__ANON__};
106undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1
107           # so now SvTYPE(CvGV(anon)) is 0xff == freed
108if (!eval { require B }) { # miniperl, presumably
109    print "__ANON__\n";
110} else {
111    print B::svref_2object($_)->GV->NAME, "\n";
112}
113EXPECT
114__ANON__
115