extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / subs.t
1 #!./perl 
2
3 BEGIN {
4     chdir 't' if -d 't';
5     @INC = '../lib';
6     $ENV{PERL5LIB} = '../lib';
7 }
8
9 $| = 1;
10 undef $/;
11 my @prgs = split "\n########\n", <DATA>;
12 print "1..", scalar @prgs, "\n";
13
14 my $Is_VMS = $^O eq 'VMS';
15 my $Is_MSWin32 = $^O eq 'MSWin32';
16 my $Is_NetWare = $^O eq 'NetWare';
17 my $Is_MacOS = $^O eq 'MacOS';
18 my $tmpfile = "tmp0000";
19 my $i = 0 ;
20 1 while -e ++$tmpfile;
21 END {  if ($tmpfile) { 1 while unlink $tmpfile} }
22
23 for (@prgs){
24     my $switch = "";
25     my @temps = () ;
26     if (s/^\s*-\w+//){
27         $switch = $&;
28     }
29     my($prog,$expected) = split(/\nEXPECT\n/, $_);
30     if ( $prog =~ /--FILE--/) {
31         my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ;
32         shift @files ;
33         die "Internal error test $i didn't split into pairs, got " . 
34                 scalar(@files) . "[" . join("%%%%", @files) ."]\n"
35             if @files % 2 ;
36         while (@files > 2) {
37             my $filename = shift @files ;
38             my $code = shift @files ;
39             push @temps, $filename ;
40             open F, ">$filename" or die "Cannot open $filename: $!\n" ;
41             print F $code ;
42             close F ;
43         }
44         shift @files ;
45         $prog = shift @files ;
46     }
47     open TEST, ">$tmpfile";
48     print TEST $prog,"\n";
49     close TEST;
50     my $results = $Is_VMS ?
51                       `./perl $switch $tmpfile 2>&1` :
52                   $Is_MSWin32 ?
53                       `.\\perl -I../lib $switch $tmpfile 2>&1` :
54                   $Is_NetWare ?
55                       `perl -I../lib $switch $tmpfile 2>&1` :
56                   $Is_MacOS ?
57                       `$^X -I::lib -MMac::err=unix $switch $tmpfile` :
58                   `./perl $switch $tmpfile 2>&1`;
59     my $status = $?;
60     $results =~ s/\n+$//;
61     # allow expected output to be written as if $prog is on STDIN
62     $results =~ s/tmp\d+/-/g;
63     $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS;  # clip off DCL status msg
64 # bison says 'parse error' instead of 'syntax error',
65 # various yaccs may or may not capitalize 'syntax'.
66     $results =~ s/^(syntax|parse) error/syntax error/mig;
67     $expected =~ s/\n+$//;
68     my $prefix = ($results =~ s/^PREFIX\n//) ;
69     if ( $results =~ s/^SKIPPED\n//) {
70         print "$results\n" ;
71     }
72     elsif (($prefix and $results !~ /^\Q$expected/) or
73            (!$prefix and $results ne $expected)){
74         print STDERR "PROG: $switch\n$prog\n";
75         print STDERR "EXPECTED:\n$expected\n";
76         print STDERR "GOT:\n$results\n";
77         print "not ";
78     }
79     print "ok ", ++$i, "\n";
80     foreach (@temps) 
81         { unlink $_ if $_ } 
82 }
83
84 __END__
85
86 # Error - not predeclaring a sub
87 Fred 1,2 ;
88 sub Fred {}
89 EXPECT
90 Number found where operator expected at - line 3, near "Fred 1"
91         (Do you need to predeclare Fred?)
92 syntax error at - line 3, near "Fred 1"
93 Execution of - aborted due to compilation errors.
94 ########
95
96 # Error - not predeclaring a sub in time
97 Fred 1,2 ;
98 use subs qw( Fred ) ;
99 sub Fred {}
100 EXPECT
101 Number found where operator expected at - line 3, near "Fred 1"
102         (Do you need to predeclare Fred?)
103 syntax error at - line 3, near "Fred 1"
104 BEGIN not safe after errors--compilation aborted at - line 4.
105 ########
106
107 # AOK
108 use subs qw( Fred) ;
109 Fred 1,2 ;
110 sub Fred { print $_[0] + $_[1], "\n" }
111 EXPECT
112 3
113 ########
114
115 # override a built-in function
116 use subs qw( open ) ;
117 open 1,2 ;
118 sub open { print $_[0] + $_[1], "\n" }
119 EXPECT
120 3
121 ########
122
123 # override a built-in function, call after definition
124 use subs qw( open ) ;
125 sub open { print $_[0] + $_[1], "\n" }
126 open 1,2 ;
127 EXPECT
128 3
129 ########
130
131 # override a built-in function, call with ()
132 use subs qw( open ) ;
133 open (1,2) ;
134 sub open { print $_[0] + $_[1], "\n" }
135 EXPECT
136 3
137 ########
138
139 # override a built-in function, call with () after definition
140 use subs qw( open ) ;
141 sub open { print $_[0] + $_[1], "\n" }
142 open (1,2) ;
143 EXPECT
144 3
145 ########
146
147 --FILE-- abc
148 Fred 1,2 ;
149 1;
150 --FILE--
151 use subs qw( Fred ) ;
152 require "./abc" ;
153 sub Fred { print $_[0] + $_[1], "\n" }
154 EXPECT
155 3
156 ########
157
158 # check that it isn't affected by block scope
159 {
160     use subs qw( Fred ) ;
161 }
162 Fred 1, 2;
163 sub Fred { print $_[0] + $_[1], "\n" }
164 EXPECT
165 3