This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In test.pl, avoid using a closure to capture warnings.
[perl5.git] / t / op / anonsub.t
CommitLineData
282f25c9
JH
1#!./perl
2
904d85c5
RGS
3# Note : we're not using t/test.pl here, because we would need
4# fresh_perl_is, and fresh_perl_is uses a closure -- a special
5# case of what this program tests for.
6
282f25c9
JH
7chdir 't' if -d 't';
8@INC = '../lib';
9$Is_VMS = $^O eq 'VMS';
10$Is_MSWin32 = $^O eq 'MSWin32';
2986a63f 11$Is_NetWare = $^O eq 'NetWare';
282f25c9
JH
12$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
13
14$|=1;
15
16undef $/;
17@prgs = split "\n########\n", <DATA>;
904d85c5 18print "1..", 6 + scalar @prgs, "\n";
282f25c9
JH
19
20$tmpfile = "asubtmp000";
211 while -f ++$tmpfile;
22END { if ($tmpfile) { 1 while unlink $tmpfile; } }
23
24for (@prgs){
25 my $switch = "";
26 if (s/^\s*(-\w+)//){
27 $switch = $1;
28 }
29 my($prog,$expected) = split(/\nEXPECT\n/, $_);
30 open TEST, ">$tmpfile";
31 print TEST "$prog\n";
d1e4d418 32 close TEST or die "Could not close: $!";
282f25c9 33 my $results = $Is_VMS ?
16ed4686 34 `$^X "-I[-.lib]" $switch $tmpfile 2>&1` :
95e8664e
CN
35 $Is_MSWin32 ?
36 `.\\perl -I../lib $switch $tmpfile 2>&1` :
7b903762
RGS
37 $Is_NetWare ?
38 `perl -I../lib $switch $tmpfile 2>&1` :
39 `./perl $switch $tmpfile 2>&1`;
282f25c9
JH
40 my $status = $?;
41 $results =~ s/\n+$//;
42 # allow expected output to be written as if $prog is on STDIN
43 $results =~ s/runltmp\d+/-/g;
44 $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
45 $expected =~ s/\n+$//;
46 if ($results ne $expected) {
47 print STDERR "PROG: $switch\n$prog\n";
48 print STDERR "EXPECTED:\n$expected\n";
49 print STDERR "GOT:\n$results\n";
50 print "not ";
51 }
52 print "ok ", ++$i, "\n";
53}
54
904d85c5
RGS
55sub test_invalid_decl {
56 my ($code,$todo) = @_;
57 $todo //= '';
58 eval $code;
59 if ($@ =~ /^Illegal declaration of anonymous subroutine at/) {
60 print "ok ", ++$i, " - '$code' is illegal$todo\n";
61 } else {
62 print "not ok ", ++$i, " - '$code' is illegal$todo\n# GOT: $@";
63 }
64}
65
66test_invalid_decl('sub;');
67test_invalid_decl('sub ($) ;');
68test_invalid_decl('{ $x = sub }');
69test_invalid_decl('sub ($) && 1');
70test_invalid_decl('sub ($) : lvalue;',' # TODO');
71
72eval "sub #foo\n{print 1}";
73if ($@ eq '') {
74 print "ok ", ++$i, "\n";
75} else {
76 print "not ok ", ++$i, "\n# GOT: $@";
77}
78
282f25c9
JH
79__END__
80sub X {
81 my $n = "ok 1\n";
82 sub { print $n };
83}
84my $x = X();
85undef &X;
86$x->();
87EXPECT
88ok 1
89########
90sub X {
91 my $n = "ok 1\n";
92 sub {
93 my $dummy = $n; # eval can't close on $n without internal reference
94 eval 'print $n';
95 die $@ if $@;
96 };
97}
98my $x = X();
99undef &X;
100$x->();
101EXPECT
102ok 1
103########
104sub X {
105 my $n = "ok 1\n";
106 eval 'sub { print $n }';
107}
108my $x = X();
109die $@ if $@;
110undef &X;
111$x->();
112EXPECT
113ok 1
114########
115sub X;
116sub X {
117 my $n = "ok 1\n";
118 eval 'sub Y { my $p = shift; $p->() }';
119 die $@ if $@;
120 Y(sub { print $n });
121}
122X();
123EXPECT
124ok 1
16920d4e 125########
16920d4e
RB
126print sub { return "ok 1\n" } -> ();
127EXPECT
128ok 1