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