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