#!/usr/bin/perl -w
# $Id: //info.ravenbrook.com/project/mps/master/test/test/script/runtest#10 $
#
# 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/ || /Ravenbrook MPS/) {
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";
}
if ($testconclusion eq "FAIL") {
$exitstatus = 1;
}
}
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");
}
if ($testconclusion eq "FAIL") {
$exitstatus = 1;
}
}
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*$)/) {
chomp;
&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));
}
sub debugtest {
local ($testfile,) = @_;
&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 debugging tests.\n";
}
}
$linkfiles = $test_header{"link"};
$objfile = "$obj_dir/tmp_test";
if (&compile_and_link($testfile, $objfile, $linkfiles)) {
mysystem("$debug_command $objfile")
} else {
die "compilation failed:\n$compoutput";
}
} else {
die "Don't know how to debug tests in the $lang language.\n";
}
}
}