From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sat, 16 Jun 2001 17:38:53 +0000 (+0000)
Subject: Make t/TEST and t/harness to test also the t/ tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7a3152049c3b11217c72b149c0293284b6993763;p=p5sagit%2Fp5-mst-13.2.git

Make t/TEST and t/harness to test also the t/ tests
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
---

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 556d01a..5444a40 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -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
--- 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;
diff --git a/t/TestInit.pm b/t/TestInit.pm
index a932286..be69c24 100644
--- a/t/TestInit.pm
+++ b/t/TestInit.pm
@@ -11,10 +11,10 @@
 # (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;
 
diff --git a/t/harness b/t/harness
index 3cacc59..d5335e7 100644
--- 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";