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'; |
282f25c9 |
8 | $ENV{PERL5LIB} = "../lib" unless $Is_VMS; |
9 | |
10 | $|=1; |
11 | |
12 | undef $/; |
13 | @prgs = split "\n########\n", <DATA>; |
14 | print "1..", scalar @prgs, "\n"; |
15 | |
16 | $tmpfile = "asubtmp000"; |
17 | 1 while -f ++$tmpfile; |
18 | END { if ($tmpfile) { 1 while unlink $tmpfile; } } |
19 | |
20 | for (@prgs){ |
21 | my $switch = ""; |
22 | if (s/^\s*(-\w+)//){ |
23 | $switch = $1; |
24 | } |
25 | my($prog,$expected) = split(/\nEXPECT\n/, $_); |
26 | open TEST, ">$tmpfile"; |
27 | print TEST "$prog\n"; |
28 | close TEST; |
29 | my $results = $Is_VMS ? |
95e8664e |
30 | `MCR $^X "-I[-.lib]" $switch $tmpfile 2>&1` : |
31 | $Is_MSWin32 ? |
32 | `.\\perl -I../lib $switch $tmpfile 2>&1` : |
33 | $Is_MacOS ? |
34 | `$^X -I::lib $switch $tmpfile` : |
35 | `./perl $switch $tmpfile 2>&1`; |
282f25c9 |
36 | my $status = $?; |
37 | $results =~ s/\n+$//; |
38 | # allow expected output to be written as if $prog is on STDIN |
39 | $results =~ s/runltmp\d+/-/g; |
40 | $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg |
41 | $expected =~ s/\n+$//; |
42 | if ($results ne $expected) { |
43 | print STDERR "PROG: $switch\n$prog\n"; |
44 | print STDERR "EXPECTED:\n$expected\n"; |
45 | print STDERR "GOT:\n$results\n"; |
46 | print "not "; |
47 | } |
48 | print "ok ", ++$i, "\n"; |
49 | } |
50 | |
51 | __END__ |
52 | sub X { |
53 | my $n = "ok 1\n"; |
54 | sub { print $n }; |
55 | } |
56 | my $x = X(); |
57 | undef &X; |
58 | $x->(); |
59 | EXPECT |
60 | ok 1 |
61 | ######## |
62 | sub X { |
63 | my $n = "ok 1\n"; |
64 | sub { |
65 | my $dummy = $n; # eval can't close on $n without internal reference |
66 | eval 'print $n'; |
67 | die $@ if $@; |
68 | }; |
69 | } |
70 | my $x = X(); |
71 | undef &X; |
72 | $x->(); |
73 | EXPECT |
74 | ok 1 |
75 | ######## |
76 | sub X { |
77 | my $n = "ok 1\n"; |
78 | eval 'sub { print $n }'; |
79 | } |
80 | my $x = X(); |
81 | die $@ if $@; |
82 | undef &X; |
83 | $x->(); |
84 | EXPECT |
85 | ok 1 |
86 | ######## |
87 | sub X; |
88 | sub X { |
89 | my $n = "ok 1\n"; |
90 | eval 'sub Y { my $p = shift; $p->() }'; |
91 | die $@ if $@; |
92 | Y(sub { print $n }); |
93 | } |
94 | X(); |
95 | EXPECT |
96 | ok 1 |