Commit 16b7182d91c8e5071656b7a8b9f73d13e41099ea

Authored by Jay Berkenbilt
1 parent dbeef33e

Upgrade qtest to 1.5

qtest/bin/qtest-driver
... ... @@ -2,7 +2,7 @@
2 2 #
3 3 # This file is part of qtest.
4 4 #
5   -# Copyright 1993-2007, Jay Berkenbilt
  5 +# Copyright 1993-2018, Jay Berkenbilt
6 6 #
7 7 # QTest is distributed under the terms of version 2.0 of the Artistic
8 8 # license which may be found in the source distribution.
... ... @@ -33,7 +33,7 @@ require TestDriver;
33 33  
34 34 if ((@ARGV == 1) && ($ARGV[0] eq '--version'))
35 35 {
36   - print "$whoami version 1.4\n";
  36 + print "$whoami version 1.5\n";
37 37 exit 0;
38 38 }
39 39 if ((@ARGV == 1) && ($ARGV[0] eq '--print-path'))
... ... @@ -46,6 +46,7 @@ my @bindirs = ();
46 46 my $datadir = undef;
47 47 my $covdir = '.';
48 48 my $stdout_tty = (-t STDOUT) ? "1" : "0";
  49 +my $junit_suffix = "";
49 50  
50 51 while (@ARGV)
51 52 {
... ... @@ -69,6 +70,11 @@ while (@ARGV)
69 70 {
70 71 $stdout_tty = $1;
71 72 }
  73 + elsif ($arg eq '-junit-suffix')
  74 + {
  75 + usage() unless @ARGV;
  76 + $junit_suffix = "-" . shift(@ARGV);
  77 + }
72 78 else
73 79 {
74 80 usage();
... ... @@ -159,8 +165,10 @@ elsif (@testcov)
159 165  
160 166 my $testlogfile = 'qtest.log';
161 167 my $testxmlfile = 'qtest-results.xml';
  168 +my $testjunitfile = "TEST-qtest$junit_suffix.xml";
162 169 unlink $testlogfile;
163 170 unlink $testxmlfile;
  171 +unlink $testjunitfile;
164 172  
165 173 my $totmissing = 0;
166 174 my $totextra = 0;
... ... @@ -208,10 +216,13 @@ if (defined $tc_log)
208 216 print_xml(" coverage-scope=\"$tc_scope\"");
209 217 }
210 218 print_xml(">\n");
  219 +print_junit("<?xml version=\"1.0\"?>\n" .
  220 + "<testsuites>\n");
211 221 foreach my $test (@tests)
212 222 {
213 223 print_and_log("\nRunning $test\n");
214 224 print_xml(" <testsuite file=\"$test\">\n");
  225 + print_junit(" <testsuite name=\"$test\">\n");
215 226 my @results = run_test($test);
216 227 if (scalar(@results) != 5)
217 228 {
... ... @@ -263,6 +274,7 @@ foreach my $test (@tests)
263 274 print_xml(" />\n");
264 275 }
265 276 print_xml(" </testsuite>\n");
  277 + print_junit(" </testsuite>\n");
266 278 }
267 279  
268 280 my $coverage_okay = 1;
... ... @@ -317,6 +329,7 @@ if (defined $tc_log)
317 329 }
318 330 print_xml(" />\n" .
319 331 "</qtest-results>\n");
  332 +print_junit("</testsuites>\n");
320 333  
321 334 exit ($okay ? 0 : 2);
322 335  
... ... @@ -408,6 +421,7 @@ sub run_test
408 421 '-tempdir', $tempdir,
409 422 '-testlog', "$cwd/$testlogfile",
410 423 '-testxml', "$cwd/$testxmlfile",
  424 + '-testjunit', "$cwd/$testjunitfile",
411 425 "-stdout-tty=$stdout_tty") or
412 426 fatal("exec $prog failed: $!");
413 427 }
... ... @@ -668,15 +682,22 @@ sub tc_do_final_checks
668 682 if (@problems)
669 683 {
670 684 my $testxml = open_xml();
  685 + my $testjunit = open_junit();
671 686 $testxml->print(" <coverage-errors count=\"" .
672 687 scalar(@problems) . "\">\n");
  688 + $testjunit->print(" <testsuite name=\"coverage\">\n");
673 689 foreach my $p (@problems)
674 690 {
675 691 $testlog->print("$p\n");
676 692 $testxml->print(" <coverage-error case=\"$p\"/>\n");
  693 + $testjunit->print(" <testcase name=\"$p\">\n" .
  694 + " <failure message=\"$p\"/>\n" .
  695 + " </testcase>\n");
677 696 }
678 697 $testxml->print(" </coverage-errors>\n");
679 698 $testxml->close();
  699 + $testjunit->print(" </testsuite>\n");
  700 + $testjunit->close();
680 701 $testlog->print("coverage errors: " . scalar(@problems) . "\n");
681 702 }
682 703 my $passed = (@problems == 0);
... ... @@ -718,6 +739,11 @@ sub open_xml
718 739 open_binary($testxmlfile);
719 740 }
720 741  
  742 +sub open_junit
  743 +{
  744 + open_binary($testjunitfile);
  745 +}
  746 +
