emacs/mps/qa/test/script/logging

#!/usr/local/perl
# $HopeName$
#
# provides subroutines to help in creating test logs and
# reports
#

1;

@LOG_FILES = (STDOUT);

#
# &describe_test(report_type)
#
# prints out report on a test. report_type is one of:
#   full:    everything
#   summary: single line, pass/fail
#   results: test, spec output, results, conclusion
#

sub describe_test {
 local ($report, $LOGFILE, $oldhandle) = @_;

 if ($LOGFILE) {
  $oldhandle = select($LOGFILE);
 }
 if ($report eq "summary") {
  $~ = "LOGSUMM";
  write;
 } else {
  $~ = "LOGHEAD";
  write;
  %keyvalues = %test_header;
  %keyrelations = ();
  &dispvals;
  %keyvalues = %spec_output;
  %keyrelations = %spec_rel;
  print $log_test_spec;
  &dispvals;
  %keyvalues = %real_output;
  %keyrelations = ();
   print $log_test_res;
  &dispvals;
  print $log_test_conc;
  $~ = "LOGCONC";
  write;
  if ($report eq "full") {
   &displog;
  }
 }
 if ($LOGFILE) {
  select($oldhandle);
 }
}

sub dispvals {
 local ($key, $rel, $val);

 $~ = "LOGVALS";

 foreach $key (sort keys %keyvalues) {
  $val = $keyvalues{$key};
  $rel = ($keyrelations{$key} || "=");
  write;
 }
}

sub displog {
 open(TESTLOG, $testlogfile);
 print $log_test_tran;
 while ($line = <TESTLOG>) {
  print $line;
 }
 print $log_test_end;
}

sub logcomment {
 local ($text, $FILE) = @_;

 foreach $FILE (@LOG_FILES) {
  print $FILE "$text\n";
 }
}

sub logtimeline {
 local ($secs, $slen, $slenl, $text, $barn, $barl, $barr) = @_;

$barn = "***********************************************************>";

$barr = "         |10s      |30s      |1min     |2min     |5min     |10min                    ";
$barl = "*********|10s******|30s******|1min*****|2min*****|5min*****|10min                    ";

 if ($secs < 10) {
  $slen = $secs
 } elsif ($secs < 30) {
  $slen = ($secs + 10) / 2
 } elsif ($secs < 60) {
  $slen = ($secs + 30) / 3
 } elsif ($secs < 120) {
  $slen = ($secs + 120) / 6
 } elsif ($secs < 300) {
  $slen = ($secs + 600) / 18
 } elsif ($secs < 600) {
  $slen = ($secs + 1200) / 30
 } else {
  $slen = 60;
 }

 if (substr($barl, $slen-1, 1) eq "*") {
  $slenl = $slen;
 } elsif (substr($barl, $slen-1, 1) eq "|") {
  $slenl = $slen - 1;
 } else {
  $slenl = $slen - ($slen % 10);
 }

 $secs = 9-($slen % 10);

 &debug("time line: $slenl, $slen, $secs");

 $text = substr($barl, 0, $slenl);
 $text = substr($barn, $slenl-1, $slen-$slenl);
 $text = substr($barr, $slen+$secs, 80-$slen-$secs); 

 $text = substr($barl, 0, $slenl) . substr($barn, $slenl, $slen-$slenl) . (" " x $secs) . substr($barr, $slen+$secs, 80-$slen-$secs);
 $text =~ s/[^>\*]*$//;
 return $text;
}

#
# what the output looks like:
#

$log_test_spec = "SPECIFIED RESULTS\n";
$log_test_res  = "RESULTS\n";
$log_test_conc = "CONCLUSION\n";
$log_test_tran = "TRANSCRIPT\n";
$log_test_end  = "END OF TRANSCRIPT\n\n";

format LOGHEAD =
------------------------------------------------------------------------
@<<<ED TEST @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$testconclusion, $testfile
@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$testtimeline
.

format LOGVALS =
  @<<<<<<<<< @< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$key, $rel, $val
.

format LOGCONC =
  @<<<<<<<<<    @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$testconclusion, $testconcreason

.

format LOGSUMM = 
@<<< @<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$testconclusion, $testfile, $testtimeline
.

format TESTTAB =
@<<<<<<<<<<<<<<<
$key
.