tools/wvformat

   1 #!/usr/bin/perl -w
   2 #
   3 # WvTest:
   4 #   Copyright (C)2007-2009 Versabanq Innovations Inc. and contributors.
   5 #       Licensed under the GNU Library General Public License, version 2.
   6 #       See the included file named LICENSE for license information.
   7 #
   8 use strict;
   9 use Getopt::Long;
  10
  11 sub usage() {
  12     print STDERR "Usage: $0 [-vs] <file>\n";
  13     exit 127;
  14 }
  15
  16 my ($verbose, $summary, $limit_lines);
  17
  18 GetOptions (
  19     "verbose|v"              => \$verbose,
  20     "summary|s"              => \$summary,
  21     "before-failure|b=i"     => \$limit_lines,
  22     ) or usage();
  23
  24 my $istty = -t STDOUT && $ENV{'TERM'} ne "dumb";
  25 my $columns;
  26 if ($istty) {
  27     $columns = `tput cols`;
  28 } else {
  29     $columns = $ENV{'COLUMNS'} || 80;
  30 }
  31
  32 my @log = ();
  33 my ($file, $sect);
  34 my ($gpasses, $gfails) = (0,0);
  35 my ($lpasses, $lfails) = (0,0);
  36 my ($tpasses, $tfails) = (0,0);
  37
  38 sub colourize($$)
  39 {
  40     my ($column, $result) = @_;
  41     my $pass = ($result eq "ok");
  42
  43     my $begcolour = $istty ? ($pass ? "\e[32;1m" : "\e[31;1m") : "";
  44     my $endcolour = $istty ? "\e[0m" : "";
  45
  46     my $dots = $columns - 15 - $column%$columns;
  47     $dots += $columns if ($dots < 0);
  48     my $leader = "."x$dots;
  49     return "$begcolour$leader $result$endcolour";
  50 }
  51
  52 sub highlight($)
  53 {
  54     my $msg = shift;
  55     my $begcolour = $istty ? "\e[1m\e[4m" : "";
  56     my $endcolour = $istty ? "\e[0m" : "";
  57     return "$begcolour$msg$endcolour";
  58 }
  59
  60 sub resultline($$$)
  61 {
  62     my ($prefix, $name, $result) = @_;
  63     if (!defined $prefix) { $prefix = ''; }
  64     return sprintf("$prefix! %s %s", $name, colourize(length($prefix)+2+length($name)+1, $result));
  65 }
  66
  67 sub print_and_clear_log()
  68 {
  69     print "v"x($columns-1) . "\n"; # Top marker
  70     my @log2print = ();
  71     my $skipped = 0;
  72     foreach (@log) {
  73         if (/^(\([0-9]+\) (#   )?)?!\s*(.*?)\s+(\S+)\s*$/) {
  74             my ($prefix, $name, $result) = ($1, $3, $4);
  75             push @log2print, resultline($prefix, $name, $result);
  76             if ($result ne "ok") {
  77                 print "wvformat: skipped $skipped lines\n" if $skipped;
  78                 print join("\n", @log2print) . "\n";
  79                 @log2print = ();
  80                 $skipped = 0;
  81             }
  82         } else {
  83             push @log2print, $_;
  84         }
  85         while (defined $limit_lines && scalar(@log2print) > $limit_lines) {
  86             shift @log2print;
  87             $skipped++;
  88         }
  89     }
  90     print "wvformat: skipped $skipped lines\n" if $skipped;
  91     print join("\n", @log2print) . "\n";
  92     print "^"x($columns-1) . "\n"; # Bottom marker
  93     @log = ();
  94 }
  95
  96 sub print_test_summary()
  97 {
  98     if (!$verbose) {
  99         print(resultline("", sprintf("%s %s [%d/%d]", $file, $sect, $lpasses, $lpasses+$lfails),
 100                          $lfails ? "FAILED" : "ok") . "\n");
 101         print_and_clear_log() if ($lfails && !$summary);
 102     }
 103     if ($lfails) { $tfails++; }
 104     else         { $tpasses++; }
 105     ($lpasses, $lfails) = (0,0);
 106 }
 107
 108 my $startup = 1;
 109
 110 while (<>)
 111 {
 112     chomp;
 113     s/\r//g;
 114
 115     if (/^(\([0-9]+\) )?\s*Testing "(.*)" in (.*):\s*$/)
 116     {
 117         print_test_summary() unless $startup;
 118         $startup = 0;
 119         (undef, $sect, $file) = ($1, $2, $3);
 120         @log = ();
 121         if ($verbose) {
 122             print highlight($_), "\n";
 123         }
 124     }
 125     elsif (/^(\([0-9]+\) (#   )?)?!\s*(.*?)\s+(\S+)\s*$/)
 126     {
 127         my ($prefix, $name, $result) = ($1, $3, $4);
 128
 129         if ($startup) {
 130             $file = "";
 131             $sect = "Startup";
 132             $startup = 0;
 133         }
 134
 135         if ($verbose) {
 136             print resultline($prefix, $name, $result) . "\n";
 137         } else {
 138             push @log, $_;
 139         }
 140
 141         if ($result eq "ok") {
 142             $gpasses++;
 143             $lpasses++;
 144         } else {
 145             $gfails++;
 146             $lfails++;
 147         }
 148     }
 149     else
 150     {
 151         if ($verbose) {
 152             print "$_\n";
 153         } else {
 154             push @log, $_;
 155         }
 156     }
 157 }
 158 if (!$verbose) {
 159     if (!$startup) {
 160         print_test_summary();
 161     } else {
 162         print_and_clear_log();
 163     }
 164 }
 165
 166 my $gtotal = $gpasses+$gfails;
 167 my $ttotal = $tpasses+$tfails;
 168 printf("\nSummary: %d test%s, %d failure%s".
 169        "\n         %d check%s, %d failure%s\n",
 170     $ttotal, $ttotal==1 ? "" : "s",
 171     $tfails, $tfails==1 ? "" : "s",
 172     $gtotal, $gtotal==1 ? "" : "s",
 173     $gfails, $gfails==1 ? "" : "s");
 174 exit(0);