tests/test/Test.pm

   1 # Test "test".
   2
   3 # Copyright (C) 1998, 2003, 2005, 2006 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 2 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, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18 # 02110-1301, USA.
  19
  20 # -*-perl-*-
  21 package Test;
  22 require 5.002;
  23 use strict;
  24
  25 sub test_vector
  26 {
  27   my @tvec =
  28     (
  29      # test-name options input expected-output expected-return-code
  30      #
  31      ['1a', '', {}, '', 1],
  32      ['1b', "-z ''", {}, '', 0],
  33      ['1c', 'any-string', {}, '', 0],
  34      ['1d', '-n any-string', {}, '', 0],
  35      ['1e', "''", {}, '', 1],
  36      ['1f', '-', {}, '', 0],
  37      ['1g', '--', {}, '', 0],
  38      ['1h', '-0', {}, '', 0],
  39      ['1i', '-f', {}, '', 0],
  40      ['1j', '--help', {}, '', 0],
  41      ['1k', '--version', {}, '', 0],
  42
  43      ['streq-1', 't = t', {}, '', 0],
  44      ['streq-2', 't = f', {}, '', 1],
  45      ['streq-3', '! = !', {}, '', 0],
  46      ['streq-4', '= = =', {}, '', 0],
  47      ['streq-5', "'(' = '('", {}, '', 0],
  48      ['streq-6', "'(' = ')'", {}, '', 1],
  49      ['strne-1', 't != t', {}, '', 1],
  50      ['strne-2', 't != f', {}, '', 0],
  51      ['strne-3', '! != !', {}, '', 1],
  52      ['strne-4', '= != =', {}, '', 1],
  53      ['strne-5', "'(' != '('", {}, '', 1],
  54      ['strne-6', "'(' != ')'", {}, '', 0],
  55
  56      ['and-1', 't -a t', {}, '', 0],
  57      ['and-2', "'' -a t", {}, '', 1],
  58      ['and-3', "t -a ''", {}, '', 1],
  59      ['and-4', "'' -a ''", {}, '', 1],
  60
  61      ['or-1', 't -o t', {}, '', 0],
  62      ['or-2', "'' -o t", {}, '', 0],
  63      ['or-3', "t -o ''", {}, '', 0],
  64      ['or-4', "'' -o ''", {}, '', 1],
  65
  66      ['eq-1', '9 -eq 9', {}, '', 0],
  67      ['eq-2', '0 -eq 0', {}, '', 0],
  68      ['eq-3', '0 -eq 00', {}, '', 0],
  69      ['eq-4', '8 -eq 9', {}, '', 1],
  70      ['eq-5', '1 -eq 0', {}, '', 1],
  71      ['eq-6', '340282366920938463463374607431768211456 -eq 0', {}, '', 1],
  72
  73      ['gt-1', '5 -gt 5', {}, '', 1],
  74      ['gt-2', '5 -gt 4', {}, '', 0],
  75      ['gt-3', '4 -gt 5', {}, '', 1],
  76      ['gt-4', '-1 -gt -2', {}, '', 0],
  77      ['gt-5', '18446744073709551616 -gt -18446744073709551616', {}, '', 0],
  78
  79      ['lt-1', '5 -lt 5', {}, '', 1],
  80      ['lt-2', '5 -lt 4', {}, '', 1],
  81      ['lt-3', '4 -lt 5', {}, '', 0],
  82      ['lt-4', '-1 -lt -2', {}, '', 1],
  83      ['lt-5', '-18446744073709551616 -lt 18446744073709551616', {}, '', 0],
  84
  85      # This evokes `test: 0x0: integer expression expected'.
  86      ['inv-1', '0x0 -eq 00', {}, '', 2],
  87
  88      ['t1', "-t", {}, '', 0],
  89      ['t2', "-t 1", {}, '', 1],
  90
  91      ['paren-1', "'(' '' ')'", {}, '', 1],
  92      ['paren-2', "'(' '(' ')'", {}, '', 0],
  93      ['paren-3', "'(' ')' ')'", {}, '', 0],
  94      ['paren-4', "'(' ! ')'", {}, '', 0],
  95      ['paren-5', "'(' -a ')'", {}, '', 0],
  96     );
  97
  98   my %inverse_op =
  99     (
 100      eq => 'ne',
 101      lt => 'ge',
 102      gt => 'le',
 103     );
 104
 105   # Generate corresponding tests of inverse ops.
 106   # E.g. generate tests of `-ge' from those of `-lt'.
 107   my @tv;
 108   my $t;
 109   foreach $t (@tvec)
 110     {
 111       my ($test_name, $flags, $in, $exp, $ret) = @$t;
 112
 113       my $op;
 114       for $op (qw(gt lt eq))
 115         {
 116           if ($test_name =~ /$op-/ && $flags =~ / -$op /)
 117             {
 118               my $inv = $inverse_op{$op};
 119               $test_name =~ s/$op/$inv/;
 120               $flags =~ s/-$op/-$inv/;
 121               $ret = 1 - $ret;
 122               push (@tv, [$test_name, $flags, $in, $exp, $ret]);
 123             }
 124         }
 125     }
 126
 127   # Generate parenthesized and negated versions of each test.
 128   # There are a few exceptions.
 129   my %not_N   = map {$_ => 1} qw (1a);
 130   my %not_P   = map {$_ => 1} qw (1a
 131                                   streq-6 strne-6
 132                                   paren-1 paren-2 paren-3 paren-4 paren-5);
 133   foreach $t (@tvec)
 134     {
 135       my ($test_name, $flags, $in, $exp, $ret) = @$t;
 136       next if $ret == 2;
 137       push (@tv, ["N-$test_name", "! $flags", $in, $exp, 1 - $ret])
 138           unless $not_N{$test_name};
 139       push (@tv, ["P-$test_name", "'(' $flags ')'", $in, $exp, $ret])
 140           unless $not_P{$test_name};
 141       push (@tv, ["NP-$test_name", "! '(' $flags ')'", $in, $exp, 1 - $ret])
 142           unless $not_P{$test_name};
 143       push (@tv, ["NNP-$test_name", "! ! '(' $flags ')'", $in, $exp, $ret])
 144           unless $not_P{$test_name};
 145     }
 146
 147   return (@tv, @tvec);
 148 }
 149
 150 1;