This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
RE: [PATCH] Warning on pararameterless 'use IO' and doc update
[perl5.git] / t / op / anonsub.t
CommitLineData
282f25c9
JH
1#!./perl
2
3chdir 't' if -d 't';
4@INC = '../lib';
5$Is_VMS = $^O eq 'VMS';
6$Is_MSWin32 = $^O eq 'MSWin32';
95e8664e 7$Is_MacOS = $^O eq 'MacOS';
2986a63f 8$Is_NetWare = $^O eq 'NetWare';
282f25c9
JH
9$ENV{PERL5LIB} = "../lib" unless $Is_VMS;
10
11$|=1;
12
13undef $/;
14@prgs = split "\n########\n", <DATA>;
15print "1..", scalar @prgs, "\n";
16
17$tmpfile = "asubtmp000";
181 while -f ++$tmpfile;
19END { if ($tmpfile) { 1 while unlink $tmpfile; } }
20
21for (@prgs){
22 my $switch = "";
23 if (s/^\s*(-\w+)//){
24 $switch = $1;
25 }
26 my($prog,$expected) = split(/\nEXPECT\n/, $_);
27 open TEST, ">$tmpfile";
28 print TEST "$prog\n";
d1e4d418 29 close TEST or die "Could not close: $!";
282f25c9 30 my $results = $Is_VMS ?
95e8664e
CN
31 `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` :
32 $Is_MSWin32 ?
33 `.\\perl -I../lib $switch $tmpfile 2>&1` :
34 $Is_MacOS ?
35 `$^X -I::lib $switch $tmpfile` :
2986a63f
JH
36 $Is_NetWare ?
37 `perl -I../lib $switch $tmpfile 2>&1` :
38 `./perl $switch $tmpfile 2>&1`;
282f25c9
JH
39 my $status = $?;
40 $results =~ s/\n+$//;
41 # allow expected output to be written as if $prog is on STDIN
42 $results =~ s/runltmp\d+/-/g;
43 $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
44 $expected =~ s/\n+$//;
45 if ($results ne $expected) {
46 print STDERR "PROG: $switch\n$prog\n";
47 print STDERR "EXPECTED:\n$expected\n";
48 print STDERR "GOT:\n$results\n";
49 print "not ";
50 }
51 print "ok ", ++$i, "\n";
52}
53
54__END__
55sub X {
56 my $n = "ok 1\n";
57 sub { print $n };
58}
59my $x = X();
60undef &X;
61$x->();
62EXPECT
63ok 1
64########
65sub X {
66 my $n = "ok 1\n";
67 sub {
68 my $dummy = $n; # eval can't close on $n without internal reference
69 eval 'print $n';
70 die $@ if $@;
71 };
72}
73my $x = X();
74undef &X;
75$x->();
76EXPECT
77ok 1
78########
79sub X {
80 my $n = "ok 1\n";
81 eval 'sub { print $n }';
82}
83my $x = X();
84die $@ if $@;
85undef &X;
86$x->();
87EXPECT
88ok 1
89########
90sub X;
91sub X {
92 my $n = "ok 1\n";
93 eval 'sub Y { my $p = shift; $p->() }';
94 die $@ if $@;
95 Y(sub { print $n });
96}
97X();
98EXPECT
99ok 1
16920d4e 100########
16920d4e
RB
101print sub { return "ok 1\n" } -> ();
102EXPECT
103ok 1