Changeset 740 for vendor/current/selftest/Subunit.pm
- Timestamp:
- Nov 14, 2012, 12:59:34 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
vendor/current/selftest/Subunit.pm
r414 r740 20 20 require Exporter; 21 21 @ISA = qw(Exporter); 22 @EXPORT_OK = qw(parse_results);23 22 24 23 use strict; 25 26 sub parse_results($$$)27 {28 my ($msg_ops, $statistics, $fh) = @_;29 my $expected_fail = 0;30 my $unexpected_fail = 0;31 my $unexpected_err = 0;32 my $open_tests = [];33 34 while(<$fh>) {35 if (/^test: (.+)\n/) {36 $msg_ops->control_msg($_);37 $msg_ops->start_test($1);38 push (@$open_tests, $1);39 } elsif (/^time: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)\n/) {40 $msg_ops->report_time(mktime($6, $5, $4, $3, $2-1, $1-1900));41 } elsif (/^(success|successful|failure|fail|skip|knownfail|error|xfail|skip-testsuite|testsuite-failure|testsuite-xfail|testsuite-success|testsuite-error): (.*?)( \[)?([ \t]*)\n/) {42 $msg_ops->control_msg($_);43 my $result = $1;44 my $testname = $2;45 my $reason = undef;46 if ($3) {47 $reason = "";48 # reason may be specified in next lines49 my $terminated = 0;50 while(<$fh>) {51 $msg_ops->control_msg($_);52 if ($_ eq "]\n") { $terminated = 1; last; } else { $reason .= $_; }53 }54 55 unless ($terminated) {56 $statistics->{TESTS_ERROR}++;57 $msg_ops->end_test($testname, "error", 1,58 "reason ($result) interrupted");59 return 1;60 }61 }62 if ($result eq "success" or $result eq "successful") {63 pop(@$open_tests); #FIXME: Check that popped value == $testname64 $statistics->{TESTS_EXPECTED_OK}++;65 $msg_ops->end_test($testname, "success", 0, $reason);66 } elsif ($result eq "xfail" or $result eq "knownfail") {67 pop(@$open_tests); #FIXME: Check that popped value == $testname68 $statistics->{TESTS_EXPECTED_FAIL}++;69 $msg_ops->end_test($testname, "xfail", 0, $reason);70 $expected_fail++;71 } elsif ($result eq "failure" or $result eq "fail") {72 pop(@$open_tests); #FIXME: Check that popped value == $testname73 $statistics->{TESTS_UNEXPECTED_FAIL}++;74 $msg_ops->end_test($testname, "failure", 1, $reason);75 $unexpected_fail++;76 } elsif ($result eq "skip") {77 $statistics->{TESTS_SKIP}++;78 # Allow tests to be skipped without prior announcement of test79 my $last = pop(@$open_tests);80 if (defined($last) and $last ne $testname) {81 push (@$open_tests, $testname);82 }83 $msg_ops->end_test($testname, "skip", 0, $reason);84 } elsif ($result eq "error") {85 $statistics->{TESTS_ERROR}++;86 pop(@$open_tests); #FIXME: Check that popped value == $testname87 $msg_ops->end_test($testname, "error", 1, $reason);88 $unexpected_err++;89 } elsif ($result eq "skip-testsuite") {90 $msg_ops->skip_testsuite($testname);91 } elsif ($result eq "testsuite-success") {92 $msg_ops->end_testsuite($testname, "success", $reason);93 } elsif ($result eq "testsuite-failure") {94 $msg_ops->end_testsuite($testname, "failure", $reason);95 } elsif ($result eq "testsuite-xfail") {96 $msg_ops->end_testsuite($testname, "xfail", $reason);97 } elsif ($result eq "testsuite-error") {98 $msg_ops->end_testsuite($testname, "error", $reason);99 }100 } elsif (/^testsuite: (.*)\n/) {101 $msg_ops->start_testsuite($1);102 } elsif (/^testsuite-count: (\d+)\n/) {103 $msg_ops->testsuite_count($1);104 } else {105 $msg_ops->output_msg($_);106 }107 }108 109 while ($#$open_tests+1 > 0) {110 $msg_ops->end_test(pop(@$open_tests), "error", 1,111 "was started but never finished!");112 $statistics->{TESTS_ERROR}++;113 $unexpected_err++;114 }115 116 return 1 if $unexpected_err > 0;117 return 1 if $unexpected_fail > 0;118 return 0;119 }120 24 121 25 sub start_test($) … … 132 36 if ($reason) { 133 37 print "$result: $name [\n"; 134 print "$reason"; 38 print $reason; 39 if (substr($reason, -1, 1) ne "\n") { print "\n"; } 135 40 print "]\n"; 136 41 } else { … … 139 44 } 140 45 141 sub skip_test($;$)142 {143 my $name = shift;144 my $reason = shift;145 end_test($name, "skip", $reason);146 }147 148 sub fail_test($;$)149 {150 my $name = shift;151 my $reason = shift;152 end_test($name, "fail", $reason);153 }154 155 sub success_test($;$)156 {157 my $name = shift;158 my $reason = shift;159 end_test($name, "success", $reason);160 }161 162 sub xfail_test($;$)163 {164 my $name = shift;165 my $reason = shift;166 end_test($name, "xfail", $reason);167 }168 169 46 sub report_time($) 170 47 { 171 48 my ($time) = @_; 172 49 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time); 173 printf "time: %04d-%02d-%02d %02d:%02d:%02d\n", $year+1900, $mon+1, $mday, $hour, $min, $sec; 50 $sec = ($time - int($time) + $sec); 51 my $msg = sprintf("%f", $sec); 52 if (substr($msg, 1, 1) eq ".") { 53 $msg = "0" . $msg; 54 } 55 printf "time: %04d-%02d-%02d %02d:%02d:%s\n", $year+1900, $mon+1, $mday, $hour, $min, $msg; 56 } 57 58 sub progress_pop() 59 { 60 print "progress: pop\n"; 61 } 62 63 sub progress_push() 64 { 65 print "progress: push\n"; 66 } 67 68 sub progress($;$) 69 { 70 my ($count, $whence) = @_; 71 72 unless(defined($whence)) { 73 $whence = ""; 74 } 75 76 print "progress: $whence$count\n"; 174 77 } 175 78 … … 206 109 } 207 110 208 sub testsuite_count($)209 {210 my ($count) = @_;211 print "testsuite-count: $count\n";212 }213 214 111 1;
Note:
See TracChangeset
for help on using the changeset viewer.