tests/test/Test.pm

   1 # -*-perl-*-
   2 package Test;
   3 require 5.002;
   4 use strict;
   5
   6 sub test_vector
   7 {
   8   my @tvec =
   9     (
  10      # test-name options input expected-output expected-return-code
  11      #
  12      ['1a', '', {}, '', 1],
  13      ['1b', "-z ''", {}, '', 0],
  14      ['1c', 'any-string', {}, '', 0],
  15      ['1d', '-n any-string', {}, '', 0],
  16
  17      ['streq-1', 't = t', {}, '', 0],
  18      ['streq-2', 't = f', {}, '', 1],
  19      ['strne-1', 't != t', {}, '', 1],
  20      ['strne-2', 't != f', {}, '', 0],
  21
  22      ['and-1', 't -a t', {}, '', 0],
  23      ['and-2', '"" -a t', {}, '', 1],
  24      ['and-3', 't -a ""', {}, '', 1],
  25      ['and-4', '"" -a ""', {}, '', 1],
  26
  27      ['or-1', 't -o t', {}, '', 0],
  28      ['or-2', '"" -o t', {}, '', 0],
  29      ['or-3', 't -o ""', {}, '', 0],
  30      ['or-4', '"" -o ""', {}, '', 1],
  31
  32      ['eq-1', '9 -eq 9', {}, '', 0],
  33      ['eq-2', '0 -eq 0', {}, '', 0],
  34      ['eq-3', '0 -eq 00', {}, '', 0],
  35      ['eq-4', '8 -eq 9', {}, '', 1],
  36      ['eq-5', '1 -eq 0', {}, '', 1],
  37
  38      ['gt-1', '5 -gt 5', {}, '', 1],
  39      ['gt-2', '5 -gt 4', {}, '', 0],
  40      ['gt-3', '4 -gt 5', {}, '', 1],
  41      ['gt-4', '-1 -gt -2', {}, '', 0],
  42
  43      ['lt-1', '5 -lt 5', {}, '', 1],
  44      ['lt-2', '5 -lt 4', {}, '', 1],
  45      ['lt-3', '4 -lt 5', {}, '', 0],
  46      ['lt-4', '-1 -lt -2', {}, '', 1],
  47
  48      # This evokes `test: 0x0: integer expression expected'.
  49      ['inv-1', '0x0 -eq 00', {}, '', 1],
  50
  51      ['t1', "-t", {}, '', 1],
  52      ['t2', "-t 1", {}, '', 1],
  53     );
  54
  55   my %inverse_op =
  56     (
  57      eq => 'ne',
  58      lt => 'ge',
  59      gt => 'le',
  60     );
  61
  62   # Generate corresponding tests of inverse ops.
  63   # E.g. generate tests of `-ge' from those of `-lt'.
  64   my @tv;
  65   my $t;
  66   foreach $t (@tvec)
  67     {
  68       my ($test_name, $flags, $in, $exp, $ret) = @$t;
  69
  70       my $op;
  71       for $op (qw(gt lt eq))
  72         {
  73           if ($test_name =~ /$op-/ && $flags =~ / -$op /)
  74             {
  75               my $inv = $inverse_op{$op};
  76               $test_name =~ s/$op/$inv/;
  77               $flags =~ s/-$op/-$inv/;
  78               $ret = 1 - $ret;
  79               push (@tv, [$test_name, $flags, $in, $exp, $ret]);
  80             }
  81         }
  82     }
  83
  84   # Generate a negated and a double-negated version of each test.
  85   # There are a few exceptions.
  86   my %not_invertible = map {$_ => 1} qw (1a inv-1 t1);
  87   foreach $t (@tvec)
  88     {
  89       my ($test_name, $flags, $in, $exp, $ret) = @$t;
  90       next if $not_invertible{$test_name};
  91       push (@tv, ["N-$test_name", "! '(' $flags ')'", $in, $exp, 1 - $ret]);
  92       push (@tv, ["NN-$test_name", "! ! '(' $flags ')'", $in, $exp, $ret]);
  93     }
  94
  95   return (@tv, @tvec);
  96 }
  97
  98 1;