diff options
| -rw-r--r-- | lib/Test/Harness.pm | 19 | ||||
| -rwxr-xr-x | t/TEST | 42 | ||||
| -rw-r--r-- | t/TestInit.pm | 4 | ||||
| -rw-r--r-- | t/harness | 19 |
4 files changed, 61 insertions, 23 deletions
diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 556d01a421..5444a406cf 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" @@ -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 a9322862ce..be69c24d7a 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; @@ -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"; |