tests/csplit/csplit-suppress-matched.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright (C) 2013-2024 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 <https://www.gnu.org/licenses/>.
  17
  18 use strict;
  19
  20 my $limits = getlimits ();
  21
  22 my $prog = 'csplit';
  23
  24 # Turn off localization of executable's output.
  25 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  26
  27 # Input from 'seq 6'
  28 my $IN_SEQ_6 =<<EOF;
  29 1
  30 2
  31 3
  32 4
  33 5
  34 6
  35 EOF
  36
  37 # Input from a possible run of 'uniq --group'
  38 # (groups separated by empty lines)
  39 my $IN_UNIQ =<<EOF;
  40 a
  41 a
  42 YY
  43
  44 XX
  45 b
  46 b
  47 YY
  48
  49 XX
  50 c
  51 YY
  52
  53 XX
  54 d
  55 d
  56 d
  57 EOF
  58
  59 # Standard Coreutils::run_tests() structure, except the addition of
  60 # "OUTPUTS" array, containing the expected content of the output files.
  61 # See code below for conversion into PRE/CMP/POST checks.
  62 my @csplit_tests =
  63 (
  64   # without --suppress-matched,
  65   # the newline (matched line) appears in the output files
  66   ["re-base", "-q - '/^\$/' '{*}'", {IN_PIPE => $IN_UNIQ},
  67     {OUTPUTS => [ "a\na\nYY\n", "\nXX\nb\nb\nYY\n","\nXX\nc\nYY\n",
  68                   "\nXX\nd\nd\nd\n" ] }],
  69
  70   # the newline (matched line) does not appear in the output files
  71   ["re-1", " --suppress-matched -q - '/^\$/' '{*}'", {IN_PIPE => $IN_UNIQ},
  72     {OUTPUTS => ["a\na\nYY\n", "XX\nb\nb\nYY\n", "XX\nc\nYY\n",
  73                  "XX\nd\nd\nd\n"]}],
  74
  75   # the 'XX' (matched line + offset 1) does not appear in the output files.
  76   # the newline appears in the files (before each split, at the end of the file)
  77   ["re-2", "--suppress-matched -q - '/^\$/1' '{*}'", {IN_PIPE => $IN_UNIQ},
  78     {OUTPUTS => ["a\na\nYY\n\n","b\nb\nYY\n\n","c\nYY\n\n","d\nd\nd\n"]}],
  79
  80   # the 'YY' (matched line + offset of -1) does not appear in the output files
  81   # the newline appears in the files (as the first line of the new split)
  82   ["re-3", " --suppress-matched -q - '/^\$/-1' '{*}'", {IN_PIPE => $IN_UNIQ},
  83     {OUTPUTS => ["a\na\n", "\nXX\nb\nb\n", "\nXX\nc\n", "\nXX\nd\nd\nd\n"]}],
  84
  85   # the last matched line for a non infinite match repetition is suppressed.
  86   # Up to and including coreutils 8.32, the last match was output.
  87   ["re-4", " --suppress-matched -q - '/^\$/' '{2}'", {IN_PIPE => $IN_UNIQ},
  88     {OUTPUTS => ["a\na\nYY\n", "XX\nb\nb\nYY\n", "XX\nc\nYY\n",
  89                  "XX\nd\nd\nd\n"]}],
  90
  91   # Test two consecutive matched lines
  92   # without suppress-matched, the second file should contain a single newline.
  93   ["re-4.1", "-q - '/^\$/' '{*}'", {IN_PIPE => "a\n\n\nb\n"},
  94     {OUTPUTS => [ "a\n", "\n", "\nb\n" ]}],
  95   # suppress-matched will cause the second file to be empty.
  96   ["re-4.2", "--suppress-match -q - '/^\$/' '{*}'", {IN_PIPE => "a\n\n\nb\n"},
  97     {OUTPUTS => [ "a\n", "", "b\n" ]}],
  98   # suppress-matched + elide-empty should output just two files.
  99   ["re-4.3", "--suppress-match -zq - '/^\$/' '{*}'", {IN_PIPE => "a\n\n\nb\n"},
 100     {OUTPUTS => [ "a\n", "b\n" ]}],
 101
 102
 103   # Test a matched-line as the last line
 104   # default: last file with newline should be created.
 105   ["re-5.1", "-q - '/^\$/' '{*}'", {IN_PIPE => "a\n\nb\n\n"},
 106     {OUTPUTS => [ "a\n", "\nb\n", "\n" ]}],
 107   # suppress-matched - last empty files should be created.
 108   ["re-5.2", "--suppress-match -q - '/^\$/' '{*}'", {IN_PIPE => "a\n\nb\n\n"},
 109     {OUTPUTS => [ "a\n", "b\n", "" ]}],
 110   # suppress-matched + elide-empty: just two files should be created.
 111   ["re-5.3", "--suppress-match -zq - '/^\$/' '{*}'", {IN_PIPE => "a\n\nb\n\n"},
 112     {OUTPUTS => [ "a\n", "b\n" ]}],
 113
 114   # without suppress-matched,
 115   # the matched lines (2/4/6) appears in the output files
 116   ["int-base",    '-q - 2 4 6', {IN_PIPE => $IN_SEQ_6},
 117     {OUTPUTS => [ "1\n", "2\n3\n", "4\n5\n", "6\n" ]}],
 118   # suppress matched - the matching lines (2/4/6) should not appear.
 119   ["int-1", '--suppress-matched -q - 2 4 6', {IN_PIPE => $IN_SEQ_6},
 120     {OUTPUTS => [ "1\n", "3\n", "5\n", "" ]}],
 121   # suppress matched + elide-empty
 122   ["int-2", '--suppress-matched -zq - 2 4 6', {IN_PIPE => $IN_SEQ_6},
 123     {OUTPUTS => [ "1\n", "3\n", "5\n" ]}],
 124 );
 125
 126
 127
 128 =pod
 129 The following loop translate the above @Tests to a Coreutils::run_tests()
 130 compatible structure. It converts "OUTPUTS" key into "CMP" + "POST" keys:
 131 1. Each element in the OUTPUTS key is expected to be an output file
 132    from csplit (named xx00, xx01, xx02...)
 133    create a "CMP" key for each one, with the output and the filename.
 134 2. Add a "POST" key, ensuring no extra files have been created.
 135    (e.g. if there are 4 expected outputs, xx00 to xx03,
 136     ensure xx04 doesn't exist).
 137 3. Add a "PRE" key, deleting all existing 'xx*' files.
 138
 139 Example:
 140
 141 Before conversion:
 142    my @csplit_tests =
 143    (
 144      ["1", '-z -q - 2 4 6',
 145        {IN_PIPE => "1\n2\n3\n4\n5\n6\n"},
 146        {OUTPUTS => [ "1\n", "2\n3\n", "4\n5\n", "6\n" ],
 147      ]
 148    )
 149
 150 After conversion:
 151
 152    my @csplit_tests =
 153    (
 154      ["1", '-z -q - 2 4 6',
 155        {IN_PIPE => "1\n2\n3\n4\n5\n6\n"},
 156        {PRE => sub { unlink glob './xx??' ; }},
 157        {CMP => ["1\n",    {'xx00'=> undef}]},
 158        {CMP => ["2\n3\n", {'xx01'=> undef}]},
 159        {CMP => ["4\n5\n", {'xx02'=> undef}]},
 160        {CMP => ["6\n",    {'xx03'=> undef}]},
 161        {POST => sub { die "extra file" if -e 'xx04'}},
 162      ],
 163     );
 164 =cut
 165 my @Tests;
 166 foreach my $t (@csplit_tests)
 167   {
 168     my ($test_name, $cmdline, @others) = @$t;
 169     my $new_ent = [$test_name, $cmdline];
 170
 171     my $out_file_num = 0 ;
 172
 173     foreach my $e (@others)
 174       {
 175         die "Internal error: expecting a hash (e.g. IN_PIPE/OUTPUTS/ERR)" .
 176             "in test '$test_name', got $e"
 177             unless ref $e && (ref $e eq 'HASH');
 178
 179         my ($key, $value) = each %$e;
 180         if ($key eq 'OUTPUTS')
 181           {
 182             # Convert each expected OUTPUT to a 'CMP' key.
 183             foreach my $output (@$value)
 184               {
 185                 my $filename = sprintf("xx%02d",$out_file_num++);
 186                 my $cmp = {CMP => [ $output, { $filename => undef}]};
 187                 push @$new_ent, $cmp;
 188               }
 189
 190             # Add a 'POST' check
 191             # Ensure no extra files have been created.
 192             my $filename = sprintf("xx%02d",$out_file_num++);
 193             my $post = { POST => sub { die "Test failed: an extraneous file " .
 194                                 "'$filename' has been created\n"
 195                                 if -e $filename; } } ;
 196             push @$new_ent, $post;
 197
 198             # before running each test, cleanup the 'xx00' files
 199             # from previous runs.
 200             my $pre = { PRE => sub { unlink glob "./xx??"; } };
 201             push @$new_ent, $pre;
 202           }
 203         else
 204           {
 205             # pass other entities as-is (e.g. OUT, ERR, OUT_SUBST, EXIT)
 206             # run_tests() will know how to handle them.
 207             push @$new_ent, $e;
 208           }
 209       }
 210
 211     push @Tests, $new_ent;
 212   }
 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;