emacs/mps/qa/test/script/runtest

#!/usr/local/perl
# $HopeName: MMQA_harness!script:runtest(trunk.20) $
#
# 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);
 &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) = @_;

 &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";
    }
   }
   $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",
      "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) = @_;

 &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 {
  $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",
     "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");
}