gotexp

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # gotexp
   5 # File ID: 1268bb2c-2988-11e5-9cd9-000df06acc56
   6 #
   7 # [Description]
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2015– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 use strict;
  16 use warnings;
  17 use Getopt::Long;
  18
  19 local $| = 1;
  20
  21 our %Opt = (
  22
  23     'help' => 0,
  24     'number' => 1,
  25     'quiet' => 0,
  26     'verbose' => 0,
  27     'version' => 0,
  28
  29 );
  30
  31 our $progname = $0;
  32 $progname =~ s/^.*\/(.*?)$/$1/;
  33 our $VERSION = '0.1.0';
  34
  35 Getopt::Long::Configure('bundling');
  36 GetOptions(
  37
  38     'help|h' => \$Opt{'help'},
  39     'number|n=i' => \$Opt{'number'},
  40     'quiet|q+' => \$Opt{'quiet'},
  41     'verbose|v+' => \$Opt{'verbose'},
  42     'version' => \$Opt{'version'},
  43
  44 ) || die("$progname: Option error. Use -h for help.\n");
  45
  46 $Opt{'verbose'} -= $Opt{'quiet'};
  47 $Opt{'help'} && usage(0);
  48 if ($Opt{'version'}) {
  49     print_version();
  50     exit(0);
  51 }
  52
  53 exit(main());
  54
  55 sub main {
  56     # {{{
  57     my $Retval = 0;
  58     my $count = 0;
  59
  60     my $slurp = join('', <>);
  61     !length($slurp) && return(0);
  62
  63     $slurp =~ s{
  64         (not\ ok\s.*?\n)
  65         .*?
  66         \s+got:\s+
  67         ('.*?'\n)
  68         \#\s+expected:\s+
  69         ('.*?'\n)
  70     }{
  71         my ($header, $got, $exp) = ($1, $2, $3);
  72         $count++;
  73         write_data($count, $Opt{'number'}, $header, $got, $exp);
  74     }egsx;
  75
  76     return $Retval;
  77     # }}}
  78 } # main()
  79
  80 sub write_data {
  81     # {{{
  82     my ($count, $number, $header, $got, $exp) = @_;
  83     if ($count == $Opt{'number'}) {
  84         $exp =~ s/^(.*?\n)(not )?ok .*$/$1/s;
  85         open(my $gotfh, ">got") or die("$progname: got: Cannot create file: $!\n");
  86         open(my $expfh, ">exp") or die("$progname: exp: Cannot create file: $!\n");
  87         print($gotfh $header . $got);
  88         print($expfh $header . $exp);
  89         close($gotfh);
  90         close($expfh);
  91     };
  92     return('');
  93     # }}}
  94 } # write_data()
  95
  96 sub print_version {
  97     # Print program version {{{
  98     print("$progname $VERSION\n");
  99     return;
 100     # }}}
 101 } # print_version()
 102
 103 sub usage {
 104     # Send the help message to stdout {{{
 105     my $Retval = shift;
 106
 107     if ($Opt{'verbose'}) {
 108         print("\n");
 109         print_version();
 110     }
 111     print(<<"END");
 112
 113 Usage: $progname [options] [file [files [...]]]
 114
 115 Options:
 116
 117   -h, --help
 118     Show this help.
 119   -n X, --number X
 120     Skip to error number X.
 121   -q, --quiet
 122     Be more quiet. Can be repeated to increase silence.
 123   -v, --verbose
 124     Increase level of verbosity. Can be repeated.
 125   --version
 126     Print version information.
 127
 128 END
 129     exit($Retval);
 130     # }}}
 131 } # usage()
 132
 133 sub msg {
 134     # Print a status message to stderr based on verbosity level {{{
 135     my ($verbose_level, $Txt) = @_;
 136
 137     if ($Opt{'verbose'} >= $verbose_level) {
 138         print(STDERR "$progname: $Txt\n");
 139     }
 140     return;
 141     # }}}
 142 } # msg()
 143
 144 __END__
 145
 146 # This program is free software; you can redistribute it and/or modify
 147 # it under the terms of the GNU General Public License as published by
 148 # the Free Software Foundation; either version 2 of the License, or (at
 149 # your option) any later version.
 150 #
 151 # This program is distributed in the hope that it will be useful, but
 152 # WITHOUT ANY WARRANTY; without even the implied warranty of
 153 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 154 # See the GNU General Public License for more details.
 155 #
 156 # You should have received a copy of the GNU General Public License
 157 # along with this program.
 158 # If not, see L<http://www.gnu.org/licenses/>.
 159
 160 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :