1 # Perl module for parsing and generating the Subunit protocol
2 # Copyright (C) 2008-2009 Jelmer Vernooij <jelmer@samba.org>
4 # Licensed under either the Apache License, Version 2.0 or the BSD 3-clause
5 # license at the users choice. A copy of both licenses are available in the
6 # project source as Apache-2.0 and BSD. You may not use this file except in
7 # compliance with one of these two licences.
9 # Unless required by applicable law or agreed to in writing, software
10 # distributed under these licenses is distributed on an "AS IS" BASIS, WITHOUT
11 # WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
12 # license you chose for the specific language governing permissions and
13 # limitations under that license.
20 @EXPORT_OK = qw(parse_results $VERSION);
22 use vars qw ( $VERSION );
28 sub parse_results($$$)
30 my ($msg_ops, $statistics, $fh) = @_;
31 my $expected_fail = 0;
32 my $unexpected_fail = 0;
33 my $unexpected_err = 0;
37 if (/^test: (.+)\n/) {
38 $msg_ops->control_msg($_);
39 $msg_ops->start_test($1);
40 push (@$open_tests, $1);
41 } elsif (/^time: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)Z\n/) {
42 $msg_ops->report_time(mktime($6, $5, $4, $3, $2, $1-1900));
43 } elsif (/^(success|successful|failure|fail|skip|knownfail|error|xfail): (.*?)( \[)?([ \t]*)\n/) {
44 $msg_ops->control_msg($_);
50 # reason may be specified in next lines
53 $msg_ops->control_msg($_);
54 if ($_ eq "]\n") { $terminated = 1; last; } else { $reason .= $_; }
57 unless ($terminated) {
58 $statistics->{TESTS_ERROR}++;
59 $msg_ops->end_test($testname, "error", 1, "reason ($result) interrupted");
63 if ($result eq "success" or $result eq "successful") {
64 pop(@$open_tests); #FIXME: Check that popped value == $testname
65 $statistics->{TESTS_EXPECTED_OK}++;
66 $msg_ops->end_test($testname, $result, 0, $reason);
67 } elsif ($result eq "xfail" or $result eq "knownfail") {
68 pop(@$open_tests); #FIXME: Check that popped value == $testname
69 $statistics->{TESTS_EXPECTED_FAIL}++;
70 $msg_ops->end_test($testname, $result, 0, $reason);
72 } elsif ($result eq "failure" or $result eq "fail") {
73 pop(@$open_tests); #FIXME: Check that popped value == $testname
74 $statistics->{TESTS_UNEXPECTED_FAIL}++;
75 $msg_ops->end_test($testname, $result, 1, $reason);
77 } elsif ($result eq "skip") {
78 $statistics->{TESTS_SKIP}++;
79 my $last = pop(@$open_tests);
80 if (defined($last) and $last ne $testname) {
81 push (@$open_tests, $testname);
83 $msg_ops->end_test($testname, $result, 0, $reason);
84 } elsif ($result eq "error") {
85 $statistics->{TESTS_ERROR}++;
86 pop(@$open_tests); #FIXME: Check that popped value == $testname
87 $msg_ops->end_test($testname, $result, 1, $reason);
91 $msg_ops->output_msg($_);
95 while ($#$open_tests+1 > 0) {
96 $msg_ops->end_test(pop(@$open_tests), "error", 1,
97 "was started but never finished!");
98 $statistics->{TESTS_ERROR}++;
102 return 1 if $unexpected_err > 0;
103 return 1 if $unexpected_fail > 0;
110 print "test: $testname\n";
119 print "$result: $name [\n";
123 print "$result: $name\n";
131 end_test($name, "skip", $reason);
138 end_test($name, "failure", $reason);
141 sub success_test($;$)
145 end_test($name, "success", $reason);
152 end_test($name, "xfail", $reason);
158 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
159 printf "time: %04d-%02d-%02d %02d:%02d:%02dZ\n", $year+1900, $mon, $mday, $hour, $min, $sec;
164 print "progress: pop\n";
169 print "progress: push\n";
174 my ($count, $whence) = @_;
176 unless(defined($whence)) {
180 print "progress: $whence$count\n";