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######## 89my @void_warnings; 90{ 91 use warnings; 92 local $SIG{'__WARN__'} = sub { push @void_warnings, @_ }; 93 sub { 1 }; 94 1 95} 96"@void_warnings" 97EXPECT 98Useless use of anonymous subroutine in void context at - line 5. 99######## 100# [perl #71154] undef &$code makes $code->() die with: Not a CODE reference 101sub __ANON__ { print "42\n" } 102undef &{$x=sub{}}; 103$x->(); 104EXPECT 105Undefined subroutine called at - line 4. 106######## 107# NAME anon constant clobbering __ANON__ 108sub __ANON__ { "42\n" } 109print __ANON__; 110sub(){3}; 111EXPECT 11242 113######## 114# NAME undef &anon giving it a freed GV 115$_ = sub{}; 116delete $::{__ANON__}; 117undef &$_; # SvREFCNT_dec + inc on a GV with a refcnt of 1 118 # so now SvTYPE(CvGV(anon)) is 0xff == freed 119if (!eval { require B }) { # miniperl, presumably 120 print "__ANON__\n"; 121} else { 122 print B::svref_2object($_)->GV->NAME, "\n"; 123} 124EXPECT 125__ANON__ 126