Remove the $ENV{PERL_CORE} boilerplate from DynaLoader's tests.

[p5sagit/p5-mst-13.2.git] / t / TEST

diff --git a/t/TEST b/t/TEST
index 6589ee2..d5007ed 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -14,6 +14,33 @@
 # In which case, we need to stop t/TEST actually running tests, as all
 # t/harness needs are its subroutines.
 
+
+# directories with special sets of test switches
+my %dir_to_switch =
+    (base => '',
+     comp => '',
+     run => '',
+     '../ext/File-Glob/t' => '-I.. -MTestInit', # FIXME - tests assume t/
+     );
+
+my %temp_no_core =
+    ('../ext/Attribute-Handlers' => 1,
+     '../ext/B-Debug' => 1,
+     '../ext/Compress-Raw-Bzip2' => 1,
+     '../ext/Compress-Raw-Zlib' => 1,
+     '../ext/Devel-PPPort' => 1,
+     '../ext/Encode' => 1,
+     '../ext/Hash-Util' => 'fixme',
+     '../ext/Hash-Util-FieldHash' => 'fixme',
+     '../ext/I18N-Langinfo' => 'fixme',
+     '../ext/IO-Compress' => 1,
+     '../ext/IPC-SysV' => 1,
+     '../ext/MIME-Base64' => 1,
+     '../ext/Safe' => 'fixme',
+     '../ext/Time-HiRes' => 1,
+     '../ext/Unicode-Normalize' => 1,
+    );
+
 if ($::do_nothing) {
     return 1;
 }
@@ -28,12 +55,15 @@ $| = 1;
 #BEGIN { require '../lib/warnings.pm'; "warnings"->import() };
 
 delete $ENV{PERL5LIB};
+delete $ENV{PERLLIB};
+delete $ENV{PERL5OPT};
 
 # remove empty elements due to insertion of empty symbols via "''p1'" syntax
 @ARGV = grep($_,@ARGV) if $^O eq 'VMS';
 our $show_elapsed_time = $ENV{HARNESS_TIMER} || 0;
 
-# Cheesy version of Getopt::Std.  Maybe we should replace it with that.
+# Cheesy version of Getopt::Std.  We can't replace it with that, because we
+# can't rely on require working.
 {
     my @argv = ();
     foreach my $idx (0..$#ARGV) {
@@ -79,7 +109,6 @@ $ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL};
 
 $ENV{EMXSHELL} = 'sh';        # For OS/2
 
-# Roll your own File::Find!
 if ($show_elapsed_time) { require Time::HiRes }
 
 my %skip = (
@@ -91,6 +120,7 @@ my %skip = (
            '.svn' => 1,
           );
 
+# Roll your own File::Find!
 sub _find_tests {
     my($dir) = @_;
     opendir DIR, $dir or die "Trouble opening $dir: $!";
@@ -141,26 +171,38 @@ 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($harness, $test, $type) = @_;
+    if (!defined $type) {
+       # To conform to the interface expected by exec in TAP::Harness
+       $type = 'perl';
+    }
 
     my $options = _scan_test($test, $type);
+    my $return_dir;
 
     my $perl = './perl';
     my $lib  = '../lib';
-    $test =~ /^([^\/]+)/;
+    $test =~ /^(.+)\/[^\/]+/;
+    my $dir = $1;
+    my $ext_dir;
 
-    my $testswitch = $dir_to_switch{$1};
+    my $testswitch = $dir_to_switch{$dir};
     if (!defined $testswitch) {
-       $testswitch = '-I. -MTestInit';  # -T will remove . from @INC
+       if ($test =~ s!^(\.\./ext/[^/]+)/t!t!) {
+           $ext_dir = $1;
+           $return_dir = '../../t';
+           $lib = '../../lib';
+           $perl = '../../t/perl';
+           $testswitch = "-I../.. -MTestInit=U2T,A";
+           if ($temp_no_core{$ext_dir}) {
+               $testswitch = $testswitch . ',NC';
+           }
+           chdir $ext_dir or die "Can't chdir to '$ext_dir': $!";
+       } else {
+           $testswitch = '-I.. -MTestInit';  # -T will remove . from @INC
+       }
     }
 
     my $utf8 = $::with_utf8 ? '-I$lib -Mutf8' : '';
@@ -176,7 +218,6 @@ sub _run_test {
           or print "can't deparse '$deparse_cmd': $!.\n";
     }
     elsif ($type eq 'perl') {
-        my $perl = $ENV{PERL} || $perl;
         my $redir = $^O eq 'VMS' ? '2>&1' : '';
 
         if ($ENV{PERL_VALGRIND}) {
@@ -194,6 +235,11 @@ sub _run_test {
         open($results, $run) or print "can't run '$run': $!.\n";
     }
 
+    if ($return_dir) {
+       chdir $return_dir
+           or die "Can't chdir from '$ext_dir' to '$return_dir': $!";
+    }
+
     # Our environment may force us to use UTF-8, but we can't be sure that
     # anything we're reading from will be generating (well formed) UTF-8
     # This may not be the best way - possibly we should unset ${^OPEN} up
@@ -234,7 +280,7 @@ sub _tests_from_manifest {
     my @results;
     my $mani = '../MANIFEST';
     if (open(MANI, $mani)) {
-       while (<MANI>) { # similar code in t/harness
+       while (<MANI>) {
            if (m!^(ext/(\S+)/+(?:[^/\s]+\.t|test\.pl)|lib/\S+?(?:\.t|test\.pl))\s!) {
                my $t = $1;
                my $extension = $2;
@@ -394,7 +440,7 @@ EOT
            $te = '';
        }
 
-        my $results = _run_test($test, $type);
+        my $results = _run_test(undef, $test, $type);
 
        my $failure;
        my $next = 0;