emacs/mps/qa/test/script/runtest

#!/usr/local/perl
# $HopeName: MMQA_harness!script:runtest(trunk.22) $
#
# provides subroutines to run tests and testsets
#

1;

# general routines first

sub mpslibvers {
 local ($exefile) = @_;

 %mpslibvers = (
  "product", "unknown",
  "platform", "unknown",
  "variety", "unknown",
  "compilation", "unknown",
  "release", "unknown");

 $_ = &convdirseps("$stringscommand $exefile|");
 &debug("OPEN >>$_<<");

 if (open(STRINGS, $_)) {
  while (<STRINGS>) {
   if (/HQNMPS/) {
    if (/product\.(\w+)/) { $mpslibvers{"product"} = $1; }
    if (/variety\.(\w+)/) { $mpslibvers{"variety"} = $1; }
    if (/platform\.(\w+)/) { $mpslibvers{"platform"} = $1; }
# the \b in the next line is just to stop hope from expanding the RCS keyword
    if (/\$\bHopeName:\s+([^\$]+)\s*\$\s*([^,]+)/) {
     $mpslibvers{"hopeversion"} = $1;
     $mpslibvers{"release"}     = $2; 
    }
    if (/(release\.[A-Za-z0-9_.:-]*\w)/) { $mpslibvers{"release"} = $1; }
    if (/compiled on (.+)$/) { $mpslibvers{"compilation"} = $1; }
   }
  }
  close STRINGS;
 }
}

# file, "yes", "result" for try
# file, "no", "full" for run

sub run_exe {
 local ($exefile, $interact, $stdin) = @_;

 $identify{"time"} = localtime;
 &mpslibvers($exefile.$exesuff);
 &log_system($exefile, $interact, $testlogfile, $stdin);
 &read_results($testlogfile);
 if ($compoutput) {
  $real_output{'cl_out'} = $compoutput;
 }
 &verdict;
}

sub setstdin {
 local ($stdin);
 $stdin = $STDIN;
 if (!defined $stdin || $stdin eq "") {
  if ($test_header{"stdin"}) {
   $stdin = $DATA_DIR."/".$test_header{"stdin"};
  }
 }
 if (!defined $stdin || $stdin eq "") {
  $stdin = "STDIN";
 }
 return $stdin;
}

sub run_test {
 local ($testfile, $interact, $report_type, $logfile) = @_;
 my $missingSymbols;

 &readheader($testfile, 1);

 unless (vleq($test_header{"harness"}, $HARNESS_VERSION)) {
  die "This test requires version $test_header{\"harness\"} or later of the MMQA harness.
(You are using version $HARNESS_VERSION.)\n";
 }

 for $lang ($test_header{"language"}) {

  if ($lang =~ /^c$/) {
   unless ($DANGEROUS eq "on") {
    $_ = &test_clib();
    if ($_) {
     print "Warning: $_\n";
     die "-- recompile test libraries (\"qa clib\") before running tests.\n";
    }
   }
   $missingSymbols = &missingTestSymbols($testfile);

   if ($DANGEROUS ne "on" && @$missingSymbols) {
    my $i;

    %real_output =
     ("seconds", 0,
      "error", "true",
      "errtext", "missing symbols");

    for ($i = 0; $i < @$missingSymbols; $i++) {
     $real_output{"missing".($i+1)} = $$missingSymbols[$i];
    }

    $testtimeline = "*";
    $testconclusion = "FAIL";
    $testconcreason = "missing symbols";

   } else {

    $stdin = &setstdin;
    $linkfiles = $test_header{"link"};
    $objfile = "$obj_dir/tmp_test";
    if (&compile_and_link($testfile, $objfile, $linkfiles)) {
     $testlogfile = "$obj_dir/tmp_log.log";
     &run_exe($objfile, $interact, $stdin);
    } else {
     %real_output = 
      ("seconds", 0,
       "error", "true",
       "cl_out", $compoutput,
       "errtext", "compilation failed");
     $testtimeline = "*";
     $testconclusion = "FAIL";
     $testconcreason = "compilation failed";
    }
   }

   &describe_test($report_type);
   open(LOG_RESULTS, ">".$logfile);
   &describe_test("verbose", LOG_RESULTS);
   close(LOG_RESULTS);
   last;
  };

  if ($lang =~ /^english$/) {
   print "Manual test -- you'll have to do it yourself.\n\n";
   &display_test_source($testfile, STDOUT, 75);
   last;
  };

  die "Don't know how to run tests in the $lang language.\n";
 }
}