721 747 sub print_and_log
722 748 {
723 749 my $fh = open_log();
... ... @@ -733,6 +759,13 @@ sub print_xml
733 759 $fh->close();
734 760 }
735 761  
  762 +sub print_junit
  763 +{
  764 + my $fh = open_junit();
  765 + print $fh @_;
  766 + $fh->close();
  767 +}
  768 +
736 769 sub print_and_pad
737 770 {
738 771 TestDriver::print_and_pad(@_);
... ... @@ -784,6 +817,7 @@ Options include:
784 817 -bindirs bindir[:bindir...]
785 818 [ -covdir [coverage-dir] ]
786 819 [ -stdout-tty=[01] ]
  820 + [ -junit-suffix suffix ]
787 821  
788 822 Subsidiary test programs are run with the -bindirs argument (a
789 823 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
809 843 useful for cases in which another program is invoking ${whoami} and
810 844 passing its output through a pipe to a terminal.
811 845  
  846 +Qtest writes its results to qtest.log, qtest-results.xml, and
  847 +TEST-qtest.xml. The TEST-qtest.xml file is compatible with JUnit's
  848 +test ouput, which makes it useful for many continuous integration
  849 +systems. The test output information in that file is not quite as rich
  850 +as in qtest-results.xml, but it is good enough for most purposes. If
  851 +you want your JUnit-compatible results file to have a different name,
  852 +pass -junit-suffix yoursuffix. This will change the name to
  853 +TEST-qtest-yoursuffix.xml.
  854 +
812 855 ";
813 856 exit 2;
814 857  
... ...
qtest/module/TestDriver.pm
... ... @@ -2,7 +2,7 @@
2 2 #
3 3 # This file is part of qtest.
4 4 #
5   -# Copyright 1993-2007, Jay Berkenbilt
  5 +# Copyright 1993-2018, Jay Berkenbilt
6 6 #
7 7 # QTest is distributed under the terms of version 2.0 of the Artistic
8 8 # license which may be found in the source distribution.
... ... @@ -71,12 +71,14 @@ use constant EXPECT_FAILURE =&gt; 1 &lt;&lt; 2;
71 71 use constant RM_WS_ONLY_LINES => 1 << 3;
72 72  
73 73 # Field names
74   -use vars qw($f_socket $f_origdir $f_tempdir $f_testlog $f_testxml $f_suitename);
  74 +use vars (qw($f_socket $f_origdir $f_tempdir $f_testlog),
  75 + qw($f_testxml $f_testjunit $f_suitename));
75 76 $f_socket = 'socket';
76 77 $f_origdir = 'origdir';
77 78 $f_tempdir = 'tempdir';
78 79 $f_testlog = 'testlog';
79 80 $f_testxml = 'testxml';
  81 +$f_testjunit = 'testjunit';
80 82 $f_suitename = 'suitename';
81 83  
82 84 use vars qw($f_passes $f_fails $f_xpasses $f_xfails $f_testnum);
... ... @@ -233,13 +235,14 @@ sub new
233 235 }
234 236 my $suitename = shift;
235 237  
236   - if (! ((@ARGV == 11) &&
  238 + if (! ((@ARGV == 13) &&
237 239 (($ARGV[0] eq '-fd') || ($ARGV[0] eq '-port')) &&
238 240 ($ARGV[2] eq '-origdir') &&
239 241 ($ARGV[4] eq '-tempdir') &&
240 242 ($ARGV[6] eq '-testlog') &&
241 243 ($ARGV[8] eq '-testxml') &&
242   - ($ARGV[10] =~ m/^-stdout-tty=([01])$/) &&
  244 + ($ARGV[10] eq '-testjunit') &&
  245 + ($ARGV[12] =~ m/^-stdout-tty=([01])$/) &&
243 246 (-d $ARGV[5])))
244 247 {
245 248 die +__PACKAGE__, ": improper invocation of test driver $0 (" .
... ... @@ -251,11 +254,14 @@ sub new
251 254 my $tempdir = $ARGV[5];
252 255 my $testlogfile = $ARGV[7];
253 256 my $testxmlfile = $ARGV[9];
  257 + my $testjunitfile = $ARGV[11];
254 258 my $testlog = new IO::File(">>$testlogfile");
255 259 binmode $testlog;
256 260 my $testxml = new IO::File(">>$testxmlfile");
257 261 binmode $testxml;
258   - $ARGV[10] =~ m/=([01])/ or die +__PACKAGE__, ": INTERNAL ERROR in ARGV[10]";
  262 + my $testjunit = new IO::File(">>$testjunitfile");
  263 + binmode $testjunit;
  264 + $ARGV[12] =~ m/=([01])/ or die +__PACKAGE__, ": INTERNAL ERROR in ARGV[10]";
259 265 my $stdout_is_tty = $1;
260 266 if ($stdout_is_tty)
261 267 {
... ... @@ -300,6 +306,7 @@ sub new
300 306 $rep->{+__PACKAGE__}{$f_tempdir} = $tempdir;
301 307 $rep->{+__PACKAGE__}{$f_testlog} = $testlog;
302 308 $rep->{+__PACKAGE__}{$f_testxml} = $testxml;
  309 + $rep->{+__PACKAGE__}{$f_testjunit} = $testjunit;
303 310 $rep->{+__PACKAGE__}{$f_suitename} = $suitename;
304 311 $rep->{+__PACKAGE__}{$f_passes} = 0;
305 312 $rep->{+__PACKAGE__}{$f_fails} = 0;
... ... @@ -342,6 +349,12 @@ sub _testxml
342 349 $rep->{+__PACKAGE__}{$f_testxml};
343 350 }
344 351  
  352 +sub _testjunit
  353 +{
  354 + my $rep = shift;
  355 + $rep->{+__PACKAGE__}{$f_testjunit};
  356 +}
  357 +
345 358 sub _suitename
346 359 {
347 360 my $rep = shift;
... ... @@ -1003,6 +1016,7 @@ sub runtest
1003 1016 my $passed = $rep->update_counters($outcome, $exp_outcome);
1004 1017  
1005 1018 my $testxml = $rep->_testxml();
  1019 + my $testjunit = $rep->_testjunit();
1006 1020 my $testlog = $rep->_testlog();
1007 1021 # $outcome_text is for the human-readable. We need something
1008 1022 # different for the xml file.
... ... @@ -1014,16 +1028,22 @@ sub runtest
1014 1028 ? ($passed ? "pass" : "unexpected-pass")
1015 1029 : ($passed ? "expected-fail" : "fail")) .
1016 1030 "\"\n");
  1031 + $testjunit->print(" <testcase\n" .
  1032 + " id=\"" . xmlify($category, 1) . " $testnum\"\n" .
  1033 + " name=\"" . xmlify($description, 1) . "\"\n");
1017 1034  
1018 1035 if (($outcome eq FAIL) && ($outcome ne $exp_outcome))
1019 1036 {
1020 1037 # Test failed and failure was not expected
1021 1038  
1022 1039 $testxml->print(" >\n");
  1040 + $testjunit->print(" >\n" .
  1041 + " <failure>\n");
1023 1042 $testlog->printf("$category test %d (%s) FAILED\n",
1024 1043 $testnum, $description);
1025 1044 my $cwd = getcwd();
1026 1045 $testlog->print("cwd: $cwd\n");
  1046 + $testjunit->print("cwd: " . xmlify($cwd) . "\n");
1027 1047 $testxml->print(" <cwd>" . xmlify($cwd) . "</cwd>\n");
1028 1048 my $cmd = $in_command;
1029 1049 if ((defined $cmd) && (ref($cmd) eq 'ARRAY'))
... ... @@ -1034,6 +1054,7 @@ sub runtest
1034 1054 {
1035 1055 $testlog->print("command: $cmd\n");
1036 1056 $testxml->print(" <command>" . xmlify($cmd) . "</command>\n");
  1057 + $testjunit->print("command: " . xmlify($cmd) . "\n");
1037 1058 }
1038 1059 if (defined $out_file)
1039 1060 {
... ... @@ -1044,6 +1065,8 @@ sub runtest
1044 1065 $testxml->print(
1045 1066 " <expected-output-file>" . xmlify($out_file) .
1046 1067 "</expected-output-file>\n");
  1068 + $testjunit->print("expected output in " .
  1069 + xmlify($out_file) . "\n");
1047 1070 }
1048 1071  
1049 1072 # It would be nice if we could filter out internal calls for
... ... @@ -1054,6 +1077,7 @@ sub runtest
1054 1077 $testxml->print(" <stacktrace>test failure" .
1055 1078 xmlify(Carp::longmess()) .
1056 1079 "</stacktrace>\n");
  1080 + $testjunit->print("stracktrace:\n" . xmlify(Carp::longmess()));
1057 1081  
1058 1082 if (! $status_match)
1059 1083 {
... ... @@ -1064,16 +1088,20 @@ sub runtest
1064 1088 " <expected-status>$out_exit_status</expected-status>\n");
1065 1089 $testxml->print(
1066 1090 " <actual-status>$exit_status</actual-status>\n");
  1091 + $testjunit->printf(" Expected status: %s\n", $out_exit_status);
  1092 + $testjunit->printf(" Actual status: %s\n", $exit_status);
1067 1093 }
1068 1094 if (! $output_match)
1069 1095 {
1070 1096 &QTC::TC("testdriver", "TestDriver output mismatch");
1071 1097 $testlog->print("--> BEGIN EXPECTED OUTPUT <--\n");
1072 1098 $testxml->print(" <expected-output>");
  1099 + $testjunit->print("-- BEGIN EXPECTED OUTPUT --\n");
1073 1100 if (defined $expected_file)
1074 1101 {
1075 1102 write_file_to_fh($expected_file, $testlog);
1076 1103 xml_write_file_to_fh($expected_file, $testxml);
  1104 + xml_write_file_to_fh($expected_file, $testjunit);
1077 1105 }
1078 1106 elsif (defined $out_regexp)
1079 1107 {
... ... @@ -1083,6 +1111,7 @@ sub runtest
1083 1111 $testlog->print("\n");
1084 1112 }
1085 1113 $testxml->print("regexp: " . xmlify($out_regexp));
  1114 + $testjunit->print("regexp: " . xmlify($out_regexp));
1086 1115 }
1087 1116 else
1088 1117 {
... ... @@ -1093,19 +1122,26 @@ sub runtest
1093 1122 "--> BEGIN ACTUAL OUTPUT <--\n");
1094 1123 $testxml->print("</expected-output>\n" .
1095 1124 " <actual-output>");
  1125 + $testjunit->print("-- END EXPECTED OUTPUT --\n" .
  1126 + "-- ACTUAL OUTPUT --\n");
1096 1127 write_file_to_fh($actual_file, $testlog);
1097 1128 xml_write_file_to_fh($actual_file, $testxml);
  1129 + xml_write_file_to_fh($actual_file, $testjunit);
1098 1130 $testlog->print("--> END ACTUAL OUTPUT <--\n");
1099 1131 $testxml->print("</actual-output>\n");
  1132 + $testjunit->print("-- ACTUAL OUTPUT --\n");
1100 1133 if (defined $output_diff)
1101 1134 {
1102 1135 &QTC::TC("testdriver", "TestDriver display diff");
1103 1136 $testlog->print("--> DIFF EXPECTED ACTUAL <--\n");
1104 1137 $testxml->print(" <diff-output>");
  1138 + $testjunit->print("-- DIFF EXPECTED ACTUAL --\n");
1105 1139 write_file_to_fh($output_diff, $testlog);
1106 1140 xml_write_file_to_fh($output_diff, $testxml);
  1141 + xml_write_file_to_fh($output_diff, $testjunit);
1107 1142 $testlog->print("--> END DIFFERENCES <--\n");
1108 1143 $testxml->print("</diff-output>\n");
  1144 + $testjunit->print("-- END DIFFERENCES --\n");
1109 1145 }
1110 1146 else
1111 1147 {
... ... @@ -1113,10 +1149,13 @@ sub runtest
1113 1149 }
1114 1150 }
1115 1151 $testxml->print(" </testcase>\n");
  1152 + $testjunit->print(" </failure>\n" .
  1153 + " </testcase>\n");
1116 1154 }
1117 1155 else
1118 1156 {
1119 1157 $testxml->print(" />\n");
  1158 + $testjunit->print(" />\n");
1120 1159 }
1121 1160  
1122 1161 if (defined $threads)
... ... @@ -1245,7 +1284,8 @@ sub xmlify
1245 1284 $str =~ s/</&lt;/g;
1246 1285 $str =~ s/>/&gt;/g;
1247 1286 $str =~ s/\"/&quot;/g if $attr;
1248   - $str =~ s/([\000-\010\013-\037\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
  1287 + $str =~ s/([\000-\010\013-\037])/sprintf("[0x%02x]", ord($1))/ge;
  1288 + $str =~ s/([\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
1249 1289 $str;
1250 1290 }
1251 1291  
... ...