Make t/TEST and t/harness to test also the t/ tests
Jarkko Hietaniemi [Sat, 16 Jun 2001 17:38:53 +0000 (17:38 +0000)]
under the main lib/ and ext/ directories.  Fix Test::Harness
to dynamically change the width of its "foo/bar....ok" output.

p4raw-id: //depot/perl@10634

lib/Test/Harness.pm
t/TEST
t/TestInit.pm
t/harness

index 556d01a..5444a40 100644 (file)
@@ -395,8 +395,16 @@ sub _run_all_tests {
     my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
     my $t_start = new Benchmark;
 
+    my $maxlen;
+    foreach (@tests) {
+       my $len = length;
+       $maxlen = $len if $len > $maxlen;
+    }
+    # +3 : we want three dots between the test name and the "ok"
+    # -2 : the .t suffix
+    my $width = $maxlen + 3 - 2;
     foreach my $tfile (@tests) {
-        my($leader, $ml) = _mk_leader($tfile);
+        my($leader, $ml) = _mk_leader($tfile, $width);
         print $leader;
 
         my $fh = _open_test($tfile);
@@ -531,22 +539,23 @@ sub _run_all_tests {
 
 =item B<_mk_leader>
 
-  my($leader, $ml) = _mk_leader($test_file);
+  my($leader, $ml) = _mk_leader($test_file, $width);
 
 Generates the 't/foo........' $leader for the given $test_file as well
 as a similar version which will overwrite the current line (by use of
 \r and such).  $ml may be empty if Test::Harness doesn't think you're
-on TTY.
+on TTY.  The width is the width of the "yada/blah..." string.
 
 =cut
 
 sub _mk_leader {
-    my $te = shift;
+    my ($te, $width) = @_;
+
     chop($te);      # XXX chomp?
 
     if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
     my $blank = (' ' x 77);
-    my $leader = "$te" . '.' x (20 - length($te));
+    my $leader = "$te" . '.' x ($width - length($te));
     my $ml = "";
 
     $ml = "\r$blank\r$leader"
diff --git a/t/TEST b/t/TEST
index 9dd34f3..5400999 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -24,7 +24,7 @@ chdir 't' if -f 't/TEST';
 die "You need to run \"make test\" first to set things up.\n"
   unless -e 'perl' or -e 'perl.exe';
 
-if ($ENV{PERL_3LOG}) {
+if ($ENV{PERL_3LOG}) { # Tru64 third(1) tool, see perlhack
     unless (-x 'perl.third') {
        unless (-x '../perl.third') {
            die "You need to run \"make perl.third first.\n";
@@ -44,7 +44,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;
 use File::Spec;
@@ -68,8 +67,20 @@ unless (@ARGV) {
     foreach my $dir (qw(base comp cmd run io op pragma lib pod)) {
         _find_tests($dir);
     }
+    my $mani = File::Spec->catdir($updir, "MANIFEST");
+    if (open(MANI, $mani)) {
+        while (<MANI>) {
+           if (m!^((?:ext|lib)/.+/t/[^/]+\.t)\s!) {
+               push @ARGV, $1;
+               $OVER{$1} = File::Spec->catdir($updir, $1);
+           }
+       }
+    } else {
+        warn "$0: cannot open $mani: $!\n";
+    }
 }
 
+# Tests known to cause infinite loops for the perlcc tests.
 # %infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
 %infinite = ();
 
@@ -84,17 +95,16 @@ sub _testprogs {
     $type = shift @_;
     @tests = @_;
 
-
     print <<'EOT' if ($type eq 'compile');
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 TESTING COMPILER
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 EOT
 
     print <<'EOT' if ($type eq 'deparse');
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 TESTING DEPARSER
---------------------------------------------------------------------------------
+------------------------------------------------------------------------------
 EOT
 
     $ENV{PERLCC_TIMEOUT} = 120
@@ -136,6 +146,8 @@ EOT
        chop($te);
        print "$te" . '.' x ($dotdotdot - length($te));
 
+       $test = $OVER{$test} if exists $OVER{$test};
+
        open(SCRIPT,"<$test") or die "Can't run $test.\n";
        $_ = <SCRIPT>;
        close(SCRIPT) unless ($type eq 'deparse');
@@ -159,15 +171,17 @@ EOT
            }
            close(SCRIPT);
        }
-       my $utf = $with_utf ? '-I../lib -Mutf8'
-                           : '';
+
+       $test = $OVER{$test} if exists $OVER{$test};
+
+       my $utf = $with_utf ? '-I../lib -Mutf8' : '';
        my $testswitch = '-I. -MTestInit'; # -T will strict . from @INC
        if ($type eq 'deparse') {
            my $deparse =
                "./perl $testswitch $switch -I../lib -MO=-qq,Deparse,".
                "-l$deparse_opts$file_opts ".
-               "./$test > ./$test.dp ".
-               "&& ./perl $testswitch $switch -I../lib ./$test.dp |";
+               "$test > $test.dp ".
+               "&& ./perl $testswitch $switch -I../lib $test.dp |";
            open(RESULTS, $deparse)
                or print "can't deparse '$deparse': $!.\n";
        }
@@ -178,11 +192,11 @@ EOT
        else {
            my $compile =
                "./perl $testswitch -I../lib ../utils/perlcc -o ".
-                "./$test.plc $utf ./$test ".
-               " && ./$test.plc |";
+                "$test.plc $utf $test ".
+               " && $test.plc |";
            open(RESULTS, $compile)
                or print "can't compile '$compile': $!.\n";
-           unlink "./$test.plc";
+           unlink "$test.plc";
        }
 
        $ok = 0;
index a932286..be69c24 100644 (file)
 # (not require) in the test scripts.
 #
 # PS this is not POD because this should be a very minimalist module in
-# case of fundemental perl breakage.
+# case of funaemental perl breakage.
 
 chdir 't' if -d 't';
 @INC = '../lib';
-$0 =~ s/\.dp$//;
+$0 =~ s/\.dp$//; # for the test.deparse make target
 1;
 
index 3cacc59..d5335e7 100644 (file)
--- a/t/harness
+++ b/t/harness
@@ -36,8 +36,23 @@ foreach (keys %datahandle) {
      unlink "$_.t";
 }
 
-@tests = @ARGV;
-@tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t pod/*.t> unless @tests;
+if (@ARGV) {
+    @tests = @ARGV;
+} else {
+    @tests = <base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t lib/*.t pod/*.t> unless @tests;
+    use File::Spec;
+    my $updir = File::Spec->updir;
+    my $mani  = File::Spec->catdir(File::Spec->updir, "MANIFEST");
+    if (open(MANI, $mani)) {
+        while (<MANI>) {
+           if (m!^((?:ext|lib)/.+/t/[^/]+\.t)\s!) {
+               push @tests, File::Spec->catdir($updir, $1);
+           }
+       }
+    } else {
+        warn "$0: cannot open $mani: $!\n";
+    }
+}
 
 Test::Harness::runtests @tests;
 exit(0) unless -e "../testcompile";