selftest/format-subunit

   1 #!/usr/bin/perl
   2 # Pretty-format subunit output
   3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
   4 # Published under the GNU GPL, v3 or later
   5
   6 =pod
   7
   8 =head1 NAME
   9
  10 format-subunit [--immediate] < instream > outstream
  11
  12 =head1 SYNOPSIS
  13
  14 Format the output of a subunit stream.
  15
  16 =head1 OPTIONS
  17
  18 =over 4
  19
  20 =item I<--immediate>
  21
  22 Show errors as soon as they happen rather than at the end of the test run.
  23
  24 =head1 LICENSE
  25
  26 GNU General Public License, version 3 or later.
  27
  28 =head1 AUTHOR
  29
  30 Jelmer Vernooij <jelmer@samba.org>
  31
  32 =cut
  33
  34 use Getopt::Long;
  35 use strict;
  36 use FindBin qw($RealBin $Script);
  37 use lib "$RealBin";
  38 use Subunit qw(parse_results);
  39
  40 my $opt_help = undef;
  41 my $opt_verbose = 0;
  42 my $opt_immediate = 0;
  43 my $opt_prefix = ".";
  44
  45 my $result = GetOptions (
  46                 'help|h|?' => \$opt_help,
  47                 'verbose' => \$opt_verbose,
  48                 'immediate' => \$opt_immediate,
  49                 'prefix:s' => \$opt_prefix,
  50             );
  51
  52 exit(1) if (not $result);
  53
  54 my $msg_ops;
  55
  56 # we want unbuffered output
  57 $| = 1;
  58
  59 my $statistics = {
  60         SUITES_FAIL => 0,
  61
  62         TESTS_UNEXPECTED_OK => 0,
  63         TESTS_EXPECTED_OK => 0,
  64         TESTS_UNEXPECTED_FAIL => 0,
  65         TESTS_EXPECTED_FAIL => 0,
  66         TESTS_ERROR => 0,
  67         TESTS_SKIP => 0,
  68 };
  69
  70 require output::plain;
  71 $msg_ops = new output::plain("$opt_prefix/summary", $opt_verbose, $opt_immediate, $statistics, undef);
  72
  73 my $expected_ret = parse_results($msg_ops, $statistics, *STDIN);
  74
  75 $msg_ops->summary();
  76
  77 exit($expected_ret);