UTEST revision 7c478bd95313f5f23a4c958a745db2134aa03244
1008N/A#!./perl
1278N/A
2868N/A# Last change: Fri Jan 10 09:57:03 WET 1997
2868N/A
2868N/A# This is written in a peculiar style, since we're trying to avoid
2868N/A# most of the constructs we'll be testing for.
2868N/A
2868N/A$| = 1;
2868N/A
2868N/Aif ($#ARGV >= 0 && $ARGV[0] eq '-v') {
2868N/A $verbose = 1;
2868N/A shift;
2868N/A}
2868N/A
2868N/Achdir 't' if -f 't/TEST';
2868N/A
2868N/Adie "You need to run \"make test\" first to set things up.\n"
2868N/A unless -e 'perl' or -e 'perl.exe';
2868N/A
2868N/A#$ENV{PERL_DESTRUCT_LEVEL} = '2';
2868N/A$ENV{EMXSHELL} = 'sh'; # For OS/2
2868N/A
2868N/Aif ($#ARGV == -1) {
2868N/A @ARGV = split(/[ \n]/,
2868N/A `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t pragma/*.t lib/*.t`);
5175N/A}
5422N/A
2868N/Aif ($^O eq 'os2' || $^O eq 'qnx') {
2868N/A $sharpbang = 0;
2868N/A}
1008N/Aelse {
2874N/A open(CONFIG, "../config.sh");
2874N/A while (<CONFIG>) {
1008N/A if (/sharpbang='(.*)'/) {
3187N/A $sharpbang = ($1 eq '#!');
1008N/A last;
2868N/A }
2868N/A }
2868N/A close(CONFIG);
1008N/A}
3214N/A
1008N/A%infinite = ( 'comp/require.t', 1, 'op/bop.t', 1, 'lib/hostname.t', 1 );
1008N/A
1008N/A_testprogs('perl', @ARGV);
1008N/A_testprogs('compile', @ARGV) if (-e "../testcompile");
1008N/A
1008N/Asub _testprogs {
2874N/A $type = shift @_;
2874N/A @tests = @_;
2874N/A
1008N/A
1008N/A print <<'EOT' if ($type eq 'compile');
3201N/A--------------------------------------------------------------------------------
3201N/ATESTING COMPILER
1008N/A--------------------------------------------------------------------------------
1008N/AEOT
1008N/A
1008N/A $ENV{PERLCC_TIMEOUT} = 120
1008N/A if ($type eq 'compile' && !$ENV{PERLCC_TIMEOUT});
1008N/A
2624N/A $bad = 0;
1008N/A $good = 0;
1008N/A $total = @tests;
1008N/A $files = 0;
2624N/A $totmax = 0;
1008N/A while ($test = shift @tests) {
3201N/A
3201N/A if ( $infinite{$test} && $type eq 'compile' ) {
1008N/A print STDERR "$test creates infinite loop! Skipping.\n";
1008N/A next;
1008N/A }
1008N/A if ($test =~ /^$/) {
1008N/A next;
1008N/A }
1008N/A $te = $test;
1008N/A chop($te);
1008N/A print "$te" . '.' x (18 - length($te));
1008N/A if (0) {
2624N/A -x $test || (print "isn't executable.\n");
1008N/A
1008N/A if ($type eq 'perl') {
1008N/A open(RESULTS, "./$test |") || (print "can't run.\n"); }
2868N/A else {
2868N/A open(RESULTS, "./perl -I../lib ../utils/perlcc -o ./$test.plc ./$test "
1008N/A ." && ./$test.plc |")
3201N/A or print "can't compile.\n";
1008N/A unlink "./$test.plc";
2508N/A }
2508N/A }
2508N/A else {
1008N/A open(SCRIPT,"$test") or die "Can't run $test.\n";
1008N/A $_ = <SCRIPT>;
1008N/A close(SCRIPT);
1008N/A if (/#!..perl(.*)/) {
5422N/A $switch = $1;
1008N/A if ($^O eq 'VMS') {
1008N/A # Must protect uppercase switches with "" on command line
1008N/A $switch =~ s/-([A-Z]\S*)/"-$1"/g;
1008N/A }
5422N/A }
1008N/A else {
1008N/A $switch = '';
1008N/A }
1008N/A
2868N/A if ($type eq 'perl') {
2868N/A open(RESULTS,"./perl$switch -I../lib -Mutf8 $test |") || (print "can't run.\n");
1008N/A }
1008N/A else {
1008N/A open(RESULTS, "./perl -I../lib ../utils/perlcc -Mutf8 ./$test -run -verbose dcf -log ../compilelog |") or print "can't compile.\n";
1008N/A }
2868N/A }
2868N/A $ok = 0;
1008N/A $next = 0;
1008N/A while (<RESULTS>) {
1008N/A if ($verbose) {
1008N/A print $_;
1008N/A }
1008N/A unless (/^#/) {
1008N/A if (/^1\.\.([0-9]+)/) {
4730N/A $max = $1;
4730N/A $totmax += $max;
4730N/A $files += 1;
4730N/A $next = 1;
4730N/A $ok = 1;
4748N/A }
4748N/A else {
4748N/A $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
4748N/A if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
4748N/A $next = $next + 1;
1008N/A }
1008N/A else {
2868N/A $ok = 0;
2868N/A }
1008N/A }
1008N/A }
1008N/A }
1008N/A close RESULTS;
1008N/A $next = $next - 1;
1008N/A if ($ok && $next == $max) {
1008N/A if ($max) {
1008N/A print "ok\n";
1008N/A $good = $good + 1;
1008N/A }
1008N/A else {
1008N/A print "skipping test on this platform\n";
1008N/A $files -= 1;
1008N/A }
1008N/A }
1008N/A else {
1008N/A $next += 1;
1008N/A print "FAILED at test $next\n";
1008N/A $bad = $bad + 1;
1008N/A $_ = $test;
1008N/A if (/^base/) {
1008N/A die "Failed a basic test--cannot continue.\n";
1008N/A }
1008N/A }
1008N/A }
1008N/A
1008N/A if ($bad == 0) {
1008N/A if ($ok) {
1008N/A print "All tests successful.\n";
1008N/A # XXX add mention of 'perlbug -ok' ?
1008N/A }
1008N/A else {
1008N/A die "FAILED--no tests were run for some reason.\n";
1008N/A }
1008N/A }
1008N/A else {
1008N/A $pct = sprintf("%.2f", $good / $total * 100);
1008N/A if ($bad == 1) {
1008N/A warn "Failed 1 test script out of $total, $pct% okay.\n";
1008N/A }
1008N/A else {
1008N/A warn "Failed $bad test scripts out of $total, $pct% okay.\n";
1008N/A }
1008N/A warn <<'SHRDLU';
1008N/A ### Since not all tests were successful, you may want to run some
1008N/A ### of them individually and examine any diagnostic messages they
1008N/A ### produce. See the INSTALL document's section on "make test".
1008N/A ### If you are testing the compiler, then ignore this message
1008N/A ### and run
1008N/A ### ./perl harness
1008N/A ### in the directory ./t.
1008N/ASHRDLU
1008N/A warn <<'SHRDLU' if $good / $total > 0.8;
1008N/A ###
1008N/A ### Since most tests were successful, you have a good chance to
1008N/A ### get information with better granularity by running
1008N/A ### ./perl harness
1008N/A ### in directory ./t.
1008N/ASHRDLU
1008N/A }
1008N/A ($user,$sys,$cuser,$csys) = times;
1008N/A print sprintf("u=%g s=%g cu=%g cs=%g scripts=%d tests=%d\n",
1008N/A $user,$sys,$cuser,$csys,$files,$totmax);
1008N/A}
1008N/Aexit ($bad != 0);
1008N/A