Commit | Line | Data |
282f25c9 |
1 | #!./perl |
2 | |
3 | chdir '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 |
9 | $ENV{PERL5LIB} = "../lib" unless $Is_VMS; |
10 | |
11 | $|=1; |
12 | |
13 | undef $/; |
14 | @prgs = split "\n########\n", <DATA>; |
15 | print "1..", scalar @prgs, "\n"; |
16 | |
17 | $tmpfile = "asubtmp000"; |
18 | 1 while -f ++$tmpfile; |
19 | END { if ($tmpfile) { 1 while unlink $tmpfile; } } |
20 | |
21 | for (@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 |
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 |
36 | $Is_NetWare ? |
37 | `perl -I../lib $switch $tmpfile 2>&1` : |
38 | `./perl $switch $tmpfile 2>&1`; |
282f25c9 |
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__ |
55 | sub X { |
56 | my $n = "ok 1\n"; |
57 | sub { print $n }; |
58 | } |
59 | my $x = X(); |
60 | undef &X; |
61 | $x->(); |
62 | EXPECT |
63 | ok 1 |
64 | ######## |
65 | sub 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 | } |
73 | my $x = X(); |
74 | undef &X; |
75 | $x->(); |
76 | EXPECT |
77 | ok 1 |
78 | ######## |
79 | sub X { |
80 | my $n = "ok 1\n"; |
81 | eval 'sub { print $n }'; |
82 | } |
83 | my $x = X(); |
84 | die $@ if $@; |
85 | undef &X; |
86 | $x->(); |
87 | EXPECT |
88 | ok 1 |
89 | ######## |
90 | sub X; |
91 | sub X { |
92 | my $n = "ok 1\n"; |
93 | eval 'sub Y { my $p = shift; $p->() }'; |
94 | die $@ if $@; |
95 | Y(sub { print $n }); |
96 | } |
97 | X(); |
98 | EXPECT |
99 | ok 1 |
16920d4e |
100 | ######## |
101 | package; |
102 | print sub { return "ok 1\n" } -> (); |
103 | EXPECT |
104 | ok 1 |