1#!/usr/bin/perl
2
3# Copyright (C) 2013-2023 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
18use strict;
19
20my $limits = getlimits ();
21
22my $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'
28my $IN_SEQ_6 =<<EOF;
291
302
313
324
335
346
35EOF
36
37# Input from a possible run of 'uniq --group'
38# (groups separated by empty lines)
39my $IN_UNIQ =<<EOF;
40a
41a
42YY
43
44XX
45b
46b
47YY
48
49XX
50c
51YY
52
53XX
54d
55d
56d
57EOF
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.
62my @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
129The following loop translate the above @Tests to a Coreutils::run_tests()
130compatible structure. It converts "OUTPUTS" key into "CMP" + "POST" keys:
1311. 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.
1342. 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).
1373. Add a "PRE" key, deleting all existing 'xx*' files.
138
139Example:
140
141Before 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
150After 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
165my @Tests;
166foreach 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
214my $save_temps = $ENV{DEBUG};
215my $verbose = $ENV{VERBOSE};
216
217my $fail = run_tests ($prog, $prog, \@Tests, $save_temps, $verbose);
218exit $fail;
219