Commit | Line | Data |
---|---|---|
4c7c9f9a | 1 | #!./perl -w |
904d85c5 | 2 | |
282f25c9 JH |
3 | chdir 't' if -d 't'; |
4 | @INC = '../lib'; | |
4c7c9f9a | 5 | require './test.pl'; |
4c7c9f9a | 6 | use strict; |
282f25c9 JH |
7 | |
8 | $|=1; | |
9 | ||
4c7c9f9a | 10 | run_multiple_progs('', \*DATA); |
282f25c9 | 11 | |
4c7c9f9a NC |
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"); | |
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 | 32 | eval "sub #foo\n{print 1}"; |
4c7c9f9a NC |
33 | is($@, ''); |
34 | ||
35 | done_testing(); | |
904d85c5 | 36 | |
282f25c9 JH |
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 | |
16920d4e | 83 | ######## |
16920d4e RB |
84 | print sub { return "ok 1\n" } -> (); |
85 | EXPECT | |
86 | ok 1 | |
2c374370 FC |
87 | ######## |
88 | # [perl #71154] undef &$code makes $code->() die with: Not a CODE reference | |
12f98b43 | 89 | sub __ANON__ { print "42\n" } |
2c374370 FC |
90 | undef &{$x=sub{}}; |
91 | $x->(); | |
92 | EXPECT | |
12f98b43 | 93 | Undefined subroutine called at - line 4. |
172a6a76 FC |
94 | ######## |
95 | # NAME anon constant clobbering __ANON__ | |
96 | sub __ANON__ { "42\n" } | |
97 | print __ANON__; | |
98 | sub(){3}; | |
99 | EXPECT | |
100 | 42 | |
7fcb4126 FC |
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__ |