tests: skip when a debian libc6-2.7-11 bug makes printf segfault
[platform/upstream/coreutils.git] / tests / misc / test
1 #!/usr/bin/perl
2
3 # Copyright (C) 2008 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 $prog = 'test';
21
22 # Turn off localization of executable's output.
23 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
24
25 sub digest_test ($)
26 {
27   my ($t) = @_;
28   my @args;
29   my $ret = 0;
30   my @list_of_hashref;
31   foreach my $e (@$t)
32     {
33       !ref $e
34         and push (@args, $e), next;
35       ref $e eq 'HASH'
36         or (warn "$0: $t->[0]: unexpected entry type\n"), next;
37
38       exists $e->{EXIT}
39         and $ret = $e->{EXIT}, next;
40
41       push @list_of_hashref, $e;
42     }
43   shift @args; # discard test name
44   my $flags = join ' ', @args;
45
46   return ($flags, $ret, \@list_of_hashref);
47 }
48
49 sub add_inverse_op_tests($)
50 {
51   my ($tests) = @_;
52   my @new;
53
54   my %inverse_op =
55     (
56      eq => 'ne',
57      lt => 'ge',
58      gt => 'le',
59     );
60
61   foreach my $t (@$tests)
62     {
63       push @new, $t;
64
65       my $test_name = $t->[0];
66       my ($flags, $ret, $LoH) = digest_test $t;
67
68       # Generate corresponding tests of inverse ops.
69       # E.g. generate tests of `-ge' from those of `-lt'.
70       foreach my $op (qw(gt lt eq))
71         {
72           if ($test_name =~ /$op-/ && $flags =~ / -$op /)
73             {
74               my $inv = $inverse_op{$op};
75               $test_name =~ s/$op/$inv/;
76               $flags =~ s/-$op/-$inv/;
77               $ret = 1 - $ret;
78               push (@new, [$test_name, $flags, {EXIT=>$ret}, @$LoH]);
79             }
80         }
81     }
82   return @new;
83 }
84
85 sub add_pn_tests($)
86 {
87   my ($tests) = @_;
88   my @new;
89
90   # Generate parenthesized and negated versions of each test.
91   # There are a few exceptions.
92   my %not_N   = map {$_ => 1} qw (1a);
93   my %not_P   = map {$_ => 1} qw (1a
94                                   streq-6 strne-6
95                                   paren-1 paren-2 paren-3 paren-4 paren-5);
96   foreach my $t (@$tests)
97     {
98       push @new, $t;
99
100       my $test_name = $t->[0];
101       my ($flags, $ret, $LoH) = digest_test $t;
102       next if $ret == 2;
103
104       push (@new, ["N-$test_name", "! $flags", {EXIT=>1-$ret}, @$LoH])
105         unless $not_N{$test_name};
106       push (@new, ["P-$test_name", "'(' $flags ')'", {EXIT=>$ret}, @$LoH])
107         unless $not_P{$test_name};
108       push (@new, ["NP-$test_name", "! '(' $flags ')'", {EXIT=>1-$ret}, @$LoH])
109         unless $not_P{$test_name};
110       push (@new, ["NNP-$test_name", "! ! '(' $flags ')'", {EXIT=>$ret, @$LoH}])
111         unless $not_P{$test_name};
112     }
113
114   return @new;
115 }
116
117 my @Tests =
118 (
119   ['1a', {EXIT=>1}],
120   ['1b', qw(-z '')],
121   ['1c', 'any-string'],
122   ['1d', qw(-n any-string)],
123   ['1e', "''", {EXIT=>1}],
124   ['1f', '-'],
125   ['1g', '--'],
126   ['1h', '-0'],
127   ['1i', '-f'],
128   ['1j', '--help'],
129   ['1k', '--version'],
130
131   ['streq-1', qw(t = t)],
132   ['streq-2', qw(t = f), {EXIT=>1}],
133   ['streq-3', qw(! = !)],
134   ['streq-4', qw(= = =)],
135   ['streq-5', "'(' = '('"],
136   ['streq-6', "'(' = ')'", {EXIT=>1}],
137   ['strne-1', qw(t != t), {EXIT=>1}],
138   ['strne-2', qw(t != f)],
139   ['strne-3', qw(! != !), {EXIT=>1}],
140   ['strne-4', qw(= != =), {EXIT=>1}],
141   ['strne-5', "'(' != '('", {EXIT=>1}],
142   ['strne-6', "'(' != ')'"],
143
144   ['and-1', qw(t -a t)],
145   ['and-2', qw('' -a t), {EXIT=>1}],
146   ['and-3', qw(t -a ''), {EXIT=>1}],
147   ['and-4', qw('' -a ''), {EXIT=>1}],
148
149   ['or-1', qw(t -o t)],
150   ['or-2', qw('' -o t)],
151   ['or-3', qw(t -o '')],
152   ['or-4', qw('' -o ''), {EXIT=>1}],
153
154   ['eq-1', qw(9 -eq 9)],
155   ['eq-2', qw(0 -eq 0)],
156   ['eq-3', qw(0 -eq 00)],
157   ['eq-4', qw(8 -eq 9), {EXIT=>1}],
158   ['eq-5', qw(1 -eq 0), {EXIT=>1}],
159   ['eq-6', qw(340282366920938463463374607431768211456 -eq 0), {EXIT=>1}],
160
161   ['gt-1', qw(5 -gt 5), {EXIT=>1}],
162   ['gt-2', qw(5 -gt 4)],
163   ['gt-3', qw(4 -gt 5), {EXIT=>1}],
164   ['gt-4', qw(-1 -gt -2)],
165   ['gt-5', qw(18446744073709551616 -gt -18446744073709551616)],
166
167   ['lt-1', qw(5 -lt 5), {EXIT=>1}],
168   ['lt-2', qw(5 -lt 4), {EXIT=>1}],
169   ['lt-3', qw(4 -lt 5)],
170   ['lt-4', qw(-1 -lt -2), {EXIT=>1}],
171   ['lt-5', qw(-18446744073709551616 -lt 18446744073709551616)],
172
173   ['inv-1', qw(0x0 -eq 00), {EXIT=>2},
174    {ERR=>"$prog: invalid integer `0x0'\n"}],
175
176   ['t1', "-t"],
177   ['t2', qw(-t 1), {EXIT=>1}],
178
179   ['paren-1', "'(' '' ')'", {EXIT=>1}],
180   ['paren-2', "'(' '(' ')'"],
181   ['paren-3', "'(' ')' ')'"],
182   ['paren-4', "'(' ! ')'"],
183   ['paren-5', "'(' -a ')'"],
184 );
185
186 @Tests = add_inverse_op_tests \@Tests;
187 @Tests = add_pn_tests \@Tests;
188
189 my $save_temps = $ENV{DEBUG};
190 my $verbose = $ENV{VERBOSE};
191
192 my $fail = run_tests ($prog, \$prog, \@Tests, $save_temps, $verbose);
193 exit $fail;