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