1#!./perl 2 3# We suppose that perl _mostly_ works at this moment, so may use 4# sophisticated testing. 5 6BEGIN { 7 chdir 't' if -d 't'; 8 @INC = '../lib'; # pick up only this build's lib 9 $ENV{PERL5LIB} = '../lib'; # so children will see it too 10} 11 12my $torture; # torture testing? 13 14use Test::Harness; 15 16$Test::Harness::switches = ""; # Too much noise otherwise 17$Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v'; 18 19if ($ARGV[0] && $ARGV[0] eq '-torture') { 20 shift; 21 $torture = 1; 22} 23 24# Let tests know they're running in the perl core. Useful for modules 25# which live dual lives on CPAN. 26$ENV{PERL_CORE} = 1; 27 28#fudge DATA for now. 29%datahandle = qw( 30 lib/bigint.t 1 31 lib/bigintpm.t 1 32 lib/bigfloat.t 1 33 lib/bigfloatpm.t 1 34 op/gv.t 1 35 lib/complex.t 1 36 lib/ph.t 1 37 lib/soundex.t 1 38 op/misc.t 1 39 op/runlevel.t 1 40 op/tie.t 1 41 op/lex_assign.t 1 42 ); 43 44foreach (keys %datahandle) { 45 unlink "$_.t"; 46} 47 48my @tests = (); 49 50# [.VMS]TEST.COM calls harness with empty arguments, so clean-up @ARGV 51@ARGV = grep $_ && length( $_ ) => @ARGV; 52 53sub _populate_hash { 54 return map {$_, 1} split /\s+/, $_[0]; 55} 56 57if ($ARGV[0] && $ARGV[0]=~/^-re/) { 58 if ($ARGV[0]!~/=/) { 59 shift; 60 $re=join "|",@ARGV; 61 @ARGV=(); 62 } else { 63 (undef,$re)=split/=/,shift; 64 } 65} 66 67if (@ARGV) { 68 if ($^O eq 'MSWin32') { 69 @tests = map(glob($_),@ARGV); 70 } 71 else { 72 @tests = @ARGV; 73 } 74} else { 75 unless (@tests) { 76 push @tests, <base/*.t>; 77 push @tests, <comp/*.t>; 78 push @tests, <cmd/*.t>; 79 push @tests, <run/*.t>; 80 push @tests, <io/*.t>; 81 push @tests, <op/*.t>; 82 push @tests, <uni/*.t>; 83 push @tests, <mro/*.t>; 84 push @tests, <lib/*.t>; 85 push @tests, <japh/*.t> if $torture; 86 push @tests, <win32/*.t> if $^O eq 'MSWin32'; 87 use Config; 88 my %skip; 89 { 90 my %extensions = _populate_hash $Config{'extensions'}; 91 my %known_extensions = _populate_hash $Config{'known_extensions'}; 92 foreach (keys %known_extensions) { 93 $skip{$_}++ unless $extensions{$_}; 94 } 95 } 96 use File::Spec; 97 my $updir = File::Spec->updir; 98 my $mani = File::Spec->catfile(File::Spec->updir, "MANIFEST"); 99 if (open(MANI, $mani)) { 100 my @manitests = (); 101 my $ext_pat = $^O eq 'MSWin32' ? '(?:win32/)?ext' : 'ext'; 102 while (<MANI>) { # similar code in t/TEST 103 if (m!^($ext_pat/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) { 104 my ($test, $extension) = ($1, $2); 105 if (defined $extension) { 106 $extension =~ s!/t$!!; 107 # XXX Do I want to warn that I'm skipping these? 108 next if $skip{$extension}; 109 } 110 push @manitests, File::Spec->catfile($updir, $test); 111 } 112 } 113 close MANI; 114 # Sort the list of test files read from MANIFEST into a sensible 115 # order instead of using the order in which they are listed there 116 push @tests, sort { lc $a cmp lc $b } @manitests; 117 } else { 118 warn "$0: cannot open $mani: $!\n"; 119 } 120 push @tests, <Module_Pluggable/*.t>; 121 push @tests, <pod/*.t>; 122 push @tests, <x2p/*.t>; 123 } 124} 125if ($^O eq 'MSWin32') { 126 s,\\,/,g for @tests; 127} 128@tests=grep /$re/, @tests 129 if $re; 130Test::Harness::runtests @tests; 131exit(0); 132