tests/misc/uniq

   1 #!/usr/bin/perl
   2 # Test uniq.
   3
   4 # Copyright (C) 2008-2009 Free Software Foundation, Inc.
   5
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 use strict;
  20
  21 my $limits = getlimits ();
  22
  23 my $prog = 'uniq';
  24 my $try = "Try \`$prog --help' for more information.\n";
  25
  26 # Turn off localization of executable's output.
  27 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  28
  29 # When possible, create a "-z"-testing variant of each test.
  30 sub add_z_variants($)
  31 {
  32   my ($tests) = @_;
  33   my @new;
  34  TEST:
  35   foreach my $t (@$tests)
  36     {
  37       push @new, $t;
  38
  39       # skip the obsolete-syntax tests
  40       $t->[0] =~ /^obs-plus/
  41         and next;
  42
  43       my @args;
  44       my @list_of_hash;
  45
  46       foreach my $e (@$t)
  47         {
  48           !ref $e
  49             and push (@args, $e), next;
  50
  51           ref $e && ref $e eq 'HASH'
  52             or (warn "$0: $t->[0]: unexpected entry type\n"), next;
  53           my $tmp = $e;
  54           foreach my $k (qw(IN OUT))
  55             {
  56               my $val = $e->{$k};
  57               # skip any test whose input or output already contains a NUL byte
  58               if (defined $val)
  59                 {
  60                   $val =~ /\0/
  61                     and next TEST;
  62
  63                   # Convert each NL in input or output to \0.
  64                   $val =~ s/\n/\0/g;
  65                   $tmp = {$k => $val};
  66                   last;
  67                 }
  68             }
  69           push @list_of_hash, $tmp;
  70         }
  71
  72       shift @args; # discard test name
  73
  74       # skip any test that uses the -z option
  75       grep /z/, @args
  76         and next;
  77
  78       push @new, ["$t->[0]-z", '-z', @args, @list_of_hash];
  79     }
  80   return @new;
  81 }
  82
  83 # I've only ever triggered the problem in a non-C locale.
  84 my $locale = $ENV{LOCALE_FR};
  85 if (! defined $locale || $locale eq 'none')
  86   {
  87     warn "$prog: skipping this test -- no appropriate locale\n";
  88     exit 77;
  89   }
  90
  91 # See if isblank returns true for nbsp.
  92 my $x = `env printf '\xa0'| LC_ALL=$locale tr '[:blank:]' x`;
  93 # If so, expect just one line of output in the schar test.
  94 # Otherwise, expect two.
  95 my $in = " y z\n\xa0 y z\n";
  96 my $schar_exp = $x eq 'x' ? " y z\n" : $in;
  97
  98 my @Tests =
  99 (
 100   # Test for a subtle, system-and-locale-dependent bug in uniq.
 101  ['schar', '-f1',  {IN => $in}, {OUT => $schar_exp},
 102   {ENV => "LC_ALL=$locale"}],
 103  ['1', '', {IN=>''}, {OUT=>''}],
 104  ['2', '', {IN=>"a\na\n"}, {OUT=>"a\n"}],
 105  ['3', '', {IN=>"a\na"}, {OUT=>"a\n"}],
 106  ['4', '', {IN=>"a\nb"}, {OUT=>"a\nb\n"}],
 107  ['5', '', {IN=>"a\na\nb"}, {OUT=>"a\nb\n"}],
 108  ['6', '', {IN=>"b\na\na\n"}, {OUT=>"b\na\n"}],
 109  ['7', '', {IN=>"a\nb\nc\n"}, {OUT=>"a\nb\nc\n"}],
 110
 111  # Ensure that newlines are not interpreted with -z.
 112  ['2z', '-z', {IN=>"a\na\n"}, {OUT=>"a\na\n\0"}],
 113  ['3z', '-z', {IN=>"a\na"}, {OUT=>"a\na\0"}],
 114  ['4z', '-z', {IN=>"a\nb"}, {OUT=>"a\nb\0"}],
 115  ['5z', '-z', {IN=>"a\na\nb"}, {OUT=>"a\na\nb\0"}],
 116  ['20z', '-dz', {IN=>"a\na\n"}, {OUT=>""}],
 117
 118  # Make sure that eight bit characters work
 119  ['8', '', {IN=>"ö\nv\n"}, {OUT=>"ö\nv\n"}],
 120  # Test output of -u option; only unique lines
 121  ['9', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 122  ['10', '-u', {IN=>"a\nb\n"}, {OUT=>"a\nb\n"}],
 123  ['11', '-u', {IN=>"a\nb\na\n"}, {OUT=>"a\nb\na\n"}],
 124  ['12', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 125  ['13', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 126  #['5',  '-u',  "a\na\n",          "",                0],
 127  # Test output of -d option; only repeated lines
 128  ['20', '-d', {IN=>"a\na\n"}, {OUT=>"a\n"}],
 129  ['21', '-d', {IN=>"a\nb\n"}, {OUT=>""}],
 130  ['22', '-d', {IN=>"a\nb\na\n"}, {OUT=>""}],
 131  ['23', '-d', {IN=>"a\na\nb\n"}, {OUT=>"a\n"}],
 132  # Check the key options
 133  # If we skip over fields or characters, is the output deterministic?
 134  ['obs30', '-1', {IN=>"a a\nb a\n"}, {OUT=>"a a\n"}],
 135  ['31', qw(-f 1), {IN=>"a a\nb a\n"}, {OUT=>"a a\n"}],
 136  ['32', qw(-f 1), {IN=>"a a\nb b\n"}, {OUT=>"a a\nb b\n"}],
 137  ['33', qw(-f 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\nb a c\n"}],
 138  ['34', qw(-f 1), {IN=>"b a\na a\n"}, {OUT=>"b a\n"}],
 139  ['35', qw(-f 2), {IN=>"a a c\nb a c\n"}, {OUT=>"a a c\n"}],
 140  # Skip over characters.
 141  ['obs-plus40', '+1', {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 142  ['obs-plus41', '+1', {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 143  ['42', qw(-s 1), {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 144  ['43', qw(-s 2), {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 145  ['obs-plus44', qw(+1 --), {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 146  ['obs-plus45', qw(+1 --), {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 147  # Skip over fields and characters
 148  ['50', qw(-f 1 -s 1), {IN=>"a aaa\nb ab\n"}, {OUT=>"a aaa\nb ab\n"}],
 149  ['51', qw(-f 1 -s 1), {IN=>"a aaa\nb aaa\n"}, {OUT=>"a aaa\n"}],
 150  ['52', qw(-s 1 -f 1), {IN=>"a aaa\nb ab\n"}, {OUT=>"a aaa\nb ab\n"}],
 151  ['53', qw(-s 1 -f 1), {IN=>"a aaa\nb aaa\n"}, {OUT=>"a aaa\n"}],
 152  # Fixed in 2.0.15
 153  ['54', qw(-s 4), {IN=>"abc\nabcd\n"}, {OUT=>"abc\n"}],
 154  # Supported in 2.0.15
 155  ['55', qw(-s 0), {IN=>"abc\nabcd\n"}, {OUT=>"abc\nabcd\n"}],
 156  ['56', qw(-s 0), {IN=>"abc\n"}, {OUT=>"abc\n"}],
 157  ['57', qw(-w 0), {IN=>"abc\nabcd\n"}, {OUT=>"abc\n"}],
 158  # Only account for a number of characters
 159  ['60', qw(-w 1), {IN=>"a a\nb a\n"}, {OUT=>"a a\nb a\n"}],
 160  ['61', qw(-w 3), {IN=>"a a\nb a\n"}, {OUT=>"a a\nb a\n"}],
 161  ['62', qw(-w 1 -f 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 162  ['63', qw(-f 1 -w 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 163  # The blank after field one is checked too
 164  ['64', qw(-f 1 -w 4), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\nb a c\n"}],
 165  ['65', qw(-f 1 -w 3), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 166  # Make sure we don't break if the file contains \0
 167  ['90', '', {IN=>"a\0a\na\n"}, {OUT=>"a\0a\na\n"}],
 168  # Check fields seperated by tabs and by spaces
 169  ['91', '', {IN=>"a\ta\na a\n"}, {OUT=>"a\ta\na a\n"}],
 170  ['92', qw(-f 1), {IN=>"a\ta\na a\n"}, {OUT=>"a\ta\na a\n"}],
 171  ['93', qw(-f 2), {IN=>"a\ta a\na a a\n"}, {OUT=>"a\ta a\n"}],
 172  ['94', qw(-f 1), {IN=>"a\ta\na\ta\n"}, {OUT=>"a\ta\n"}],
 173  # Check the count option; add tests for other options too
 174  ['101', '-c', {IN=>"a\nb\n"}, {OUT=>"      1 a\n      1 b\n"}],
 175  ['102', '-c', {IN=>"a\na\n"}, {OUT=>"      2 a\n"}],
 176  # Check the local -D (--all-repeated) option
 177  ['110', '-D', {IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 178  ['111', qw(-D -w1), {IN=>"a a\na b\n"}, {OUT=>"a a\na b\n"}],
 179  ['112', qw(-D -c), {IN=>"a a\na b\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>
 180   "$prog: printing all duplicated lines and repeat counts is meaningless\n$try"}
 181   ],
 182  ['113', '--all-repeated=separate', {IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 183  ['114', '--all-repeated=separate', {IN=>"a\na\nb\nc\nc\n"}, {OUT=>"a\na\n\nc\nc\n"}],
 184  ['115', '--all-repeated=separate', {IN=>"a\na\nb\nb\nc\n"}, {OUT=>"a\na\n\nb\nb\n"}],
 185  ['116', '--all-repeated=prepend', {IN=>"a\na\n"}, {OUT=>"\na\na\n"}],
 186  ['117', '--all-repeated=prepend', {IN=>"a\na\nb\nc\nc\n"}, {OUT=>"\na\na\n\nc\nc\n"}],
 187  ['118', '--all-repeated=prepend', {IN=>"a\nb\n"}, {OUT=>""}],
 188  ['119', '--all-repeated=badoption', {IN=>"a\n"}, {OUT=>""}, {EXIT=>1},
 189   {ERR=>"$prog: invalid argument \`badoption' for \`--all-repeated'\n"
 190         . "Valid arguments are:\n"
 191         . "  - \`none'\n"
 192         . "  - \`prepend'\n"
 193         . "  - \`separate'\n"
 194         . $try}],
 195  # Check that -d and -u suppress all output, as POSIX requires.
 196  ['120', qw(-d -u), {IN=>"a\na\n\b"}, {OUT=>""}],
 197  ['121', "-d -u -w$limits->{'UINTMAX_OFLOW'}", {IN=>"a\na\n\b"}, {OUT=>""}],
 198  ['122', "-d -u -w$limits->{'SIZE_OFLOW'}", {IN=>"a\na\n\b"}, {OUT=>""}],
 199  # Check that --zero-terminated is synonymous with -z.
 200  ['123', '--zero-terminated', {IN=>"a\na\nb"}, {OUT=>"a\na\nb\0"}],
 201  ['124', '--zero-terminated', {IN=>"a\0a\0b"}, {OUT=>"a\0b\0"}],
 202 );
 203
 204 # Set _POSIX2_VERSION=199209 in the environment of each obs-plus* test.
 205 foreach my $t (@Tests)
 206   {
 207     $t->[0] =~ /^obs-plus/
 208       and push @$t, {ENV=>'_POSIX2_VERSION=199209'};
 209   }
 210
 211 @Tests = add_z_variants \@Tests;
 212 @Tests = triple_test \@Tests;
 213
 214 my $save_temps = $ENV{DEBUG};
 215 my $verbose = $ENV{VERBOSE};
 216
 217 my $fail = run_tests ($prog, $prog, \@Tests, $save_temps, $verbose);
 218 exit $fail;