#!/usr/bin/perl
# Test "cut".

# Copyright (C) 2006-2009 Free Software Foundation, Inc.

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;

(my $ME = $0) =~ s|.*/||;

# Turn off localization of executable's output.
@ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;

my $prog = 'cut';
my $try = "Try \`$prog --help' for more information.\n";
my $from_1 = "$prog: fields and positions are numbered from 1\n$try";
my $inval = "$prog: invalid byte or field list\n$try";
my $no_endpoint = "$prog: invalid range with no endpoint: -\n$try";

my @Tests =
 (
  # Provoke a double-free in cut from coreutils-6.7.
  ['dbl-free', '-f2-', {IN=>{f=>'x'}}, {IN=>{g=>'y'}}, {OUT=>"x\ny\n"}],

  # This failed (as it should) even before coreutils-6.9.90,
  # but cut from 6.9.90 produces a more useful diagnostic.
  ['zero-1', '-b0',   {ERR=>$from_1}, {EXIT => 1} ],

  # Up to coreutils-6.9, specifying a range of 0-2 was not an error.
  # It was treated just like "-2".
  ['zero-2', '-f0-2', {ERR=>$from_1}, {EXIT => 1} ],

  ['1', '-d:', '-f1,3-', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  ['2', '-d:', '-f1,3-', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  ['3', qw(-d: -f2-), {IN=>"a:b:c\n"}, {OUT=>"b:c\n"}],
  ['4', qw(-d: -f4), {IN=>"a:b:c\n"}, {OUT=>"\n"}],
  ['5', qw(-d: -f4), {IN=>""}, {OUT=>""}],
  ['6', '-c4', {IN=>"123\n"}, {OUT=>"\n"}],
  ['7', '-c4', {IN=>"123"}, {OUT=>"\n"}],
  ['8', '-c4', {IN=>"123\n1"}, {OUT=>"\n\n"}],
  ['9', '-c4', {IN=>""}, {OUT=>""}],
  ['a', qw(-s -d:), '-f3-', {IN=>"a:b:c\n"}, {OUT=>"c\n"}],
  ['b', qw(-s -d:), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b:c\n"}],
  ['c', qw(-s -d:), '-f1,3', {IN=>"a:b:c\n"}, {OUT=>"a:c\n"}],
  # Trailing colon should not be output
  ['d', qw(-s -d:), '-f1,3', {IN=>"a:b:c:\n"}, {OUT=>"a:c\n"}],
  ['e', qw(-s -d:), '-f3-', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  ['f', qw(-s -d:), '-f3-4', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  ['g', qw(-s -d:), '-f3,4', {IN=>"a:b:c:\n"}, {OUT=>"c:\n"}],
  # Make sure -s suppresses non-delimited lines
  ['h', qw(-s -d:), '-f2,3', {IN=>"abc\n"}, {OUT=>""}],
  #
  ['i', qw(-d: -f1-3), {IN=>":::\n"}, {OUT=>"::\n"}],
  ['j', qw(-d: -f1-4), {IN=>":::\n"}, {OUT=>":::\n"}],
  ['k', qw(-d: -f2-3), {IN=>":::\n"}, {OUT=>":\n"}],
  ['l', qw(-d: -f2-4), {IN=>":::\n"}, {OUT=>"::\n"}],
  ['m', qw(-s -d: -f1-3), {IN=>":::\n"}, {OUT=>"::\n"}],
  ['n', qw(-s -d: -f1-4), {IN=>":::\n"}, {OUT=>":::\n"}],
  ['o', qw(-s -d: -f2-3), {IN=>":::\n"}, {OUT=>":\n"}],
  ['p', qw(-s -d: -f2-4), {IN=>":::\n"}, {OUT=>"::\n"}],
  ['q', qw(-s -d: -f2-4), {IN=>":::\n:\n"}, {OUT=>"::\n\n"}],
  ['r', qw(-s -d: -f2-4), {IN=>":::\n:1\n"}, {OUT=>"::\n1\n"}],
  ['s', qw(-s -d: -f1-4), {IN=>":::\n:a\n"}, {OUT=>":::\n:a\n"}],
  ['t', qw(-s -d: -f3-), {IN=>":::\n:1\n"}, {OUT=>":\n\n"}],
  # Make sure it handles empty input properly, with and without -s.
  ['u', qw(-s -f3-), {IN=>""}, {OUT=>""}],
  ['v', '-f3-', {IN=>""}, {OUT=>""}],
  # Make sure it handles empty input properly.
  ['w', qw(-b 1), {IN=>""}, {OUT=>""}],
  ['x', qw(-s -d: -f2-4), {IN=>":\n"}, {OUT=>"\n"}],
  # Errors
  # -s may be used only with -f
  ['y', qw(-s -b4), {IN=>":\n"}, {OUT=>""}, {EXIT=>1},
   {ERR=>"$prog: suppressing non-delimited lines makes sense\n"
    . "\tonly when operating on fields\n$try"}],
  # You must specify bytes or fields (or chars)
  ['z', '', {IN=>":\n"}, {OUT=>""}, {EXIT=>1},
   {ERR=>"$prog: you must specify a list of bytes, characters, or fields\n$try"}],
  # Empty field list
  ['empty-fl', qw(-f ''), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$from_1}],
  # Missing field list
  ['missing-fl', qw(-f --), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$inval}],
  # Empty byte list
  ['empty-bl', qw(-b ''), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$from_1}],
  # Missing byte list
  ['missing-bl', qw(-b --), {IN=>":\n"}, {OUT=>""}, {EXIT=>1}, {ERR=>$inval}],

  # This test fails with cut from textutils-1.22.
  ['empty-f1', '-f1', {IN=>""}, {OUT=>""}],

  ['empty-f2', '-f2', {IN=>""}, {OUT=>""}],

  ['o-delim', qw(-d: --out=_), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b_c\n"}],
  ['nul-idelim', qw(-d '' --out=_), '-f2,3', {IN=>"a\0b\0c\n"}, {OUT=>"b_c\n"}],
  ['nul-odelim', qw(-d: --out=), '-f2,3', {IN=>"a:b:c\n"}, {OUT=>"b\0c\n"}],
  ['multichar-od', qw(-d: --out=_._), '-f2,3', {IN=>"a:b:c\n"},
   {OUT=>"b_._c\n"}],

  # Prior to 1.22i, you couldn't use a delimiter that would sign-extend.
  ['8bit-delim', '-d', "\255", '--out=_', '-f2,3', {IN=>"a\255b\255c\n"},
   {OUT=>"b_c\n"}],

  # New functionality:
  ['out-delim1', '-c1-3,5-', '--output-d=:', {IN=>"abcdefg\n"},
   {OUT=>"abc:efg\n"}],
  # A totally overlapped field shouldn't change anything:
  ['out-delim2', '-c1-3,2,5-', '--output-d=:', {IN=>"abcdefg\n"},
   {OUT=>"abc:efg\n"}],
  # Partial overlap: index `2' is not at the start of a range.
  ['out-delim3', '-c1-3,2-4,6', '--output-d=:', {IN=>"abcdefg\n"},
   {OUT=>"abcd:f\n"}],
  ['out-delim3a', '-c1-3,2-4,6-', '--output-d=:', {IN=>"abcdefg\n"},
   {OUT=>"abcd:fg\n"}],
  # Ensure that the following two commands produce the same output.
  # Before an off-by-one fix, the output from the former would not contain a `:'.
  ['out-delim4', '-c4-,2-3', '--output-d=:',
   {IN=>"abcdefg\n"}, {OUT=>"bc:defg\n"}],
  ['out-delim5', '-c2-3,4-', '--output-d=:',
   {IN=>"abcdefg\n"}, {OUT=>"bc:defg\n"}],
  # This test would fail for cut from coreutils-5.0.1 and earlier.
  ['out-delim6', '-c2,1-3', '--output-d=:', {IN=>"abc\n"}, {OUT=>"abc\n"}],
  #
  ['od-abut', '-b1-2,3-4', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"ab:cd\n"}],
  ['od-overlap', '-b1-2,2', '--output-d=:', {IN=>"abc\n"}, {OUT=>"ab\n"}],
  ['od-overlap2', '-b1-2,2-', '--output-d=:', {IN=>"abc\n"}, {OUT=>"abc\n"}],
  ['od-overlap3', '-b1-3,2-', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"abcd\n"}],
  ['od-overlap4', '-b1-3,2-3', '--output-d=:', {IN=>"abcd\n"}, {OUT=>"abc\n"}],
  ['od-overlap5', '-b1-3,1-4', '--output-d=:', {IN=>"abcde\n"}, {OUT=>"abcd\n"}],

  # None of the following invalid ranges provoked an error up to coreutils-6.9.
  ['inval1', qw(-f 2-0), {IN=>''}, {OUT=>''}, {EXIT=>1},
   {ERR=>"$prog: invalid decreasing range\n$try"}],
  ['inval2', qw(-f -), {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
  ['inval3', '-f', '4,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
  ['inval4', '-f', '1-2,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
  ['inval5', '-f', '1-,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
  ['inval6', '-f', '-1,-', {IN=>''}, {OUT=>''}, {EXIT=>1}, {ERR=>$no_endpoint}],
 );

@Tests = triple_test \@Tests;

my $save_temps = $ENV{DEBUG};
my $verbose = $ENV{VERBOSE};

my $fail = run_tests ($ME, $prog, \@Tests, $save_temps, $verbose);
exit $fail;
