From 4fcbc3669aa997848e15198cc9fb856287a6788c Mon Sep 17 00:00:00 2001 From: markm Date: Wed, 9 Sep 1998 07:00:04 +0000 Subject: Initial import of Perl5. The king is dead; long live the king! --- contrib/perl5/t/TEST | 181 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 181 insertions(+) create mode 100755 contrib/perl5/t/TEST (limited to 'contrib/perl5/t/TEST') diff --git a/contrib/perl5/t/TEST b/contrib/perl5/t/TEST new file mode 100755 index 0000000..3685c2a --- /dev/null +++ b/contrib/perl5/t/TEST @@ -0,0 +1,181 @@ +#!./perl + +# Last change: Fri Jan 10 09:57:03 WET 1997 + +# This is written in a peculiar style, since we're trying to avoid +# most of the constructs we'll be testing for. + +$| = 1; + +if ($#ARGV >= 0 && $ARGV[0] eq '-v') { + $verbose = 1; + shift; +} + +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'; + +# check leakage for embedders +$ENV{PERL_DESTRUCT_LEVEL} = 2 unless exists $ENV{PERL_DESTRUCT_LEVEL}; + +$ENV{EMXSHELL} = 'sh'; # For OS/2 + +if ($#ARGV == -1) { + @ARGV = split(/[ \n]/, + `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`); +} + +%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 ); + +_testprogs('perl', @ARGV); +_testprogs('compile', @ARGV) if (-e "../testcompile"); + +sub _testprogs { + $type = shift @_; + @tests = @_; + + + print <<'EOT' if ($type eq 'compile'); +-------------------------------------------------------------------------------- +TESTING COMPILER +-------------------------------------------------------------------------------- +EOT + + $bad = 0; + $good = 0; + $total = @tests; + $files = 0; + $totmax = 0; + $maxlen = 0; + foreach (@tests) { + $len = length; + $maxlen = $len if $len > $maxlen; + } + # +3 : we want three dots between the test name and the "ok" + # -2 : the .t suffix + $dotdotdot = $maxlen + 3 - 2; + while ($test = shift @tests) { + + if ( $infinite{$test} && $type eq 'compile' ) { + print STDERR "$test creates infinite loop! Skipping.\n"; + next; + } + if ($test =~ /^$/) { + next; + } + $te = $test; + chop($te); + print "$te" . '.' x ($dotdotdot - length($te)); + + open(SCRIPT,"<$test") or die "Can't run $test.\n"; + $_ =