1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# We suppose that perl _mostly_ works at this moment, so may use 4*0Sstevel@tonic-gate# sophisticated testing. 5*0Sstevel@tonic-gate 6*0Sstevel@tonic-gateBEGIN { 7*0Sstevel@tonic-gate chdir 't' if -d 't'; 8*0Sstevel@tonic-gate @INC = '../lib'; # pick up only this build's lib 9*0Sstevel@tonic-gate $ENV{PERL5LIB} = '../lib'; # so children will see it too 10*0Sstevel@tonic-gate} 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gatemy $torture; # torture testing? 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gateuse Test::Harness; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate$Test::Harness::switches = ""; # Too much noise otherwise 17*0Sstevel@tonic-gate$Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gateif ($ARGV[0] eq '-torture') { 20*0Sstevel@tonic-gate shift; 21*0Sstevel@tonic-gate $torture = 1; 22*0Sstevel@tonic-gate} 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gate# Let tests know they're running in the perl core. Useful for modules 25*0Sstevel@tonic-gate# which live dual lives on CPAN. 26*0Sstevel@tonic-gate$ENV{PERL_CORE} = 1; 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gate#fudge DATA for now. 29*0Sstevel@tonic-gate%datahandle = qw( 30*0Sstevel@tonic-gate lib/bigint.t 1 31*0Sstevel@tonic-gate lib/bigintpm.t 1 32*0Sstevel@tonic-gate lib/bigfloat.t 1 33*0Sstevel@tonic-gate lib/bigfloatpm.t 1 34*0Sstevel@tonic-gate op/gv.t 1 35*0Sstevel@tonic-gate lib/complex.t 1 36*0Sstevel@tonic-gate lib/ph.t 1 37*0Sstevel@tonic-gate lib/soundex.t 1 38*0Sstevel@tonic-gate op/misc.t 1 39*0Sstevel@tonic-gate op/runlevel.t 1 40*0Sstevel@tonic-gate op/tie.t 1 41*0Sstevel@tonic-gate op/lex_assign.t 1 42*0Sstevel@tonic-gate ); 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gateforeach (keys %datahandle) { 45*0Sstevel@tonic-gate unlink "$_.t"; 46*0Sstevel@tonic-gate} 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gatemy @tests = (); 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gateif (@ARGV) { 51*0Sstevel@tonic-gate if ($^O eq 'MSWin32') { 52*0Sstevel@tonic-gate @tests = map(glob($_),@ARGV); 53*0Sstevel@tonic-gate } 54*0Sstevel@tonic-gate else { 55*0Sstevel@tonic-gate @tests = @ARGV; 56*0Sstevel@tonic-gate } 57*0Sstevel@tonic-gate} else { 58*0Sstevel@tonic-gate unless (@tests) { 59*0Sstevel@tonic-gate push @tests, <base/*.t>; 60*0Sstevel@tonic-gate push @tests, <comp/*.t>; 61*0Sstevel@tonic-gate push @tests, <cmd/*.t>; 62*0Sstevel@tonic-gate push @tests, <run/*.t>; 63*0Sstevel@tonic-gate push @tests, <io/*.t>; 64*0Sstevel@tonic-gate push @tests, <op/*.t>; 65*0Sstevel@tonic-gate push @tests, <uni/*.t>; 66*0Sstevel@tonic-gate push @tests, <lib/*.t>; 67*0Sstevel@tonic-gate push @tests, <japh/*.t> if $torture; 68*0Sstevel@tonic-gate push @tests, <win32/*.t> if $^O eq 'MSWin32'; 69*0Sstevel@tonic-gate use File::Spec; 70*0Sstevel@tonic-gate my $updir = File::Spec->updir; 71*0Sstevel@tonic-gate my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); 72*0Sstevel@tonic-gate if (open(MANI, $mani)) { 73*0Sstevel@tonic-gate while (<MANI>) { # similar code in t/TEST 74*0Sstevel@tonic-gate if (m!^(ext/\S+/?(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { 75*0Sstevel@tonic-gate push @tests, File::Spec->catfile($updir, $1); 76*0Sstevel@tonic-gate } 77*0Sstevel@tonic-gate } 78*0Sstevel@tonic-gate close MANI; 79*0Sstevel@tonic-gate } else { 80*0Sstevel@tonic-gate warn "$0: cannot open $mani: $!\n"; 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate push @tests, <pod/*.t>; 83*0Sstevel@tonic-gate push @tests, <x2p/*.t>; 84*0Sstevel@tonic-gate } 85*0Sstevel@tonic-gate} 86*0Sstevel@tonic-gateif ($^O eq 'MSWin32') { 87*0Sstevel@tonic-gate s,\\,/,g for @tests; 88*0Sstevel@tonic-gate} 89*0Sstevel@tonic-gateTest::Harness::runtests @tests; 90*0Sstevel@tonic-gateexit(0) unless -e "../testcompile"; 91*0Sstevel@tonic-gate 92*0Sstevel@tonic-gate# %infinite = qw ( 93*0Sstevel@tonic-gate# op/bop.t 1 94*0Sstevel@tonic-gate# lib/hostname.t 1 95*0Sstevel@tonic-gate# op/lex_assign.t 1 96*0Sstevel@tonic-gate# lib/ph.t 1 97*0Sstevel@tonic-gate# ); 98*0Sstevel@tonic-gate 99*0Sstevel@tonic-gatemy $dhwrapper = <<'EOT'; 100*0Sstevel@tonic-gateopen DATA,"<".__FILE__; 101*0Sstevel@tonic-gateuntil (($_=<DATA>) =~ /^__END__/) {}; 102*0Sstevel@tonic-gateEOT 103*0Sstevel@tonic-gate 104*0Sstevel@tonic-gate@tests = grep (!$infinite{$_}, @tests); 105*0Sstevel@tonic-gate@tests = map { 106*0Sstevel@tonic-gate my $new = $_; 107*0Sstevel@tonic-gate if ($datahandle{$_} && !( -f "$new.t") ) { 108*0Sstevel@tonic-gate $new .= '.t'; 109*0Sstevel@tonic-gate local(*F, *T); 110*0Sstevel@tonic-gate open(F,"<$_") or die "Can't open $_: $!"; 111*0Sstevel@tonic-gate open(T,">$new") or die "Can't open $new: $!"; 112*0Sstevel@tonic-gate print T $dhwrapper, <F>; 113*0Sstevel@tonic-gate close F; 114*0Sstevel@tonic-gate close T; 115*0Sstevel@tonic-gate } 116*0Sstevel@tonic-gate $new; 117*0Sstevel@tonic-gate } @tests; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gateprint "The tests ", join(' ', keys(%infinite)), 120*0Sstevel@tonic-gate " generate infinite loops! Skipping!\n"; 121*0Sstevel@tonic-gate 122*0Sstevel@tonic-gate$ENV{'HARNESS_COMPILE_TEST'} = 1; 123*0Sstevel@tonic-gate$ENV{'PERLCC_TIMEOUT'} = 120 unless $ENV{'PERLCC_TIMEOUT'}; 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gateTest::Harness::runtests @tests; 126*0Sstevel@tonic-gateforeach (keys %datahandle) { 127*0Sstevel@tonic-gate unlink "$_.t"; 128*0Sstevel@tonic-gate} 129