Commit | Line | Data |
---|---|---|
4c7c9f9a | 1 | #!./perl -w |
904d85c5 | 2 | |
282f25c9 JH |
3 | chdir 't' if -d 't'; |
4 | @INC = '../lib'; | |
4c7c9f9a NC |
5 | require './test.pl'; |
6 | $ENV{PERL5LIB} = "../lib" unless $^O eq 'VMS'; | |
7 | use strict; | |
282f25c9 JH |
8 | |
9 | $|=1; | |
10 | ||
4c7c9f9a | 11 | run_multiple_progs('', \*DATA); |
282f25c9 | 12 | |
4c7c9f9a NC |
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"); | |
282f25c9 JH |
17 | } |
18 | ||
4c7c9f9a NC |
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;'; | |
904d85c5 | 28 | eval $code; |
4c7c9f9a NC |
29 | like($@, qr/^Illegal declaration of anonymous subroutine at/, |
30 | "'$code' is illegal"); | |
904d85c5 RGS |
31 | } |
32 | ||
904d85c5 | 33 | eval "sub #foo\n{print 1}"; |
4c7c9f9a NC |
34 | is($@, ''); |
35 | ||
36 | done_testing(); | |
904d85c5 | 37 | |
282f25c9 JH |
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 | |
16920d4e | 84 | ######## |
16920d4e RB |
85 | print sub { return "ok 1\n" } -> (); |
86 | EXPECT | |
87 | ok 1 |