Upgrade qtest to 1.5

2 files changed, 91 insertions, 8 deletions

diff --git a/qtest/bin/qtest-driver b/qtest/bin/qtest-driver
index 5f3b0152..11ab7518 100755
--- a/qtest/bin/qtest-driver
+++ b/qtest/bin/qtest-driver
@@ -2,7 +2,7 @@
 #
 # This file is part of qtest.
 #
-# Copyright 1993-2007, Jay Berkenbilt
+# Copyright 1993-2018, Jay Berkenbilt
 #
 # QTest is distributed under the terms of version 2.0 of the Artistic
 # license which may be found in the source distribution.
@@ -33,7 +33,7 @@ require TestDriver;
 
 if ((@ARGV == 1) && ($ARGV[0] eq '--version'))
 {
-    print "$whoami version 1.4\n";
+    print "$whoami version 1.5\n";
     exit 0;
 }
 if ((@ARGV == 1) && ($ARGV[0] eq '--print-path'))
@@ -46,6 +46,7 @@ my @bindirs = ();
 my $datadir = undef;
 my $covdir = '.';
 my $stdout_tty = (-t STDOUT) ? "1" : "0";
+my $junit_suffix = "";
 
 while (@ARGV)
 {
@@ -69,6 +70,11 @@ while (@ARGV)
     {
 	$stdout_tty = $1;
     }
+    elsif ($arg eq '-junit-suffix')
+    {
+	usage() unless @ARGV;
+	$junit_suffix = "-" . shift(@ARGV);
+    }
     else
     {
 	usage();
@@ -159,8 +165,10 @@ elsif (@testcov)
 
 my $testlogfile = 'qtest.log';
 my $testxmlfile = 'qtest-results.xml';
+my $testjunitfile = "TEST-qtest$junit_suffix.xml";
 unlink $testlogfile;
 unlink $testxmlfile;
+unlink $testjunitfile;
 
 my $totmissing = 0;
 my $totextra = 0;
@@ -208,10 +216,13 @@ if (defined $tc_log)
     print_xml(" coverage-scope=\"$tc_scope\"");
 }
 print_xml(">\n");
+print_junit("<?xml version=\"1.0\"?>\n" .
+            "<testsuites>\n");
 foreach my $test (@tests)
 {
     print_and_log("\nRunning $test\n");
     print_xml(" <testsuite file=\"$test\">\n");
+    print_junit(" <testsuite name=\"$test\">\n");
     my @results = run_test($test);
     if (scalar(@results) != 5)
     {
@@ -263,6 +274,7 @@ foreach my $test (@tests)
 	print_xml("  />\n");
     }
     print_xml(" </testsuite>\n");
+    print_junit(" </testsuite>\n");
 }
 
 my $coverage_okay = 1;
@@ -317,6 +329,7 @@ if (defined $tc_log)
 }
 print_xml(" />\n" .
 	  "</qtest-results>\n");
+print_junit("</testsuites>\n");
 
 exit ($okay ? 0 : 2);
 
@@ -408,6 +421,7 @@ sub run_test
 	       '-tempdir', $tempdir,
 	       '-testlog', "$cwd/$testlogfile",
 	       '-testxml', "$cwd/$testxmlfile",
+	       '-testjunit', "$cwd/$testjunitfile",
 	       "-stdout-tty=$stdout_tty") or
 		   fatal("exec $prog failed: $!");
     }
@@ -668,15 +682,22 @@ sub tc_do_final_checks
     if (@problems)
     {
 	my $testxml = open_xml();
+        my $testjunit = open_junit();
 	$testxml->print(" <coverage-errors count=\"" .
 			scalar(@problems) . "\">\n");
+        $testjunit->print(" <testsuite name=\"coverage\">\n");
 	foreach my $p (@problems)
 	{
 	    $testlog->print("$p\n");
 	    $testxml->print("  <coverage-error case=\"$p\"/>\n");
+            $testjunit->print("  <testcase name=\"$p\">\n" .
+                              "   <failure message=\"$p\"/>\n" .
+                              "  </testcase>\n");
 	}
 	$testxml->print(" </coverage-errors>\n");
 	$testxml->close();
+        $testjunit->print(" </testsuite>\n");
+        $testjunit->close();
 	$testlog->print("coverage errors: " . scalar(@problems) . "\n");
     }
     my $passed = (@problems == 0);
