tevent: avoid any operation on epoll_ev after a epoll_panic()
[Samba/gebeck_regimport.git] / selftest / Subunit.pm
blob1cc0e721696673b9c21a873fb03d4acd618767de
1 # Perl module for parsing and generating the Subunit protocol
2 # Copyright (C) 2008-2009 Jelmer Vernooij <jelmer@samba.org>
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation; either version 3 of the License, or
7 # (at your option) any later version.
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program. If not, see <http://www.gnu.org/licenses/>.
17 package Subunit;
18 use POSIX;
20 require Exporter;
21 @ISA = qw(Exporter);
23 use strict;
25 sub start_test($)
27 my ($testname) = @_;
28 print "test: $testname\n";
31 sub end_test($$;$)
33 my $name = shift;
34 my $result = shift;
35 my $reason = shift;
36 if ($reason) {
37 print "$result: $name [\n";
38 print $reason;
39 if (substr($reason, -1, 1) ne "\n") { print "\n"; }
40 print "]\n";
41 } else {
42 print "$result: $name\n";
46 sub report_time($)
48 my ($time) = @_;
49 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
50 $sec = ($time - int($time) + $sec);
51 my $msg = sprintf("%f", $sec);
52 if (substr($msg, 1, 1) eq ".") {
53 $msg = "0" . $msg;
55 printf "time: %04d-%02d-%02d %02d:%02d:%s\n", $year+1900, $mon+1, $mday, $hour, $min, $msg;
58 sub progress_pop()
60 print "progress: pop\n";
63 sub progress_push()
65 print "progress: push\n";
68 sub progress($;$)
70 my ($count, $whence) = @_;
72 unless(defined($whence)) {
73 $whence = "";
76 print "progress: $whence$count\n";
79 # The following are Samba extensions:
81 sub start_testsuite($)
83 my ($name) = @_;
84 print "testsuite: $name\n";
87 sub skip_testsuite($;$)
89 my ($name, $reason) = @_;
90 if ($reason) {
91 print "skip-testsuite: $name [\n$reason\n]\n";
92 } else {
93 print "skip-testsuite: $name\n";
97 sub end_testsuite($$;$)
99 my $name = shift;
100 my $result = shift;
101 my $reason = shift;
102 if ($reason) {
103 print "testsuite-$result: $name [\n";
104 print "$reason\n";
105 print "]\n";
106 } else {
107 print "testsuite-$result: $name\n";