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.
9 $Is_VMS = $^O eq 'VMS';
10 $Is_MSWin32 = $^O eq 'MSWin32';
11 $Is_NetWare = $^O eq 'NetWare';
12 $ENV{PERL5LIB} = "../lib" unless $Is_VMS;
17 @prgs = split "\n########\n", <DATA>;
18 print "1..", 6 + scalar @prgs, "\n";
20 $tmpfile = "asubtmp000";
21 1 while -f ++$tmpfile;
22 END { if ($tmpfile) { 1 while unlink $tmpfile; } }
29 my($prog,$expected) = split(/\nEXPECT\n/, $_);
30 open TEST, ">$tmpfile";
32 close TEST or die "Could not close: $!";
33 my $results = $Is_VMS ?
34 `$^X "-I[-.lib]" $switch $tmpfile 2>&1` :
36 `.\\perl -I../lib $switch $tmpfile 2>&1` :
38 `perl -I../lib $switch $tmpfile 2>&1` :
39 `./perl $switch $tmpfile 2>&1`;
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";
52 print "ok ", ++$i, "\n";
55 sub test_invalid_decl {
56 my ($code,$todo) = @_;
59 if ($@ =~ /^Illegal declaration of anonymous subroutine at/) {
60 print "ok ", ++$i, " - '$code' is illegal$todo\n";
62 print "not ok ", ++$i, " - '$code' is illegal$todo\n# GOT: $@";
66 test_invalid_decl('sub;');
67 test_invalid_decl('sub ($) ;');
68 test_invalid_decl('{ $x = sub }');
69 test_invalid_decl('sub ($) && 1');
70 test_invalid_decl('sub ($) : lvalue;',' # TODO');
72 eval "sub #foo\n{print 1}";
74 print "ok ", ++$i, "\n";
76 print "not ok ", ++$i, "\n# GOT: $@";
93 my $dummy = $n; # eval can't close on $n without internal reference
106 eval 'sub { print $n }';
118 eval 'sub Y { my $p = shift; $p->() }';
126 print sub { return "ok 1\n" } -> ();