← Back to branch summary

~ubuntu-branches/ubuntu/utopic/coreutils/utopic-proposed

« back to all changes in this revision

Viewing changes to tests/misc/test

  • Committer: Package Import Robot
  • Author(s): Colin Watson
  • Date: 2012-11-28 03:03:42 UTC
  • mfrom: (8.3.4 sid)
  • Revision ID: package-import@ubuntu.com-20121128030342-21zanj8354gas5gr
Tags: 8.20-3ubuntu1
* Resynchronise with Debian.  Remaining changes:
  - Make 'uname -i -p' return the real processor/hardware, instead of
    unknown.
  - Build-depend on gettext:any instead of on gettext, so that apt-get can
    properly resolve build-dependencies on the tool when cross-building.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/misc/test
1
 
#!/usr/bin/perl
2
 
 
3
 
# Copyright (C) 2008-2011 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 <http://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;