tests/misc/test.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2008-2019 Free Software Foundation, Inc.
   4
   5 # This program is free software: you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation, either version 3 of the License, or
   8 # (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  17
  18 use strict;
  19
  20 my $limits = getlimits ();
  21
  22 my $prog = 'test';
  23
  24 # Turn off localization of executable's output.
  25 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  26
  27 sub digest_test ($)
  28 {
  29   my ($t) = @_;
  30   my @args;
  31   my $ret = 0;
  32   my @list_of_hashref;
  33   foreach my $e (@$t)
  34     {
  35       !ref $e
  36         and push (@args, $e), next;
  37       ref $e eq 'HASH'
  38         or (warn "$0: $t->[0]: unexpected entry type\n"), next;
  39
  40       exists $e->{EXIT}
  41         and $ret = $e->{EXIT}, next;
  42
  43       push @list_of_hashref, $e;
  44     }
  45   shift @args; # discard test name
  46   my $flags = join ' ', @args;
  47
  48   return ($flags, $ret, \@list_of_hashref);
  49 }
  50
  51 sub add_inverse_op_tests($)
  52 {
  53   my ($tests) = @_;
  54   my @new;
  55
  56   my %inverse_op =
  57     (
  58      eq => 'ne',
  59      lt => 'ge',
  60      gt => 'le',
  61     );
  62
  63   foreach my $t (@$tests)
  64     {
  65       push @new, $t;
  66
  67       my $test_name = $t->[0];
  68       my ($flags, $ret, $LoH) = digest_test $t;
  69
  70       # Generate corresponding tests of inverse ops.
  71       # E.g. generate tests of '-ge' from those of '-lt'.
  72       foreach my $op (qw(gt lt eq))
  73         {
  74           if ($test_name =~ /$op-/ && $flags =~ / -$op /)
  75             {
  76               my $inv = $inverse_op{$op};
  77               $test_name =~ s/$op/$inv/;
  78               $flags =~ s/-$op/-$inv/;
  79               $ret = 1 - $ret;
  80               push (@new, [$test_name, $flags, {EXIT=>$ret}, @$LoH]);
  81             }
  82         }
  83     }
  84   return @new;
  85 }
  86
  87 sub add_pn_tests($)
  88 {
  89   my ($tests) = @_;
  90   my @new;
  91
  92   # Generate parenthesized and negated versions of each test.
  93   # There are a few exceptions.
  94   my %not_N   = map {$_ => 1} qw (1a);
  95   my %not_P   = map {$_ => 1} qw (1a
  96                                   streq-6 strne-6
  97                                   paren-1 paren-2 paren-3 paren-4 paren-5);
  98   foreach my $t (@$tests)
  99     {
 100       push @new, $t;
 101
 102       my $test_name = $t->[0];
 103       my ($flags, $ret, $LoH) = digest_test $t;
 104       next if $ret == 2;
 105
 106       push (@new, ["N-$test_name", "! $flags", {EXIT=>1-$ret}, @$LoH])
 107         unless $not_N{$test_name};
 108       push (@new, ["P-$test_name", "'(' $flags ')'", {EXIT=>$ret}, @$LoH])
 109         unless $not_P{$test_name};
 110       push (@new, ["NP-$test_name", "! '(' $flags ')'", {EXIT=>1-$ret}, @$LoH])
 111         unless $not_P{$test_name};
 112       push (@new, ["NNP-$test_name", "! ! '(' $flags ')'", {EXIT=>$ret, @$LoH}])
 113         unless $not_P{$test_name};
 114     }
 115
 116   return @new;
 117 }
 118
 119 my @Tests =
 120 (
 121   ['1a', {EXIT=>1}],
 122   ['1b', qw(-z '')],
 123   ['1c', 'any-string'],
 124   ['1d', qw(-n any-string)],
 125   ['1e', "''", {EXIT=>1}],
 126   ['1f', '-'],
 127   ['1g', '--'],
 128   ['1h', '-0'],
 129   ['1i', '-f'],
 130   ['1j', '--help'],
 131   ['1k', '--version'],
 132
 133   ['streq-1', qw(t = t)],
 134   ['streq-2', qw(t = f), {EXIT=>1}],
 135   ['streqeq-1', qw(t == t)],
 136   ['streqeq-2', qw(t == f), {EXIT=>1}],
 137   ['streq-3', qw(! = !)],
 138   ['streq-4', qw(= = =)],
 139   ['streq-5', "'(' = '('"],
 140   ['streq-6', "'(' = ')'", {EXIT=>1}],
 141   ['strne-1', qw(t != t), {EXIT=>1}],
 142   ['strne-2', qw(t != f)],
 143   ['strne-3', qw(! != !), {EXIT=>1}],
 144   ['strne-4', qw(= != =), {EXIT=>1}],
 145   ['strne-5', "'(' != '('", {EXIT=>1}],
 146   ['strne-6', "'(' != ')'"],
 147
 148   ['and-1', qw(t -a t)],
 149   ['and-2', qw('' -a t), {EXIT=>1}],
 150   ['and-3', qw(t -a ''), {EXIT=>1}],
 151   ['and-4', qw('' -a ''), {EXIT=>1}],
 152
 153   ['or-1', qw(t -o t)],
 154   ['or-2', qw('' -o t)],
 155   ['or-3', qw(t -o '')],
 156   ['or-4', qw('' -o ''), {EXIT=>1}],
 157
 158   ['eq-1', qw(9 -eq 9)],
 159   ['eq-2', qw(0 -eq 0)],
 160   ['eq-3', qw(0 -eq 00)],
 161   ['eq-4', qw(8 -eq 9), {EXIT=>1}],
 162   ['eq-5', qw(1 -eq 0), {EXIT=>1}],
 163   ['eq-6', "$limits->{UINTMAX_OFLOW} -eq 0", {EXIT=>1}],
 164
 165   ['gt-1', qw(5 -gt 5), {EXIT=>1}],
 166   ['gt-2', qw(5 -gt 4)],
 167   ['gt-3', qw(4 -gt 5), {EXIT=>1}],
 168   ['gt-4', qw(-1 -gt -2)],
 169   ['gt-5', "$limits->{UINTMAX_OFLOW} -gt $limits->{INTMAX_UFLOW}"],
 170
 171   ['lt-1', qw(5 -lt 5), {EXIT=>1}],
 172   ['lt-2', qw(5 -lt 4), {EXIT=>1}],
 173   ['lt-3', qw(4 -lt 5)],
 174   ['lt-4', qw(-1 -lt -2), {EXIT=>1}],
 175   ['lt-5', "$limits->{INTMAX_UFLOW} -lt $limits->{UINTMAX_OFLOW}"],
 176
 177   ['inv-1', qw(0x0 -eq 00), {EXIT=>2},
 178    {ERR=>"$prog: invalid integer '0x0'\n"}],
 179
 180   ['t1', "-t"],
 181   ['t2', qw(-t 1), {EXIT=>1}],
 182
 183   ['paren-1', "'(' '' ')'", {EXIT=>1}],
 184   ['paren-2', "'(' '(' ')'"],
 185   ['paren-3', "'(' ')' ')'"],
 186   ['paren-4', "'(' ! ')'"],
 187   ['paren-5', "'(' -a ')'"],
 188 );
 189
 190 @Tests = add_inverse_op_tests \@Tests;
 191 @Tests = add_pn_tests \@Tests;
 192
 193 my $save_temps = $ENV{DEBUG};
 194 my $verbose = $ENV{VERBOSE};
 195
 196 my $fail = run_tests ($prog, \$prog, \@Tests, $save_temps, $verbose);
 197 exit $fail;