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);
=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"
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";
$ENV{EMXSHELL} = 'sh'; # For OS/2
-
# Roll your own File::Find!
use TestInit;
use File::Spec;
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 = ();
$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
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');
}
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";
}
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;
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";