tests/misc/cut.pl

   1 #!/usr/bin/perl
   2 # Test "cut".
   3
   4 # Copyright (C) 2006-2013 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 $ME = $0) =~ s|.*/||;
  22
  23 # Turn off localization of executable's output.
  24 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  25
  26 my $mb_locale = $ENV{LOCALE_FR_UTF8};
  27 ! defined $mb_locale || $mb_locale eq 'none'
  28   and $mb_locale = 'C';
  29
  30 my $prog = 'cut';
  31 my $try = "Try '$prog --help' for more information.\n";
  32 my $from_1 = "$prog: fields and positions are numbered from 1\n$try";
  33 my $inval = "$prog: invalid byte, character or field list\n$try";
  34 my $no_endpoint = "$prog: invalid range with no endpoint: -\n$try";
  35 my $nofield = "$prog: an input delimiter may be specified only when " .
  36               "operating on fields\n$try";
  37
  38 my @Tests =
  39  (
  40   # Provoke a double-free in cut from coreutils-6.7.
  41   ['dbl-free', '-f2-', {IN=>{f=>'x'}}, {IN=>{g=>'y'}}, {OUT=>"x\ny\n"}],
  42
  43   # This failed (as it should) even before coreutils-6.9.90,
  44   # but cut from 6.9.90 produces a more useful diagnostic.
  45   ['zero-1', '-b0',   {ERR=>$from_1}, {EXIT => 1} ],
  46
  47   # Up to coreutils-6.9, specifying a range of 0-2 was not an error.
  48   # It was treated just like "-2".
  49   ['zero-2', '-f0-2', {ERR=>$from_1}, {EXIT => 1} ],
  50
  51   # Up to coreutils-8.20, specifying a range of 0- was not an error.
  52   ['zero-3b', '-b0-', {ERR=>$from_1}, {EXIT => 1} ],
  53   ['zero-3c', '-c0-', {ERR=>$from_1}, {EXIT => 1} ],
  54   ['zero-3f', '-f0-', {ERR=>$from_1}, {EXIT => 1} ],
  55
  56   ['1', '-d:', '-f1,3-', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  57   ['2', '-d:', '-f1,3-', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  58   ['3', qw(-d: -f2-), {IN=>"a:b:c\n"}, {OUT=>"b:c\n"}],
  59   ['4', qw(-d: -f4), {IN=>"a:b:c\n"}, {OUT=>"\n"}],
  60   ['5', qw(-d: -f4), {IN=>""}, {OUT=>""}],
  61   ['6', '-c4', {IN=>"123\n"}, {OUT=>"\n"}],
  62   ['7', '-c4', {IN=>"123"}, {OUT=>"\n"}],
  63   ['8', '-c4', {IN=>"123\n1"}, {OUT=>"\n\n"}],
  64   ['9', '-c4', {IN=>""}, {OUT=>""}],
  65   ['a', qw(-s -d:), '-f3-', {IN=>"a:b:c\n"}, {OUT=>"c\n"}],
  66   ['b', qw(-s -d:), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b:c\n"}],
  67   ['c', qw(-s -d:), '-f1,3', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  68   # Trailing colon should not be output
  69   ['d', qw(-s -d:), '-f1,3', {IN=>"a:b:c:\n"}, {OUT=>"a:c\n"}],
  70   ['e', qw(-s -d:), '-f3-', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  71   ['f', qw(-s -d:), '-f3-4', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  72   ['g', qw(-s -d:), '-f3,4', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  73   # Make sure -s suppresses non-delimited lines
  74   ['h', qw(-s -d:), '-f2,3', {IN=>"abc\n"}, {OUT=>""}],
  75   #
  76   ['i', qw(-d: -f1-3), {IN=>":::\n"}, {OUT=>"::\n"}],
  77   ['j', qw(-d: -f1-4), {IN=>":::\n"}, {OUT=>":::\n"}],
  78   ['k', qw(-d: -f2-3), {IN=>":::\n"}, {OUT=>":\n"}],
  79   ['l', qw(-d: -f2-4), {IN=>":::\n"}, {OUT=>"::\n"}],
  80   ['m', qw(-s -d: -f1-3), {IN=>":::\n"}, {OUT=>"::\n"}],
  81   ['n', qw(-s -d: -f1-4), {IN=>":::\n"}, {OUT=>":::\n"}],
  82   ['o', qw(-s -d: -f2-3), {IN=>":::\n"}, {OUT=>":\n"}],
  83   ['p', qw(-s -d: -f2-4), {IN=>":::\n"}, {OUT=>"::\n"}],
  84   ['q', qw(-s -d: -f2-4), {IN=>":::\n:\n"}, {OUT=>"::\n\n"}],
  85   ['r', qw(-s -d: -f2-4), {IN=>":::\n:1\n"}, {OUT=>"::\n1\n"}],
  86   ['s', qw(-s -d: -f1-4), {IN=>":::\n:a\n"}, {OUT=>":::\n:a\n"}],
  87   ['t', qw(-s -d: -f3-), {IN=>":::\n:1\n"}, {OUT=>":\n\n"}],
  88   # Make sure it handles empty input properly, with and without -s.
  89   ['u', qw(-s -f3-), {IN=>""}, {OUT=>""}],
  90   ['v', '-f3-', {IN=>""}, {OUT=>""}],
  91   # Make sure it handles empty input properly.
  92   ['w', qw(-b 1), {IN=>""}, {OUT=>""}],
  93   ['x', qw(-s -d: -f2-4), {IN=>":\n"}, {OUT=>"\n"}],
  94   # Errors
  95   # -s may be used only with -f
  96   ['y', qw(-s -b4), {IN=>":\n"}, {OUT=>""}, {EXIT=>1},
  97    {ERR=>"$prog: suppressing non-delimited lines makes sense\n"
  98     . "\tonly when operating on fields\n$try"}],
  99   # You must specify bytes or fields (or chars)
 100   ['z', '', {IN=>":\n"}, {OUT=>""}, {EXIT=>1},
 101    {ERR=>"$prog: you must specify a list of bytes, characters, or fields\n$try"}
 102   ],
 103   # Empty field list
 104   ['empty-fl', qw(-f ''), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$from_1}],
 105   # Missing field list
 106   ['missing-fl', qw(-f --), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$inval}],
 107   # Empty byte list
 108   ['empty-bl', qw(-b ''), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$from_1}],
 109   # Missing byte list
 110   ['missing-bl', qw(-b --), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$inval}],
 111
 112   # This test fails with cut from textutils-1.22.
 113   ['empty-f1', '-f1', {IN=>""}, {OUT=>""}],
 114
 115   ['empty-f2', '-f2', {IN=>""}, {OUT=>""}],
 116
 117   ['o-delim', qw(-d: --out=_), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b_c\n"}],
 118   ['nul-idelim', qw(-d '' --out=_), '-f2,3', {IN=>"a\0b\0c\n"}, {OUT=>"b_c\n"}],
 119   ['nul-odelim', qw(-d: --out=), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b\0c\n"}],
 120   ['multichar-od', qw(-d: --out=_._), '-f2,3', {IN=>"a:b:c\n"},
 121    {OUT=>"b_._c\n"}],
 122
 123   # Ensure delim is not allowed without a field
 124   # Prior to 8.21, a NUL delim was allowed without a field
 125   ['delim-no-field1', qw(-d ''), '-b1', {EXIT=>1}, {ERR=>$nofield}],
 126   ['delim-no-field2', qw(-d:), '-b1', {EXIT=>1}, {ERR=>$nofield}],
 127
 128   # Prior to 1.22i, you couldn't use a delimiter that would sign-extend.
 129   ['8bit-delim', '-d', "\255", '--out=_', '-f2,3', {IN=>"a\255b\255c\n"},
 130    {OUT=>"b_c\n"}],
 131
 132   # newline processing for fields
 133   ['newline-1', '-f1-', {IN=>"a\nb"}, {OUT=>"a\nb\n"}],
 134   ['newline-2', '-f1-', {IN=>""}, {OUT=>""}],
 135   ['newline-3', '-d:', '-f1', {IN=>"a:1\nb:2\n"}, {OUT=>"a\nb\n"}],
 136   ['newline-4', '-d:', '-f1', {IN=>"a:1\nb:2"}, {OUT=>"a\nb\n"}],
 137   ['newline-5', '-d:', '-f2', {IN=>"a:1\nb:2\n"}, {OUT=>"1\n2\n"}],
 138   ['newline-6', '-d:', '-f2', {IN=>"a:1\nb:2"}, {OUT=>"1\n2\n"}],
 139   ['newline-7', '-s', '-d:', '-f1', {IN=>"a:1\nb:2"}, {OUT=>"a\nb\n"}],
 140   ['newline-8', '-s', '-d:', '-f1', {IN=>"a:1\nb:2\n"}, {OUT=>"a\nb\n"}],
 141   ['newline-9', '-s', '-d:', '-f1', {IN=>"a1\nb2"}, {OUT=>""}],
 142   ['newline-10', '-s', '-d:', '-f1,2', {IN=>"a:1\nb:2"}, {OUT=>"a:1\nb:2\n"}],
 143   ['newline-11', '-s', '-d:', '-f1,2', {IN=>"a:1\nb:2\n"}, {OUT=>"a:1\nb:2\n"}],
 144   ['newline-12', '-s', '-d:', '-f1', {IN=>"a:1\nb:"}, {OUT=>"a\nb\n"}],
 145   ['newline-13', '-d:', '-f1-', {IN=>"a1:\n:"}, {OUT=>"a1:\n:\n"}],
 146   # newline processing for fields when -d == '\n'
 147   ['newline-14', "-d'\n'", '-f1', {IN=>"a:1\nb:"}, {OUT=>"a:1\nb:\n"}],
 148   ['newline-15', '-s', "-d'\n'", '-f1', {IN=>"a:1\nb:"}, {OUT=>"a:1\n"}],
 149   ['newline-16', '-s', "-d'\n'", '-f2', {IN=>"\nb"}, {OUT=>""}],
 150   ['newline-17', '-s', "-d'\n'", '-f1', {IN=>"\nb"}, {OUT=>"\n"}],
 151   ['newline-18', "-d'\n'", '-f2', {IN=>"\nb"}, {OUT=>"\nb\n"}],
 152   ['newline-19', "-d'\n'", '-f1', {IN=>"\nb"}, {OUT=>"\nb\n"}],
 153   ['newline-20', '-s', "-d'\n'", '-f1-', {IN=>"\n"}, {OUT=>"\n"}],
 154   ['newline-21', '-s', "-d'\n'", '-f1-', {IN=>"\nb"}, {OUT=>"\n"}],
 155   ['newline-22', "-d'\n'", '-f1-', {IN=>"\nb"}, {OUT=>"\nb\n"}],
 156
 157   # New functionality:
 158   ['out-delim1', '-c1-3,5-', '--output-d=:', {IN=>"abcdefg\n"},
 159    {OUT=>"abc:efg\n"}],
 160   # A totally overlapped field shouldn't change anything:
 161   ['out-delim2', '-c1-3,2,5-', '--output-d=:', {IN=>"abcdefg\n"},
 162    {OUT=>"abc:efg\n"}],
 163   # Partial overlap: index '2' is not at the start of a range.
 164   ['out-delim3', '-c1-3,2-4,6', '--output-d=:', {IN=>"abcdefg\n"},
 165    {OUT=>"abcd:f\n"}],
 166   ['out-delim3a', '-c1-3,2-4,6-', '--output-d=:', {IN=>"abcdefg\n"},
 167    {OUT=>"abcd:fg\n"}],
 168   # Ensure that the following two commands produce the same output.
 169   # Before an off-by-1 fix, the output from the former would not contain a ':'.
 170   ['out-delim4', '-c4-,2-3', '--output-d=:',
 171    {IN=>"abcdefg\n"}, {OUT=>"bc:defg\n"}],
 172   ['out-delim5', '-c2-3,4-', '--output-d=:',
 173    {IN=>"abcdefg\n"}, {OUT=>"bc:defg\n"}],
 174   # This test would fail for cut from coreutils-5.0.1 and earlier.
 175   ['out-delim6', '-c2,1-3', '--output-d=:', {IN=>"abc\n"}, {OUT=>"abc\n"}],
 176   #
 177   ['od-abut', '-b1-2,3-4', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"ab:cd\n"}],
 178   ['od-overlap', '-b1-2,2', '--output-d=:', {IN=>"abc\n"}, {OUT=>"ab\n"}],
 179   ['od-overlap2', '-b1-2,2-', '--output-d=:', {IN=>"abc\n"}, {OUT=>"abc\n"}],
 180   ['od-overlap3', '-b1-3,2-', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"abcd\n"}],
 181   ['od-overlap4', '-b1-3,2-3', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"abc\n"}],
 182   ['od-overlap5', '-b1-3,1-4', '--output-d=:',
 183    {IN=>"abcde\n"}, {OUT=>"abcd\n"}],
 184
 185   # None of the following invalid ranges provoked an error up to coreutils-6.9.
 186   ['inval1', qw(-f 2-0), {IN=>''}, {OUT=>''}, {EXIT=>1},
 187    {ERR=>"$prog: invalid decreasing range\n$try"}],
 188   ['inval2', qw(-f -), {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
 189   ['inval3', '-f', '4,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
 190   ['inval4', '-f', '1-2,-', {IN=>''}, {OUT=>''}, {EXIT=>1},
 191    {ERR=>$no_endpoint}],
 192   ['inval5', '-f', '1-,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
 193   ['inval6', '-f', '-1,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
 194   # This would evoke a segfault from 5.3.0..8.10
 195   ['big-unbounded-b', '--output-d=:', '-b1234567890-', {IN=>''}, {OUT=>''}],
 196   ['big-unbounded-b2a', '--output-d=:', '-b1,9-',      {IN=>'123456789'},
 197     {OUT=>"1:9\n"}],
 198   ['big-unbounded-b2b', '--output-d=:', '-b1,1234567890-', {IN=>''}, {OUT=>''}],
 199   ['big-unbounded-c', '--output-d=:', '-c1234567890-', {IN=>''}, {OUT=>''}],
 200   ['big-unbounded-f', '--output-d=:', '-f1234567890-', {IN=>''}, {OUT=>''}],
 201
 202   ['overlapping-unbounded-1', '-b3-,2-', {IN=>"1234\n"}, {OUT=>"234\n"}],
 203   ['overlapping-unbounded-2', '-b2-,3-', {IN=>"1234\n"}, {OUT=>"234\n"}],
 204
 205   # When printing output delimiters, and with one or more ranges subsumed
 206   # by a to-EOL range, cut 8.20 and earlier would print extraneous delimiters.
 207   ['EOL-subsumed-1', '--output-d=: -b2-,3,4-4,5',
 208                                          {IN=>"123456\n"}, {OUT=>"23456\n"}],
 209   ['EOL-subsumed-2', '--output-d=: -b3,4-4,5,2-',
 210                                          {IN=>"123456\n"}, {OUT=>"23456\n"}],
 211   ['EOL-subsumed-3', '--complement -b3,4-4,5,2-',
 212                                          {IN=>"123456\n"}, {OUT=>"1\n"}],
 213  );
 214
 215 if ($mb_locale ne 'C')
 216   {
 217     # Duplicate each test vector, appending "-mb" to the test name and
 218     # inserting {ENV => "LC_ALL=$mb_locale"} in the copy, so that we
 219     # provide coverage for the distro-added multi-byte code paths.
 220     my @new;
 221     foreach my $t (@Tests)
 222       {
 223         my @new_t = @$t;
 224         my $test_name = shift @new_t;
 225
 226         push @new, ["$test_name-mb", @new_t, {ENV => "LC_ALL=$mb_locale"}];
 227       }
 228     push @Tests, @new;
 229   }
 230
 231
 232 @Tests = triple_test \@Tests;
 233
 234 my $save_temps = $ENV{DEBUG};
 235 my $verbose = $ENV{VERBOSE};
 236
 237 my $fail = run_tests ($ME, $prog, \@Tests, $save_temps, $verbose);
 238 exit $fail;