2009-06-04 19:30:23 +04:00
# Perl module for parsing and generating the Subunit protocol
# Copyright (C) 2008-2009 Jelmer Vernooij <jelmer@samba.org>
2009-03-25 17:40:39 +03:00
#
# 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 ;
2018-01-25 07:23:06 +03:00
use Time::HiRes ;
2007-08-27 19:15:38 +04:00
require Exporter ;
@ ISA = qw( Exporter ) ;
use strict ;
2019-12-07 12:37:00 +03:00
use warnings ;
2007-08-27 19:15:38 +04:00
2009-06-03 20:03:45 +04:00
sub start_test ($)
{
my ( $ testname ) = @ _ ;
print "test: $testname\n" ;
}
sub end_test ( $ $ ; $ )
{
my $ name = shift ;
my $ result = shift ;
my $ reason = shift ;
if ( $ reason ) {
2009-06-05 18:10:12 +04:00
print "$result: $name [\n" ;
2010-08-26 05:50:08 +04:00
print $ reason ;
2010-08-28 11:42:10 +04:00
if ( substr ( $ reason , - 1 , 1 ) ne "\n" ) { print "\n" ; }
2009-06-04 15:49:11 +04:00
print "]\n" ;
2009-06-03 20:03:45 +04:00
} else {
print "$result: $name\n" ;
}
}
2018-01-25 07:23:06 +03:00
sub report_time ()
2009-06-03 20:03:45 +04:00
{
my ( $ time ) = @ _ ;
2018-01-25 07:23:06 +03:00
$ time = Time::HiRes:: time ( ) unless ( defined ( $ time ) ) ;
my ( $ sec , $ min , $ hour , $ mday , $ mon , $ year , $ wday , $ yday , $ isdst ) = gmtime ( $ time ) ;
2010-09-14 01:22:35 +04:00
$ sec = ( $ time - int ( $ time ) + $ sec ) ;
2010-09-14 01:56:26 +04:00
my $ msg = sprintf ( "%f" , $ sec ) ;
if ( substr ( $ msg , 1 , 1 ) eq "." ) {
$ msg = "0" . $ msg ;
}
2023-08-17 03:46:17 +03:00
printf "time: %04d-%02d-%02d %02d:%02d:%sZ\n" , $ year + 1900 , $ mon + 1 , $ mday , $ hour , $ min , $ msg ;
2009-06-03 20:03:45 +04:00
}
2010-03-30 16:30:08 +04:00
sub progress_pop ()
{
print "progress: pop\n" ;
}
sub progress_push ()
{
print "progress: push\n" ;
}
sub progress ( $ ; $ )
{
my ( $ count , $ whence ) = @ _ ;
unless ( defined ( $ whence ) ) {
$ whence = "" ;
}
print "progress: $whence$count\n" ;
}
2009-06-05 18:10:12 +04:00
# The following are Samba extensions:
sub start_testsuite ($)
{
my ( $ name ) = @ _ ;
print "testsuite: $name\n" ;
}
sub skip_testsuite ( $ ; $ )
{
my ( $ name , $ reason ) = @ _ ;
if ( $ reason ) {
2009-06-05 19:25:42 +04:00
print "skip-testsuite: $name [\n$reason\n]\n" ;
2009-06-05 18:10:12 +04:00
} else {
print "skip-testsuite: $name\n" ;
}
}
sub end_testsuite ( $ $ ; $ )
{
my $ name = shift ;
my $ result = shift ;
my $ reason = shift ;
if ( $ reason ) {
2009-06-05 18:32:52 +04:00
print "testsuite-$result: $name [\n" ;
print "$reason\n" ;
2009-06-05 18:10:12 +04:00
print "]\n" ;
} else {
2009-06-05 18:32:52 +04:00
print "testsuite-$result: $name\n" ;
2009-06-05 18:10:12 +04:00
}
}
2007-08-27 19:15:38 +04:00
1 ;