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
  20 require Exporter;
  21 @ISA = qw(Exporter);
  22
  23 use strict;
  24
  25 sub start_test($)
  26 {
  27         my ($testname) = @_;
  28         print "test: $testname\n";
  29 }
  30
  31 sub end_test($$;$)
  32 {
  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";
  43         }
  44 }
  45
  46 sub report_time($)
  47 {
  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;
  54         }
  55         printf "time: %04d-%02d-%02d %02d:%02d:%s\n", $year+1900, $mon+1, $mday, $hour, $min, $msg;
  56 }
  57
  58 sub progress_pop()
  59 {
  60         print "progress: pop\n";
  61 }
  62
  63 sub progress_push()
  64 {
  65         print "progress: push\n";
  66 }
  67
  68 sub progress($;$)
  69 {
  70         my ($count, $whence) = @_;
  71
  72         unless(defined($whence)) {
  73                 $whence = "";
  74         }
  75
  76         print "progress: $whence$count\n";
  77 }
  78
  79 # The following are Samba extensions:
  80
  81 sub start_testsuite($)
  82 {
  83         my ($name) = @_;
  84         print "testsuite: $name\n";
  85 }
  86
  87 sub skip_testsuite($;$)
  88 {
  89         my ($name, $reason) = @_;
  90         if ($reason) {
  91                 print "skip-testsuite: $name [\n$reason\n]\n";
  92         } else {
  93                 print "skip-testsuite: $name\n";
  94         }
  95 }
  96
  97 sub end_testsuite($$;$)
  98 {
  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";
 108         }
 109 }
 110
 111 1;