sub run_from_testset {
 local ($testfile) = @_;
 my $missingSymbols;

 &readheader($testfile, 1);
 if ($test_header{"language"} ne "c") {
  &logcomment("Skipping test $testfile: don't know how to run it in batch mode.");
  $testsetresults{$testfile}="/";
 } elsif (!vleq($test_header{"harness"}, $HARNESS_VERSION)) {
  &logcomment("Skipping test $testfile: needs newer harness.");
  $testsetresults{$testfile}="/";
 } else {
  $missingSymbols = &missingTestSymbols($testfile);

  if ($DANGEROUS ne "on" && @$missingSymbols) {
   my $i;

   %real_output =
    ("seconds", 0,
     "error", "true",
     "errtext", "missing symbols");

   for ($i = 0; $i < @$missingSymbols; $i++) {
    $real_output{"missing".($i+1)} = $$missingSymbols[$i];
   }

   $testtimeline = "*";
   $testconclusion = "FAIL";
   $testconcreason = "missing symbols";
   &describe_test("summary");
   &describe_test("summary", LOG_SUMMARY);
   &describe_test("results", LOG_RESULTS);
   &describe_test("results", LOG_FULL);
  } else {
   $stdin = &setstdin;
   $linkfiles = $test_header{"link"};
   $objfile = "$obj_dir/tmp_test";
   $testlogfile = "$obj_dir/tmp_log.log";

   if (&compile_and_link($testfile, $objfile, $linkfiles)) {
    &run_exe($objfile, "no", $stdin);
    &describe_test("summary");
    &describe_test("summary", LOG_SUMMARY);
    &describe_test("results", LOG_RESULTS);
    &describe_test("full", LOG_FULL);
   } else {
    %real_output = 
     ("seconds", 0,
      "error", "true",
      "cl_out", $compoutput,
      "errtext", "compilation failed");
    $testtimeline = "*";
    $testconclusion = "FAIL";
    $testconcreason = "compilation failed";
    &describe_test("summary");
    &describe_test("summary", LOG_SUMMARY);
    &describe_test("results", LOG_RESULTS);
    &describe_test("results", LOG_FULL);
   }
  }
  if ($testconclusion eq "PASS") {
   $testsetresults{$testfile}=".";
  } else {
   $testsetresults{$testfile}="*";
  }
  open(LOG_VERBOSE, ">$LOG_DIR/last.log");
  &describe_test("verbose", LOG_VERBOSE);
  close(LOG_VERBOSE);
  &mailfile("$LOG_DIR/last.log",
   "$MAIL_SUBJECT $testid $testconclusion");
 }
}

sub run_testset {
 local ($testsetfile, $logsummfile, $logresfile, $logfullfile) = @_;

 open(TESTSET, $testsetfile) ||
  die "Failed to open testset $testsetfile.";

 &ensuredir($LOG_DIR);

 %testsetresults = ();

 open(LOG_SUMMARY, ">".$logsummfile);
 open(LOG_RESULTS, ">".$logresfile);
 open(LOG_FULL,    ">".$logfullfile);
 &describe_settings(LOG_SUMMARY);
 @LOG_FILES = (STDOUT, LOG_SUMMARY, LOG_RESULTS, LOG_FULL);
 &logcomment("Test set $testsetfile");
 &logcomment("");

 unless (&clib) {
  &logcomment("Failed to compile libraries.");
 } else {
  while (<TESTSET>) {
   unless (/(^%)|(^\s*$)/) {
    chop;
    &run_from_testset($_);
   }
  }
 }

 close(LOG_SUMMARY);
 close(LOG_RESULTS);
 close(LOG_FULL);
 &mailfile($logsummfile, "$MAIL_SUBJECT summary of test set $testsetfile");
}
 

sub missingTestSymbols {
 my ($testfile) = @_;

 &readSymbols();
 return &missingSymbols(&listFileSymbols($testfile));
}