tests/uniq/uniq.pl

   1 #!/usr/bin/perl
   2 # Test uniq.
   3
   4 # Copyright (C) 2008-2024 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 <https://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 my $mb_locale;
  30 #Comment out next line to disable multibyte tests
  31 $mb_locale = $ENV{LOCALE_FR_UTF8};
  32 ! defined $mb_locale || $mb_locale eq 'none'
  33   and $mb_locale = 'C';
  34
  35 # When possible, create a "-z"-testing variant of each test.
  36 sub add_z_variants($)
  37 {
  38   my ($tests) = @_;
  39   my @new;
  40  TEST:
  41   foreach my $t (@$tests)
  42     {
  43       push @new, $t;
  44
  45       # skip the obsolete-syntax tests
  46       $t->[0] =~ /^obs-plus/
  47         and next;
  48
  49       my @args;
  50       my @list_of_hash;
  51
  52       foreach my $e (@$t)
  53         {
  54           !ref $e
  55             and push (@args, $e), next;
  56
  57           ref $e && ref $e eq 'HASH'
  58             or (warn "$0: $t->[0]: unexpected entry type\n"), next;
  59           my $tmp = $e;
  60           foreach my $k (qw(IN OUT))
  61             {
  62               my $val = $e->{$k};
  63               # skip any test whose input or output already contains a NUL byte
  64               if (defined $val)
  65                 {
  66                   $val =~ /\0/
  67                     and next TEST;
  68
  69                   # Convert each NL in input or output to \0.
  70                   $val =~ s/\n/\0/g;
  71                   $tmp = {$k => $val};
  72                   last;
  73                 }
  74             }
  75           push @list_of_hash, $tmp;
  76         }
  77
  78       shift @args; # discard test name
  79
  80       # skip any test that uses the -z option
  81       grep /z/, @args
  82         and next;
  83
  84       push @new, ["$t->[0]-z", '-z', @args, @list_of_hash];
  85     }
  86   return @new;
  87 }
  88
  89 my @Tests =
  90 (
  91  ['1', '', {IN=>''}, {OUT=>''}],
  92  ['2', '', {IN=>"a\na\n"}, {OUT=>"a\n"}],
  93  ['3', '', {IN=>"a\na"}, {OUT=>"a\n"}],
  94  ['4', '', {IN=>"a\nb"}, {OUT=>"a\nb\n"}],
  95  ['5', '', {IN=>"a\na\nb"}, {OUT=>"a\nb\n"}],
  96  ['6', '', {IN=>"b\na\na\n"}, {OUT=>"b\na\n"}],
  97  ['7', '', {IN=>"a\nb\nc\n"}, {OUT=>"a\nb\nc\n"}],
  98
  99  # Ensure that newlines are not interpreted with -z.
 100  ['2z', '-z', {IN=>"a\na\n"}, {OUT=>"a\na\n\0"}],
 101  ['3z', '-z', {IN=>"a\na"}, {OUT=>"a\na\0"}],
 102  ['4z', '-z', {IN=>"a\nb"}, {OUT=>"a\nb\0"}],
 103  ['5z', '-z', {IN=>"a\na\nb"}, {OUT=>"a\na\nb\0"}],
 104  ['10z', '-z -f1', {IN=>"a\nb\n\0c\nb\n\0"}, {OUT=>"a\nb\n\0"}],
 105  ['20z', '-dz', {IN=>"a\na\n"}, {OUT=>""}],
 106
 107  # Make sure that eight bit characters work
 108  ['8', '', {IN=>"ö\nv\n"}, {OUT=>"ö\nv\n"}],
 109  # Test output of -u option; only unique lines
 110  ['9', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 111  ['10', '-u', {IN=>"a\nb\n"}, {OUT=>"a\nb\n"}],
 112  ['11', '-u', {IN=>"a\nb\na\n"}, {OUT=>"a\nb\na\n"}],
 113  ['12', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 114  ['13', '-u', {IN=>"a\na\n"}, {OUT=>""}],
 115  #['5',  '-u',  "a\na\n",          "",                0],
 116  # Test output of -d option; only repeated lines
 117  ['20', '-d', {IN=>"a\na\n"}, {OUT=>"a\n"}],
 118  ['21', '-d', {IN=>"a\nb\n"}, {OUT=>""}],
 119  ['22', '-d', {IN=>"a\nb\na\n"}, {OUT=>""}],
 120  ['23', '-d', {IN=>"a\na\nb\n"}, {OUT=>"a\n"}],
 121  # Check the key options
 122  # If we skip over fields or characters, is the output deterministic?
 123  ['obs30', '-1', {IN=>"a a\nb a\n"}, {OUT=>"a a\n"}],
 124  ['31', qw(-f 1), {IN=>"a a\nb a\n"}, {OUT=>"a a\n"}],
 125  ['32', qw(-f 1), {IN=>"a a\nb b\n"}, {OUT=>"a a\nb b\n"}],
 126  ['33', qw(-f 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\nb a c\n"}],
 127  ['34', qw(-f 1), {IN=>"b a\na a\n"}, {OUT=>"b a\n"}],
 128  ['35', qw(-f 2), {IN=>"a a c\nb a c\n"}, {OUT=>"a a c\n"}],
 129  # Skip over characters.
 130  ['obs-plus40', '+1', {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 131  ['obs-plus41', '+1', {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 132  ['42', qw(-s 1), {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 133  ['43', qw(-s 2), {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 134  ['obs-plus44', qw(+1 --), {IN=>"aaa\naaa\n"}, {OUT=>"aaa\n"}],
 135  ['obs-plus45', qw(+1 --), {IN=>"baa\naaa\n"}, {OUT=>"baa\n"}],
 136  # Skip over fields and characters
 137  ['50', qw(-f 1 -s 1), {IN=>"a aaa\nb ab\n"}, {OUT=>"a aaa\nb ab\n"}],
 138  ['51', qw(-f 1 -s 1), {IN=>"a aaa\nb aaa\n"}, {OUT=>"a aaa\n"}],
 139  ['52', qw(-s 1 -f 1), {IN=>"a aaa\nb ab\n"}, {OUT=>"a aaa\nb ab\n"}],
 140  ['53', qw(-s 1 -f 1), {IN=>"a aaa\nb aaa\n"}, {OUT=>"a aaa\n"}],
 141  # Fixed in 2.0.15
 142  ['54', qw(-s 4), {IN=>"abc\nabcd\n"}, {OUT=>"abc\n"}],
 143  # Supported in 2.0.15
 144  ['55', qw(-s 0), {IN=>"abc\nabcd\n"}, {OUT=>"abc\nabcd\n"}],
 145  ['56', qw(-s 0), {IN=>"abc\n"}, {OUT=>"abc\n"}],
 146  ['57', qw(-w 0), {IN=>"abc\nabcd\n"}, {OUT=>"abc\n"}],
 147  # Only account for a number of characters
 148  ['60', qw(-w 1), {IN=>"a a\nb a\n"}, {OUT=>"a a\nb a\n"}],
 149  ['61', qw(-w 3), {IN=>"a a\nb a\n"}, {OUT=>"a a\nb a\n"}],
 150  ['62', qw(-w 1 -f 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 151  ['63', qw(-f 1 -w 1), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 152  # The blank after field one is checked too
 153  ['64', qw(-f 1 -w 4), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\nb a c\n"}],
 154  ['65', qw(-f 1 -w 3), {IN=>"a a a\nb a c\n"}, {OUT=>"a a a\n"}],
 155  # Make sure we don't break if the file contains \0
 156  ['90', '', {IN=>"a\0a\na\n"}, {OUT=>"a\0a\na\n"}],
 157  # Check fields separated by tabs and by spaces
 158  ['91', '', {IN=>"a\ta\na a\n"}, {OUT=>"a\ta\na a\n"}],
 159  ['92', qw(-f 1), {IN=>"a\ta\na a\n"}, {OUT=>"a\ta\na a\n"}],
 160  ['93', qw(-f 2), {IN=>"a\ta a\na a a\n"}, {OUT=>"a\ta a\n"}],
 161  ['94', qw(-f 1), {IN=>"a\ta\na\ta\n"}, {OUT=>"a\ta\n"}],
 162  # Check the count option; add tests for other options too
 163  ['101', '-c', {IN=>"a\nb\n"}, {OUT=>"      1 a\n      1 b\n"}],
 164  ['102', '-c', {IN=>"a\na\n"}, {OUT=>"      2 a\n"}],
 165  # Check the local -D (--all-repeated) option
 166  ['110', '-D', {IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 167  ['111', qw(-D -w1), {IN=>"a a\na b\n"}, {OUT=>"a a\na b\n"}],
 168  ['112', qw(-D -c), {IN=>"a a\na b\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>
 169   "$prog: printing all duplicated lines and repeat counts is meaningless\n$try"}
 170   ],
 171  ['113', '--all-repeated=separate', {IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 172  ['114', '--all-repeated=separate',
 173   {IN=>"a\na\nb\nc\nc\n"}, {OUT=>"a\na\n\nc\nc\n"}],
 174  ['115', '--all-repeated=separate',
 175   {IN=>"a\na\nb\nb\nc\n"}, {OUT=>"a\na\n\nb\nb\n"}],
 176  ['116', '--all-repeated=prepend', {IN=>"a\na\n"}, {OUT=>"\na\na\n"}],
 177  ['117', '--all-repeated=prepend',
 178   {IN=>"a\na\nb\nc\nc\n"}, {OUT=>"\na\na\n\nc\nc\n"}],
 179  ['118', '--all-repeated=prepend', {IN=>"a\nb\n"}, {OUT=>""}],
 180  ['119', '--all-repeated=badoption', {IN=>"a\n"}, {OUT=>""}, {EXIT=>1},
 181   {ERR=>"$prog: invalid argument 'badoption' for '--all-repeated'\n"
 182         . "Valid arguments are:\n"
 183         . "  - 'none'\n"
 184         . "  - 'prepend'\n"
 185         . "  - 'separate'\n"
 186         . $try}],
 187  # Check that -d and -u suppress all output, as POSIX requires.
 188  ['120', qw(-d -u), {IN=>"a\na\n\b"}, {OUT=>""}],
 189  ['121', "-d -u -w$limits->{UINTMAX_OFLOW}", {IN=>"a\na\n\b"}, {OUT=>""}],
 190  ['122', "-d -u -w$limits->{SIZE_OFLOW}", {IN=>"a\na\n\b"}, {OUT=>""}],
 191  # Check that --zero-terminated is synonymous with -z.
 192  ['123', '--zero-terminated', {IN=>"a\na\nb"}, {OUT=>"a\na\nb\0"}],
 193  ['124', '--zero-terminated', {IN=>"a\0a\0b"}, {OUT=>"a\0b\0"}],
 194  # Check ignore-case
 195  ['125', '',              {IN=>"A\na\n"}, {OUT=>"A\na\n"}],
 196  ['126', '-i',            {IN=>"A\na\n"}, {OUT=>"A\n"}],
 197  ['127', '--ignore-case', {IN=>"A\na\n"}, {OUT=>"A\n"}],
 198  # Check grouping
 199  ['128', '--group=prepend', {IN=>"a\na\nb\n"}, {OUT=>"\na\na\n\nb\n"}],
 200  ['129', '--group=append',  {IN=>"a\na\nb\n"}, {OUT=>"a\na\n\nb\n\n"}],
 201  ['130', '--group=separate',{IN=>"a\na\nb\n"}, {OUT=>"a\na\n\nb\n"}],
 202  # no explicit grouping = separate
 203  ['131', '--group',         {IN=>"a\na\nb\n"}, {OUT=>"a\na\n\nb\n"}],
 204  ['132', '--group=both',    {IN=>"a\na\nb\n"}, {OUT=>"\na\na\n\nb\n\n"}],
 205  # Grouping in the special case of a single group
 206  ['133', '--group=prepend', {IN=>"a\na\n"}, {OUT=>"\na\na\n"}],
 207  ['134', '--group=append',  {IN=>"a\na\n"}, {OUT=>"a\na\n\n"}],
 208  ['135', '--group=separate',{IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 209  ['136', '--group',         {IN=>"a\na\n"}, {OUT=>"a\na\n"}],
 210  # Grouping with empty input - should never print anything
 211  ['137', '--group=prepend',  {IN=>""}, {OUT=>""}],
 212  ['138', '--group=append',   {IN=>""}, {OUT=>""}],
 213  ['139', '--group=separate', {IN=>""}, {OUT=>""}],
 214  ['140', '--group=both',     {IN=>""}, {OUT=>""}],
 215  # Grouping with other options - must fail
 216  ['141', '--group -c',       {IN=>""}, {OUT=>""}, {EXIT=>1},
 217   {ERR=>"$prog: --group is mutually exclusive with -c/-d/-D/-u\n" .
 218         "Try 'uniq --help' for more information.\n"}],
 219  ['142', '--group -d',       {IN=>""}, {OUT=>""}, {EXIT=>1},
 220   {ERR=>"$prog: --group is mutually exclusive with -c/-d/-D/-u\n" .
 221         "Try 'uniq --help' for more information.\n"}],
 222  ['143', '--group -u',       {IN=>""}, {OUT=>""}, {EXIT=>1},
 223   {ERR=>"$prog: --group is mutually exclusive with -c/-d/-D/-u\n" .
 224         "Try 'uniq --help' for more information.\n"}],
 225  ['144', '--group -D',       {IN=>""}, {OUT=>""}, {EXIT=>1},
 226   {ERR=>"$prog: --group is mutually exclusive with -c/-d/-D/-u\n" .
 227         "Try 'uniq --help' for more information.\n"}],
 228  # Grouping with badoption
 229  ['145', '--group=badoption',{IN=>""}, {OUT=>""}, {EXIT=>1},
 230   {ERR=>"$prog: invalid argument 'badoption' for '--group'\n" .
 231         "Valid arguments are:\n" .
 232         "  - 'prepend'\n" .
 233         "  - 'append'\n" .
 234         "  - 'separate'\n" .
 235         "  - 'both'\n" .
 236         "Try '$prog --help' for more information.\n"}],
 237 );
 238
 239 # Locale related tests
 240
 241 my $locale = $ENV{LOCALE_FR};
 242 if ( defined $locale && $locale ne 'none' )
 243   {
 244     # I've only ever triggered the problem in a non-C locale.
 245
 246     # See if nbsp is considered a blank character
 247     my $x = qx!env printf 'x\xa0y'| LC_ALL=$locale join -a2 -o2.1 /dev/null -!;
 248     chomp $x;
 249     # If so, expect just one line of output in the schar test.
 250     # Otherwise, expect two.
 251     my $in = " y z\n\xa0 y z\n";
 252     my $schar_exp = $x eq 'x' ? " y z\n" : $in;
 253
 254     my @Locale_Tests =
 255     (
 256       # Test for a subtle, system-and-locale-dependent bug in uniq.
 257       ['schar', '-f1',  {IN => $in}, {OUT => $schar_exp},
 258         {ENV => "LC_ALL=$locale"}]
 259     );
 260
 261     push @Tests, @Locale_Tests;
 262   }
 263
 264
 265 # Set _POSIX2_VERSION=199209 in the environment of each obs-plus* test.
 266 foreach my $t (@Tests)
 267   {
 268     $t->[0] =~ /^obs-plus/
 269       and push @$t, {ENV=>'_POSIX2_VERSION=199209'};
 270   }
 271
 272 if ($mb_locale ne 'C')
 273   {
 274     # Duplicate each test vector, appending "-mb" to the test name and
 275     # inserting {ENV => "LC_ALL=$mb_locale"} in the copy, so that we
 276     # provide coverage for multi-byte code paths.
 277     my @new;
 278     foreach my $t (@Tests)
 279       {
 280         my @new_t = @$t;
 281         my $test_name = shift @new_t;
 282
 283         # In test #145, replace the each ‘...’ by '...'.
 284         if ($test_name =~ "145")
 285           {
 286             my $sub = { ERR_SUBST => "s/‘([^’]+)’/'\$1'/g"};
 287             push @new_t, $sub;
 288             push @$t, $sub;
 289           }
 290         next if (   $test_name =~ "schar"
 291                  or $test_name =~ "^obs-plus"
 292                  or $test_name =~ "119");
 293         push @new, ["$test_name-mb", @new_t, {ENV => "LC_ALL=$mb_locale"}];
 294       }
 295     push @Tests, @new;
 296
 297     # Test that -w counts characters, not bytes.
 298     my $trouble_with_w1 = "à\ná\n";
 299     my @Locale_Tests =
 300     (
 301       ['w1-mb', '-w1',  {IN => $trouble_with_w1}, {OUT => $trouble_with_w1},
 302         {ENV => "LC_ALL=$mb_locale"}]
 303     );
 304     push @Tests, @Locale_Tests;
 305    }
 306
 307 # Remember that triple_test creates from each test with exactly one "IN"
 308 # file two more tests (.p and .r suffix on name) corresponding to reading
 309 # input from a file and from a pipe.  The pipe-reading test would fail
 310 # due to a race condition about 1 in 20 times.
 311 # Remove the IN_PIPE version of the "output-is-input" test above.
 312 # The others aren't susceptible because they have three inputs each.
 313
 314 @Tests = grep {$_->[0] ne 'output-is-input.p'} @Tests;
 315
 316 @Tests = add_z_variants \@Tests;
 317 @Tests = triple_test \@Tests;
 318
 319 my $save_temps = $ENV{DEBUG};
 320 my $verbose = $ENV{VERBOSE};
 321
 322 my $fail = run_tests ($prog, $prog, \@Tests, $save_temps, $verbose);
 323 exit $fail;