@@ -718,6 +739,11 @@ sub open_xml
     open_binary($testxmlfile);
 }
 
+sub open_junit
+{
+    open_binary($testjunitfile);
+}
+
 sub print_and_log
 {
     my $fh = open_log();
@@ -733,6 +759,13 @@ sub print_xml
     $fh->close();
 }
 
+sub print_junit
+{
+    my $fh = open_junit();
+    print $fh @_;
+    $fh->close();
+}
+
 sub print_and_pad
 {
     TestDriver::print_and_pad(@_);
@@ -784,6 +817,7 @@ Options include:
   -bindirs bindir[:bindir...]
   [ -covdir [coverage-dir] ]
   [ -stdout-tty=[01] ]
+  [ -junit-suffix suffix ]
 
 Subsidiary test programs are run with the -bindirs argument (a
 colon-separated list of directories, which may be relative but will be
@@ -809,6 +843,15 @@ determination of whether standard output is a terminal.  This can be
 useful for cases in which another program is invoking ${whoami} and
 passing its output through a pipe to a terminal.
 
+Qtest writes its results to qtest.log, qtest-results.xml, and
+TEST-qtest.xml. The TEST-qtest.xml file is compatible with JUnit's
+test ouput, which makes it useful for many continuous integration
+systems. The test output information in that file is not quite as rich
+as in qtest-results.xml, but it is good enough for most purposes. If
+you want your JUnit-compatible results file to have a different name,
+pass -junit-suffix yoursuffix. This will change the name to
+TEST-qtest-yoursuffix.xml.
+
 ";
     exit 2;
 
diff --git a/qtest/module/TestDriver.pm b/qtest/module/TestDriver.pm
index ca083e56..cec08d35 100644
--- a/qtest/module/TestDriver.pm
+++ b/qtest/module/TestDriver.pm
@@ -2,7 +2,7 @@
 #
 # This file is part of qtest.
 #
-# Copyright 1993-2007, Jay Berkenbilt
+# Copyright 1993-2018, Jay Berkenbilt
 #
 # QTest is distributed under the terms of version 2.0 of the Artistic
 # license which may be found in the source distribution.
@@ -71,12 +71,14 @@ use constant EXPECT_FAILURE       => 1 << 2;
 use constant RM_WS_ONLY_LINES     => 1 << 3;
 
 # Field names
-use vars qw($f_socket $f_origdir $f_tempdir $f_testlog $f_testxml $f_suitename);
+use vars (qw($f_socket $f_origdir $f_tempdir $f_testlog),
+          qw($f_testxml $f_testjunit $f_suitename));
 $f_socket = 'socket';
 $f_origdir = 'origdir';
 $f_tempdir = 'tempdir';
 $f_testlog = 'testlog';
 $f_testxml = 'testxml';
+$f_testjunit = 'testjunit';
 $f_suitename = 'suitename';
 
 use vars qw($f_passes $f_fails $f_xpasses $f_xfails $f_testnum);
@@ -233,13 +235,14 @@ sub new
     }
     my $suitename = shift;
 
-    if (! ((@ARGV == 11) &&
+    if (! ((@ARGV == 13) &&
 	   (($ARGV[0] eq '-fd') || ($ARGV[0] eq '-port')) &&
 	   ($ARGV[2] eq '-origdir') &&
 	   ($ARGV[4] eq '-tempdir') &&
 	   ($ARGV[6] eq '-testlog') &&
 	   ($ARGV[8] eq '-testxml') &&
-	   ($ARGV[10] =~ m/^-stdout-tty=([01])$/) &&
+	   ($ARGV[10] eq '-testjunit') &&
+	   ($ARGV[12] =~ m/^-stdout-tty=([01])$/) &&
 	   (-d $ARGV[5])))
     {
 	die +__PACKAGE__, ": improper invocation of test driver $0 (" .
@@ -251,11 +254,14 @@ sub new
     my $tempdir = $ARGV[5];
     my $testlogfile = $ARGV[7];
     my $testxmlfile = $ARGV[9];
+    my $testjunitfile = $ARGV[11];
     my $testlog = new IO::File(">>$testlogfile");
     binmode $testlog;
     my $testxml = new IO::File(">>$testxmlfile");
     binmode $testxml;
-    $ARGV[10] =~ m/=([01])/ or die +__PACKAGE__, ": INTERNAL ERROR in ARGV[10]";
+    my $testjunit = new IO::File(">>$testjunitfile");
+    binmode $testjunit;
+    $ARGV[12] =~ m/=([01])/ or die +__PACKAGE__, ": INTERNAL ERROR in ARGV[10]";
     my $stdout_is_tty = $1;
     if ($stdout_is_tty)
     {
@@ -300,6 +306,7 @@ sub new
     $rep->{+__PACKAGE__}{$f_tempdir} = $tempdir;
     $rep->{+__PACKAGE__}{$f_testlog} = $testlog;
     $rep->{+__PACKAGE__}{$f_testxml} = $testxml;
+    $rep->{+__PACKAGE__}{$f_testjunit} = $testjunit;
     $rep->{+__PACKAGE__}{$f_suitename} = $suitename;
     $rep->{+__PACKAGE__}{$f_passes} = 0;
     $rep->{+__PACKAGE__}{$f_fails} = 0;
@@ -342,6 +349,12 @@ sub _testxml
     $rep->{+__PACKAGE__}{$f_testxml};
 }
 
+sub _testjunit
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_testjunit};
+}
+
 sub _suitename
 {
     my $rep = shift;
@@ -1003,6 +1016,7 @@ sub runtest
     my $passed = $rep->update_counters($outcome, $exp_outcome);
 
     my $testxml = $rep->_testxml();
+    my $testjunit = $rep->_testjunit();
     my $testlog = $rep->_testlog();
     # $outcome_text is for the human-readable.  We need something
     # different for the xml file.
@@ -1014,16 +1028,22 @@ sub runtest
 		     ? ($passed ? "pass" : "unexpected-pass")
 		     : ($passed ? "expected-fail" : "fail")) .
 		    "\"\n");
+    $testjunit->print("  <testcase\n" .
+		    "   id=\"" . xmlify($category, 1) . " $testnum\"\n" .
+		    "   name=\"" . xmlify($description, 1) . "\"\n");
 
     if (($outcome eq FAIL) && ($outcome ne $exp_outcome))
     {
 	# Test failed and failure was not expected
 
 	$testxml->print("  >\n");
+        $testjunit->print("  >\n" .
+                          "   <failure>\n");
 	$testlog->printf("$category test %d (%s) FAILED\n",
 			 $testnum, $description);
 	my $cwd = getcwd();
 	$testlog->print("cwd: $cwd\n");
+        $testjunit->print("cwd: " . xmlify($cwd) . "\n");
 	$testxml->print("   <cwd>" . xmlify($cwd) . "</cwd>\n");
 	my $cmd = $in_command;
 	if ((defined $cmd) && (ref($cmd) eq 'ARRAY'))
@@ -1034,6 +1054,7 @@ sub runtest
 	{
 	    $testlog->print("command: $cmd\n");
 	    $testxml->print("   <command>" . xmlify($cmd) . "</command>\n");
+	    $testjunit->print("command: " . xmlify($cmd) . "\n");
 	}
 	if (defined $out_file)
 	{
@@ -1044,6 +1065,8 @@ sub runtest
 	    $testxml->print(
 		"   <expected-output-file>" . xmlify($out_file) .
 		"</expected-output-file>\n");
+            $testjunit->print("expected output in " .
+                              xmlify($out_file) . "\n");
 	}
 
 	# It would be nice if we could filter out internal calls for
@@ -1054,6 +1077,7 @@ sub runtest
 	$testxml->print("   <stacktrace>test failure" .
 			xmlify(Carp::longmess()) .
 			"</stacktrace>\n");
+	$testjunit->print("stracktrace:\n" . xmlify(Carp::longmess()));
 
 	if (! $status_match)
 	{
@@ -1064,16 +1088,20 @@ sub runtest
 		"   <expected-status>$out_exit_status</expected-status>\n");
 	    $testxml->print(
 		"   <actual-status>$exit_status</actual-status>\n");
+	    $testjunit->printf("  Expected status: %s\n", $out_exit_status);
+	    $testjunit->printf("  Actual   status: %s\n", $exit_status);
 	}
 	if (! $output_match)
 	{
 	    &QTC::TC("testdriver", "TestDriver output mismatch");
 	    $testlog->print("--> BEGIN EXPECTED OUTPUT <--\n");
 	    $testxml->print("   <expected-output>");
+            $testjunit->print("-- BEGIN EXPECTED OUTPUT --\n");
 	    if (defined $expected_file)
 	    {
 		write_file_to_fh($expected_file, $testlog);
 		xml_write_file_to_fh($expected_file, $testxml);
+		xml_write_file_to_fh($expected_file, $testjunit);
 	    }
 	    elsif (defined $out_regexp)
 	    {
@@ -1083,6 +1111,7 @@ sub runtest
 		    $testlog->print("\n");
 		}
 		$testxml->print("regexp: " . xmlify($out_regexp));
+		$testjunit->print("regexp: " . xmlify($out_regexp));
 	    }
 	    else
 	    {
@@ -1093,19 +1122,26 @@ sub runtest
 			    "--> BEGIN ACTUAL OUTPUT <--\n");
 	    $testxml->print("</expected-output>\n" .
 			    "   <actual-output>");
+	    $testjunit->print("-- END EXPECTED OUTPUT --\n" .
+                              "-- ACTUAL OUTPUT --\n");
 	    write_file_to_fh($actual_file, $testlog);
 	    xml_write_file_to_fh($actual_file, $testxml);
+	    xml_write_file_to_fh($actual_file, $testjunit);
 	    $testlog->print("--> END ACTUAL OUTPUT <--\n");
 	    $testxml->print("</actual-output>\n");
+	    $testjunit->print("-- ACTUAL OUTPUT --\n");
 	    if (defined $output_diff)
 	    {
 		&QTC::TC("testdriver", "TestDriver display diff");
 		$testlog->print("--> DIFF EXPECTED ACTUAL <--\n");
 		$testxml->print("   <diff-output>");
+		$testjunit->print("-- DIFF EXPECTED ACTUAL --\n");
 		write_file_to_fh($output_diff, $testlog);
 		xml_write_file_to_fh($output_diff, $testxml);
+		xml_write_file_to_fh($output_diff, $testjunit);
 		$testlog->print("--> END DIFFERENCES <--\n");
 		$testxml->print("</diff-output>\n");
+		$testjunit->print("-- END DIFFERENCES --\n");
 	    }
 	    else
 	    {
@@ -1113,10 +1149,13 @@ sub runtest
 	    }
 	}
 	$testxml->print("  </testcase>\n");
+	$testjunit->print("   </failure>\n" .
+                          "  </testcase>\n");
     }
     else
     {
 	$testxml->print("  />\n");
+	$testjunit->print("  />\n");
     }
 
     if (defined $threads)
@@ -1245,7 +1284,8 @@ sub xmlify
     $str =~ s/</&lt;/g;
     $str =~ s/>/&gt;/g;
     $str =~ s/\"/&quot;/g if $attr;
-    $str =~ s/([\000-\010\013-\037\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
+    $str =~ s/([\000-\010\013-\037])/sprintf("[0x%02x]", ord($1))/ge;
+    $str =~ s/([\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
     $str;
 }