2009-03-25 17:40:39 +03:00
# Simple Perl module for parsing the Subunit protocol
# Copyright (C) 2008 Jelmer Vernooij <jelmer@samba.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
2007-08-27 19:15:38 +04:00
package Subunit ;
2009-06-03 19:39:54 +04:00
use POSIX ;
2007-08-27 19:15:38 +04:00
require Exporter ;
@ ISA = qw( Exporter ) ;
@ EXPORT_OK = qw( parse_results ) ;
use strict ;
2007-12-20 19:07:21 +03:00
sub parse_results ($$$$$)
2007-08-27 19:15:38 +04:00
{
2007-12-20 19:07:21 +03:00
my ( $ msg_ops , $ statistics , $ fh , $ expecting_failure , $ open_tests ) = @ _ ;
2007-10-02 19:54:26 +04:00
my $ unexpected_ok = 0 ;
my $ expected_fail = 0 ;
my $ unexpected_fail = 0 ;
my $ unexpected_err = 0 ;
2007-12-20 17:54:02 +03:00
my $ orig_open_len = $#$ open_tests ;
2007-08-27 19:15:38 +04:00
2008-03-18 17:36:03 +03:00
while ( <$fh> ) {
2007-08-27 19:15:38 +04:00
if ( /^test: (.+)\n/ ) {
2007-12-20 19:07:21 +03:00
$ msg_ops - > control_msg ( $ _ ) ;
$ msg_ops - > start_test ( $ open_tests , $ 1 ) ;
2007-12-20 17:54:02 +03:00
push ( @$ open_tests , $ 1 ) ;
2009-06-03 19:39:54 +04:00
} elsif ( /^time: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)Z\n/ ) {
$ msg_ops - > report_time ( mktime ( $ 6 , $ 5 , $ 4 , $ 3 , $ 2 , $ 1 ) ) ;
2008-04-16 02:03:00 +04:00
} elsif ( /^(success|successful|failure|skip|knownfail|error): (.*?)( \[)?([ \t]*)\n/ ) {
2007-12-20 19:07:21 +03:00
$ msg_ops - > control_msg ( $ _ ) ;
2007-08-27 19:15:38 +04:00
my $ reason = undef ;
if ( $ 3 ) {
$ reason = "" ;
# reason may be specified in next lines
2008-04-16 02:03:00 +04:00
my $ terminated = 0 ;
2007-08-27 19:15:38 +04:00
while ( <$fh> ) {
2007-12-20 19:07:21 +03:00
$ msg_ops - > control_msg ( $ _ ) ;
2008-04-16 02:03:00 +04:00
if ( $ _ eq "]\n" ) { $ terminated = 1 ; last ; } else { $ reason . = $ _ ; }
}
unless ( $ terminated ) {
$ statistics - > { TESTS_ERROR } + + ;
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , "reason interrupted" ) ;
return 1 ;
2007-08-27 19:15:38 +04:00
}
}
my $ result = $ 1 ;
2007-11-29 03:36:38 +03:00
if ( $ 1 eq "success" or $ 1 eq "successful" ) {
2007-12-20 17:54:02 +03:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 19:07:21 +03:00
if ( $ expecting_failure - > ( join ( "." , @$ open_tests ) . ".$2" ) ) {
2007-08-27 19:15:38 +04:00
$ statistics - > { TESTS_UNEXPECTED_OK } + + ;
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 19:54:26 +04:00
$ unexpected_ok + + ;
2007-08-27 19:15:38 +04:00
} else {
$ statistics - > { TESTS_EXPECTED_OK } + + ;
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-08-27 19:15:38 +04:00
}
} elsif ( $ 1 eq "failure" ) {
2007-12-20 17:54:02 +03:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 19:07:21 +03:00
if ( $ expecting_failure - > ( join ( "." , @$ open_tests ) . ".$2" ) ) {
2007-08-27 19:15:38 +04:00
$ statistics - > { TESTS_EXPECTED_FAIL } + + ;
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-10-02 19:54:26 +04:00
$ expected_fail + + ;
2007-08-27 19:15:38 +04:00
} else {
$ statistics - > { TESTS_UNEXPECTED_FAIL } + + ;
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 19:54:26 +04:00
$ unexpected_fail + + ;
2007-08-27 19:15:38 +04:00
}
2008-04-16 02:03:00 +04:00
} elsif ( $ 1 eq "knownfail" ) {
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
$ statistics - > { TESTS_EXPECTED_FAIL } + + ;
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-08-27 19:15:38 +04:00
} elsif ( $ 1 eq "skip" ) {
$ statistics - > { TESTS_SKIP } + + ;
2007-12-20 17:54:02 +03:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-08-27 19:15:38 +04:00
} elsif ( $ 1 eq "error" ) {
$ statistics - > { TESTS_ERROR } + + ;
2007-12-20 17:54:02 +03:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 19:54:26 +04:00
$ unexpected_err + + ;
2007-08-27 19:15:38 +04:00
}
} else {
2007-12-20 19:07:21 +03:00
$ msg_ops - > output_msg ( $ _ ) ;
2007-08-27 19:15:38 +04:00
}
}
2007-12-20 17:54:02 +03:00
while ( $#$ open_tests > $ orig_open_len ) {
2007-12-20 19:07:21 +03:00
$ msg_ops - > end_test ( $ open_tests , pop ( @$ open_tests ) , "error" , 1 ,
2007-10-02 19:54:26 +04:00
"was started but never finished!" ) ;
2007-08-27 19:15:38 +04:00
$ statistics - > { TESTS_ERROR } + + ;
2007-10-02 19:54:26 +04:00
$ unexpected_err + + ;
2007-08-27 19:15:38 +04:00
}
2007-10-02 19:54:26 +04:00
return 1 if $ unexpected_err > 0 ;
return 1 if $ unexpected_fail > 0 ;
return 1 if $ unexpected_ok > 0 and $ expected_fail > 0 ;
return 0 if $ unexpected_ok > 0 and $ expected_fail == 0 ;
return 0 if $ expected_fail > 0 ;
return 1 ;
2007-08-27 19:15:38 +04:00
}
1 ;