X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2FTEST;h=58f1da5a5a611cfdcaf7cd73f3f70f498e6d653d;hb=a3323f52209391b4b2c45b3e1feb26c6f51fb6fa;hp=c466d0e1675f45193b75123f098360997f23ec96;hpb=0c3906b8d7f8aa1d0043aa83d9efabd51a266d7b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/TEST b/t/TEST
index c466d0e..58f1da5 100755
--- a/t/TEST
+++ b/t/TEST
@@ -14,9 +14,6 @@ $| = 1;
 #BEGIN { require '../lib/strict.pm'; "strict"->import() };
 #BEGIN { require '../lib/warnings.pm'; "warnings"->import() };
 
-# Let tests know they're running in the perl core.  Useful for modules
-# which live dual lives on CPAN.
-$ENV{PERL_CORE} = 1;
 delete $ENV{PERL5LIB};
 
 # remove empty elements due to insertion of empty symbols via "''p1'" syntax
@@ -70,7 +67,6 @@ $ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
 $ENV{EMXSHELL} = 'sh';        # For OS/2
 
 # Roll your own File::Find!
-use TestInit;
 if ($show_elapsed_time) { require Time::HiRes }
 
 my %skip = (
@@ -133,27 +129,41 @@ sub _scan_test {
     return { file => $file_opts, switch => $switch };
 }
 
+# directories with special sets of test switches
+my %dir_to_switch =
+    (base => '',
+     comp => '',
+     run => '',
+     );
 
 sub _run_test {
     my($test, $type) = @_;
 
     my $options = _scan_test($test, $type);
 
-    my $utf8 = $::with_utf8 ? '-I../lib -Mutf8' : '';
-    my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
+    my $perl = './perl';
+    my $lib  = '../lib';
+    $test =~ /^([^\/]+)/;
+
+    my $testswitch = $dir_to_switch{$1};
+    if (!defined $testswitch) {
+	$testswitch = '-I. -MTestInit';  # -T will remove . from @INC
+    }
+
+    my $utf8 = $::with_utf8 ? '-I$lib -Mutf8' : '';
 
     my $results;
     if ($type eq 'deparse') {
         my $deparse_cmd =
-          "./perl $testswitch $options->{switch} -I../lib -MO=-qq,Deparse,-sv1.,".
+          "$perl $testswitch $options->{switch} -I$lib -MO=-qq,Deparse,-sv1.,".
           "-l$::deparse_opts$options->{file} ".
           "$test > $test.dp ".
-          "&& ./perl $testswitch $options->{switch} -I../lib $test.dp |";
+          "&& $perl $testswitch $options->{switch} -I$lib $test.dp |";
         open($results, $deparse_cmd)
           or print "can't deparse '$deparse_cmd': $!.\n";
     }
     elsif ($type eq 'perl') {
-        my $perl = $ENV{PERL} || './perl';
+        my $perl = $ENV{PERL} || $perl;
         my $redir = $^O eq 'VMS' ? '2>&1' : '';
 
         if ($ENV{PERL_VALGRIND}) {
@@ -166,7 +176,7 @@ sub _run_test {
             $redir = "3>$Valgrind_Log";
         }
 
-        my $run = "$perl" . _quote_args("$testswitch $options->{switch} $utf8")
+        my $run = $perl . _quote_args("$testswitch $options->{switch} $utf8")
           . " $test $redir|";
         open($results, $run) or print "can't run '$run': $!.\n";
     }
@@ -194,56 +204,28 @@ sub _quote_args {
 }
 
 sub _populate_hash {
+    return unless defined $_[0];
     return map {$_, 1} split /\s+/, $_[0];
 }
 
-unless (@ARGV) {
-    # base first, as TEST bails out if that can't run
-    # then comp, to validate that require works
-    # then run, to validate that -M works
-    # then we know we can -MTestInit for everything else, making life simpler
-    foreach my $dir (qw(base comp run cmd io op uni mro)) {
-	_find_tests($dir);
-    }
-    _find_tests("lib") unless $::core;
-    # Config.pm may be broken for make minitest. And this is only a refinement
-    # for skipping tests on non-default builds, so it is allowed to fail.
-    # What we want to to is make a list of extensions which we did not build.
-    my $configsh = '../config.sh';
+sub _tests_from_manifest {
+    my ($extensions, $known_extensions) = @_;
     my %skip;
-    if (-f $configsh) {
-	my (%extensions, %known_extensions);
-	open FH, $configsh or die "Can't open $configsh: $!";
-	while (<FH>) {
-	    if (/^extensions=['"](.*)['"]$/) {
-		# Deliberate string interpolation to avoid triggering possible
-		# $1 resetting bugs.
-		%extensions = _populate_hash ("$1");
-	    }
-	    elsif (/^known_extensions=['"](.*)['"]$/) {
-		%known_extensions = _populate_hash ($1);
-	    }
-	}
-	if (%extensions) {
-	    if (%known_extensions) {
-		foreach (keys %known_extensions) {
-		    $skip{$_}++ unless $extensions{$_};
-		}
-	    } else {
-		warn "No known_extensions line found in $configsh";
-	    }
-	} else {
-	    warn "No extensions line found in $configsh";
-	}
+    my %extensions = _populate_hash($extensions);
+    my %known_extensions = _populate_hash($known_extensions);
+
+    foreach (keys %known_extensions) {
+	$skip{$_}++ unless $extensions{$_};
     }
+
+    my @results;
     my $mani = '../MANIFEST';
     if (open(MANI, $mani)) {
 	while (<MANI>) { # similar code in t/harness
 	    if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
 		my $t = $1;
 		my $extension = $2;
-		if (!$::core || $t =~ m!^lib/[a-z]!)
-		{
+		if (!$::core || $t =~ m!^lib/[a-z]!) {
 		    if (defined $extension) {
 			$extension =~ s!/t$!!;
 			# XXX Do I want to warn that I'm skipping these?
@@ -253,7 +235,7 @@ unless (@ARGV) {
 			next if $skip{$flat_extension}; # Foo/Bar may live in Foo-Bar
 		    }
 		    my $path = "../$t";
-		    push @ARGV, $path;
+		    push @results, $path;
 		    $::path_to_name{$path} = $t;
 		}
 	    }
@@ -262,6 +244,45 @@ unless (@ARGV) {
     } else {
 	warn "$0: cannot open $mani: $!\n";
     }
+    return @results;
+}
+
+unless (@ARGV) {
+    # base first, as TEST bails out if that can't run
+    # then comp, to validate that require works
+    # then run, to validate that -M works
+    # then we know we can -MTestInit for everything else, making life simpler
+    foreach my $dir (qw(base comp run cmd io op uni mro)) {
+	_find_tests($dir);
+    }
+    _find_tests("lib") unless $::core;
+    # Config.pm may be broken for make minitest. And this is only a refinement
+    # for skipping tests on non-default builds, so it is allowed to fail.
+    # What we want to to is make a list of extensions which we did not build.
+    my $configsh = '../config.sh';
+    my ($extensions, $known_extensions);
+    if (-f $configsh) {
+	open FH, $configsh or die "Can't open $configsh: $!";
+	while (<FH>) {
+	    if (/^extensions=['"](.*)['"]$/) {
+		$extensions = $1;
+	    }
+	    elsif (/^known_extensions=['"](.*)['"]$/) {
+		$known_extensions = $1;
+	    }
+	}
+	if (!defined $known_extensions) {
+	    warn "No known_extensions line found in $configsh";
+	}
+	if (!defined $extensions) {
+	    warn "No extensions line found in $configsh";
+	}
+    }
+    # The "complex" constructions of list return from a subroutine, and push of
+    # a list, might fail if perl is really hosed, but they aren't needed for
+    # make minitest, and the building of extensions will likely also fail if
+    # something is that badly wrong.
+    push @ARGV, _tests_from_manifest($extensions, $known_extensions);
     unless ($::core) {
 	_find_tests('pod');
 	_find_tests('x2p');
@@ -360,9 +381,6 @@ EOT
 	    $te = '';
 	}
 
-	# XXX DAPM %OVER not defined anywhere
-	# $test = $OVER{$test} if exists $OVER{$test};
-
         my $results = _run_test($test, $type);
 
 	my $failure;