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