selftest/Subunit.pm

   1 # Perl module for parsing and generating the Subunit protocol
   2 # Copyright (C) 2008-2009 Jelmer Vernooij <jelmer@samba.org>
   3 #
   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.
   8
   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.
  13
  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/>.
  16
  17 package Subunit;
  18 use POSIX;
  19 use Time::HiRes;
  20
  21 require Exporter;
  22 @ISA = qw(Exporter);
  23
  24 use strict;
  25
  26 sub start_test($)
  27 {
  28         my ($testname) = @_;
  29         print "test: $testname\n";
  30 }
  31
  32 sub end_test($$;$)
  33 {
  34         my $name = shift;
  35         my $result = shift;
  36         my $reason = shift;
  37         if ($reason) {
  38                 print "$result: $name [\n";
  39                 print $reason;
  40                 if (substr($reason, -1, 1) ne "\n") { print "\n"; }
  41                 print "]\n";
  42         } else {
  43                 print "$result: $name\n";
  44         }
  45 }
  46
  47 sub report_time()
  48 {
  49         my ($time) = @_;
  50         $time = Time::HiRes::time() unless (defined($time));
  51         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($time);
  52         $sec = ($time - int($time) + $sec);
  53         my $msg = sprintf("%f", $sec);
  54         if (substr($msg, 1, 1) eq ".") {
  55                 $msg = "0" . $msg;
  56         }
  57         printf "time: %04d-%02d-%02d %02d:%02d:%s\n", $year+1900, $mon+1, $mday, $hour, $min, $msg;
  58 }
  59
  60 sub progress_pop()
  61 {
  62         print "progress: pop\n";
  63 }
  64
  65 sub progress_push()
  66 {
  67         print "progress: push\n";
  68 }
  69
  70 sub progress($;$)
  71 {
  72         my ($count, $whence) = @_;
  73
  74         unless(defined($whence)) {
  75                 $whence = "";
  76         }
  77
  78         print "progress: $whence$count\n";
  79 }
  80
  81 # The following are Samba extensions:
  82
  83 sub start_testsuite($)
  84 {
  85         my ($name) = @_;
  86         print "testsuite: $name\n";
  87 }
  88
  89 sub skip_testsuite($;$)
  90 {
  91         my ($name, $reason) = @_;
  92         if ($reason) {
  93                 print "skip-testsuite: $name [\n$reason\n]\n";
  94         } else {
  95                 print "skip-testsuite: $name\n";
  96         }
  97 }
  98
  99 sub end_testsuite($$;$)
 100 {
 101         my $name = shift;
 102         my $result = shift;
 103         my $reason = shift;
 104         if ($reason) {
 105                 print "testsuite-$result: $name [\n";
 106                 print "$reason\n";
 107                 print "]\n";
 108         } else {
 109                 print "testsuite-$result: $name\n";
 110         }
 111 }
 112
 113 1;