2007-08-27 15:15:38 +00:00
package Subunit ;
require Exporter ;
@ ISA = qw( Exporter ) ;
@ EXPORT_OK = qw( parse_results ) ;
use strict ;
2007-12-20 17:07:21 +01:00
sub parse_results ($$$$$)
2007-08-27 15:15:38 +00:00
{
2007-12-20 17:07:21 +01:00
my ( $ msg_ops , $ statistics , $ fh , $ expecting_failure , $ open_tests ) = @ _ ;
2007-10-02 15:54:26 +00:00
my $ unexpected_ok = 0 ;
my $ expected_fail = 0 ;
my $ unexpected_fail = 0 ;
my $ unexpected_err = 0 ;
2007-12-20 15:54:02 +01:00
my $ orig_open_len = $#$ open_tests ;
2007-08-27 15:15:38 +00:00
2008-03-18 15:36:03 +01:00
while ( <$fh> ) {
2007-08-27 15:15:38 +00:00
if ( /^test: (.+)\n/ ) {
2007-12-20 17:07:21 +01:00
$ msg_ops - > control_msg ( $ _ ) ;
$ msg_ops - > start_test ( $ open_tests , $ 1 ) ;
2007-12-20 15:54:02 +01:00
push ( @$ open_tests , $ 1 ) ;
2008-04-16 00:03:00 +02:00
} elsif ( /^(success|successful|failure|skip|knownfail|error): (.*?)( \[)?([ \t]*)\n/ ) {
2007-12-20 17:07:21 +01:00
$ msg_ops - > control_msg ( $ _ ) ;
2007-08-27 15:15:38 +00:00
my $ reason = undef ;
if ( $ 3 ) {
$ reason = "" ;
# reason may be specified in next lines
2008-04-16 00:03:00 +02:00
my $ terminated = 0 ;
2007-08-27 15:15:38 +00:00
while ( <$fh> ) {
2007-12-20 17:07:21 +01:00
$ msg_ops - > control_msg ( $ _ ) ;
2008-04-16 00:03:00 +02: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 15:15:38 +00:00
}
}
my $ result = $ 1 ;
2007-11-29 01:36:38 +01:00
if ( $ 1 eq "success" or $ 1 eq "successful" ) {
2007-12-20 15:54:02 +01:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 17:07:21 +01:00
if ( $ expecting_failure - > ( join ( "." , @$ open_tests ) . ".$2" ) ) {
2007-08-27 15:15:38 +00:00
$ statistics - > { TESTS_UNEXPECTED_OK } + + ;
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 15:54:26 +00:00
$ unexpected_ok + + ;
2007-08-27 15:15:38 +00:00
} else {
$ statistics - > { TESTS_EXPECTED_OK } + + ;
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-08-27 15:15:38 +00:00
}
} elsif ( $ 1 eq "failure" ) {
2007-12-20 15:54:02 +01:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 17:07:21 +01:00
if ( $ expecting_failure - > ( join ( "." , @$ open_tests ) . ".$2" ) ) {
2007-08-27 15:15:38 +00:00
$ statistics - > { TESTS_EXPECTED_FAIL } + + ;
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-10-02 15:54:26 +00:00
$ expected_fail + + ;
2007-08-27 15:15:38 +00:00
} else {
$ statistics - > { TESTS_UNEXPECTED_FAIL } + + ;
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 15:54:26 +00:00
$ unexpected_fail + + ;
2007-08-27 15:15:38 +00:00
}
2008-04-16 00:03:00 +02: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 15:15:38 +00:00
} elsif ( $ 1 eq "skip" ) {
$ statistics - > { TESTS_SKIP } + + ;
2007-12-20 15:54:02 +01:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 0 , $ reason ) ;
2007-08-27 15:15:38 +00:00
} elsif ( $ 1 eq "error" ) {
$ statistics - > { TESTS_ERROR } + + ;
2007-12-20 15:54:02 +01:00
pop ( @$ open_tests ) ; #FIXME: Check that popped value == $2
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , $ 2 , $ 1 , 1 , $ reason ) ;
2007-10-02 15:54:26 +00:00
$ unexpected_err + + ;
2007-08-27 15:15:38 +00:00
}
} else {
2007-12-20 17:07:21 +01:00
$ msg_ops - > output_msg ( $ _ ) ;
2007-08-27 15:15:38 +00:00
}
}
2007-12-20 15:54:02 +01:00
while ( $#$ open_tests > $ orig_open_len ) {
2007-12-20 17:07:21 +01:00
$ msg_ops - > end_test ( $ open_tests , pop ( @$ open_tests ) , "error" , 1 ,
2007-10-02 15:54:26 +00:00
"was started but never finished!" ) ;
2007-08-27 15:15:38 +00:00
$ statistics - > { TESTS_ERROR } + + ;
2007-10-02 15:54:26 +00:00
$ unexpected_err + + ;
2007-08-27 15:15:38 +00:00
}
2007-10-02 15:54:26 +00: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 15:15:38 +00:00
}
1 ;