tests/misc/seq.pl

   1 #!/usr/bin/perl
   2 # Test "seq".
   3
   4 # Copyright (C) 1999-2019 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 $program_name = $0) =~ s|.*/||;
  22
  23 # Turn off localization of executable's output.
  24 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  25
  26 my $prog = 'seq';
  27 my $try_help = "Try '$prog --help' for more information.\n";
  28 my $err_inc_zero = "seq: invalid Zero increment value: '0'\n".$try_help;
  29 my $err_nan_arg = "seq: invalid 'not-a-number' argument: 'nan'\n".$try_help;
  30
  31 my $locale = $ENV{LOCALE_FR_UTF8};
  32 ! defined $locale || $locale eq 'none'
  33   and $locale = 'C';
  34
  35 my $p = '9' x 81;
  36 (my $q = $p) =~ s/9/0/g;
  37 $q = "1$q";
  38 (my $r = $q) =~ s/0$/1/;
  39
  40 my @Tests =
  41   (
  42    ['onearg-1', qw(10),         {OUT => [(1..10)]}],
  43    ['onearg-2', qw(-1)],
  44    ['empty-rev', qw(1 -1 3)],
  45    ['neg-1',    qw(-10 10 10),  {OUT => [qw(-10 0 10)]}],
  46    # ['neg-2',  qw(-.1 .1 .11), {OUT => [qw(-0.1 0.0 0.1)]}],
  47    ['neg-3',    qw(1 -1 0),     {OUT => [qw(1 0)]}],
  48    ['neg-4',    qw(1 -1 -1),    {OUT => [qw(1 0 -1)]}],
  49
  50    ['float-1',  qw(0.8 0.1 0.9),        {OUT => [qw(0.8 0.9)]}],
  51    ['float-2',  qw(0.1 0.99 1.99),      {OUT => [qw(0.10 1.09)]}],
  52    ['float-3',  qw(10.8 0.1 10.95),     {OUT => [qw(10.8 10.9)]}],
  53    ['float-4',  qw(0.1 -0.1 -0.2),      {OUT => [qw(0.1 0.0 -0.1 -0.2)]},
  54     {OUT_SUBST => 's,^-0\.0$,0.0,'},
  55    ],
  56    ['float-5',  qw(0.8 1e-1 0.9),       {OUT => [qw(0.8 0.9)]}],
  57    # Don't append lots of zeros to that 0.9000...; for example, changing the
  58    # number to 0.90000000000000000000 tickles a bug in Solaris 8 strtold
  59    # that would cause the test to fail.
  60    ['float-6',  qw(0.8 0.1 0.9000000000000),    {OUT => [qw(0.8 0.9)]}],
  61
  62    ['wid-1',    qw(.8 1e-2 .81),  {OUT => [qw(0.80 0.81)]}],
  63    ['wid-2',    qw(.89999 1e-7 .8999901),  {OUT => [qw(0.8999900 0.8999901)]}],
  64
  65    ['eq-wid-1', qw(-w 1 -1 -1), {OUT => [qw(01 00 -1)]}],
  66    # Prior to 2.0g, this test would fail on e.g., HPUX systems
  67    # because it'd end up using %3.1f as the format instead of %4.1f.
  68    ['eq-wid-2', qw(-w -.1 .1 .11),{OUT => [qw(-0.1 00.0 00.1)]}],
  69    ['eq-wid-3', qw(-w 1 3.0),  {OUT => [qw(1 2 3)]}],
  70    ['eq-wid-4', qw(-w .8 1e-2 .81),  {OUT => [qw(0.80 0.81)]}],
  71    ['eq-wid-5', qw(-w 1 .5 2),  {OUT => [qw(1.0 1.5 2.0)]}],
  72    ['eq-wid-6', qw(-w +1 2),  {OUT => [qw(1 2)]}],
  73    ['eq-wid-7', qw(-w "    .1"  "    .1"),  {OUT => [qw(0.1)]}],
  74    ['eq-wid-8', qw(-w 9 0.5 10),  {OUT => [qw(09.0 09.5 10.0)]}],
  75    # Prior to 8.21, these tests involving numbers in scentific notation
  76    # would fail with misalignment or wrong widths.
  77    ['eq-wid-9', qw(-w -1e-3 1),  {OUT => [qw(-0.001 00.999)]}],
  78    ['eq-wid-10',qw(-w -1e-003 1),  {OUT => [qw(-0.001 00.999)]}],
  79    ['eq-wid-11',qw(-w -1.e-3 1),  {OUT => [qw(-0.001 00.999)]}],
  80    ['eq-wid-12',qw(-w -1.0e-4 1),  {OUT => [qw(-0.00010 00.99990)]}],
  81    ['eq-wid-13',qw(-w 999 1e3),  {OUT => [qw(0999 1000)]}],
  82    # Prior to 8.21, if the start value hadn't a precision, while step did,
  83    # then misalignment would occur if the sequence narrowed.
  84    ['eq-wid-14',qw(-w -1 1.0 0),  {OUT => [qw(-1.0 00.0)]}],
  85    ['eq-wid-15',qw(-w 10 -.1 9.9),  {OUT => [qw(10.0 09.9)]}],
  86
  87    # Prior to coreutils-4.5.11, some of these were not accepted.
  88    ['fmt-1',    qw(-f %2.1f 1.5 .5 2),{OUT => [qw(1.5 2.0)]}],
  89    ['fmt-2',    qw(-f %0.1f 1.5 .5 2),{OUT => [qw(1.5 2.0)]}],
  90    ['fmt-3',    qw(-f %.1f  1.5 .5 2),{OUT => [qw(1.5 2.0)]}],
  91
  92    ['fmt-4',    qw(-f %3.0f 1 2),     {OUT => ['  1', '  2']}],
  93    ['fmt-5',    qw(-f %-3.0f 1 2),    {OUT => ['1  ', '2  ']}],
  94    ['fmt-6',    qw(-f %+3.0f 1 2),    {OUT => [' +1', ' +2']}],
  95    ['fmt-7',    qw(-f %0+3.0f 1 2),   {OUT => [qw(+01 +02)]}],
  96    ['fmt-8',    qw(-f %0+.0f 1 2),    {OUT => [qw(+1 +2)]}],
  97    ['fmt-9',    '-f "% -3.0f"', qw(-1 0), {OUT => ['-1 ', ' 0 ']}],
  98    ['fmt-a',    '-f "% -.0f"',qw(-1 0), {OUT => ['-1', ' 0']}],
  99    ['fmt-b',    qw(-f %%%g%% 1),        {OUT => ['%1%']}],
 100
 101    # In coreutils-[6.0..6.9], this would mistakenly succeed and print "%Lg".
 102    ['fmt-c',    qw(-f %%g 1), {EXIT => 1},
 103     {ERR => "seq: format '%%g' has no % directive\n"}],
 104
 105    # In coreutils-6.9..6.10, this would fail with an erroneous diagnostic:
 106    # "seq: memory exhausted".  In coreutils-6.0..6.8, it would mistakenly
 107    # succeed and print a blank line.
 108    ['fmt-eos1', qw(-f % 1), {EXIT => 1},
 109     {ERR => "seq: format '%' ends in %\n"}],
 110    ['fmt-eos2', qw(-f %g% 1), {EXIT => 1},
 111     {ERR => "seq: format '%g%' has too many % directives\n"}],
 112
 113    ['fmt-d',    qw(-f "" 1), {EXIT => 1},
 114     {ERR => "seq: format '' has no % directive\n"}],
 115    ['fmt-e',    qw(-f %g%g 1), {EXIT => 1},
 116     {ERR => "seq: format '%g%g' has too many % directives\n"}],
 117
 118    # With coreutils-6.12 and earlier, with a UTF8 numeric locale that uses
 119    # something other than "." as the decimal point, this use of seq would
 120    # fail to print the "2,0" endpoint.
 121    ['locale-dec-pt', qw(-0.1 0.1 2),
 122     {OUT => [qw(-0.1 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0
 123                          1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0)]},
 124
 125     {ENV => "LC_ALL=$locale"},
 126     {OUT_SUBST => 's/,/./g'},
 127     ],
 128
 129    # With coreutils-8.19 and prior, this would infloop.
 130    ['long-1', "$p $r", {OUT => [$p, $q, $r]}],
 131
 132    # Exercise the code that trims leading zeros.
 133    ['long-leading-zeros1', qw(000 2), {OUT => [qw(0 1 2)]}],
 134    ['long-leading-zeros2', qw(000 02), {OUT => [qw(0 1 2)]}],
 135    ['long-leading-zeros3', qw(00 02), {OUT => [qw(0 1 2)]}],
 136    ['long-leading-zeros4', qw(0 02), {OUT => [qw(0 1 2)]}],
 137
 138    # Exercise the -s option, which was broken in 8.20
 139    ['sep-1', qw(-s, 1 3), {OUT => [qw(1,2,3)]}],
 140    ['sep-2', qw(-s, 1 1), {OUT => [qw(1)]}],
 141    ['sep-3', qw(-s,, 1 3), {OUT => [qw(1,,2,,3)]}],
 142
 143    # Exercise fast path avoidance logic.
 144    # In 8.20 a step value != 1, with positive integer start and end was broken
 145    ['not-fast-1', qw(1 3 1), {OUT => [qw(1)]}],
 146    ['not-fast-2', qw(1 1 4.2), {OUT => [qw(1 2 3 4)]}],
 147    ['not-fast-3', qw(1 1 0)],
 148    # In 8.20..8.22 a start or end of -0 was broken
 149    ['not-fast-4', qw(-0 10), {OUT => [qw(-0 1 2 3 4 5 6 7 8 9 10)]}],
 150    ['not-fast-5', qw(1 -0)],
 151
 152    # Ensure the correct parameters are passed to the fast path
 153    ['fast-1', qw(4), {OUT => [qw(1 2 3 4)]}],
 154    ['fast-2', qw(1 4), {OUT => [qw(1 2 3 4)]}],
 155    ['fast-3', qw(1 1 4), {OUT => [qw(1 2 3 4)]}],
 156
 157    # Ensure an INCREMENT of Zero is rejected.
 158    ['inc-zero-1',       qw(1 0 10), {EXIT => 1}, {ERR => $err_inc_zero}],
 159    ['inc-zero-2',       qw(0 -0 0), {EXIT => 1}, {ERR => $err_inc_zero},
 160     {ERR_SUBST => 's/-0/0/'}],
 161    ['inc-zero-3',       qw(1 0.0 10), {EXIT => 1},{ERR => $err_inc_zero},
 162     {ERR_SUBST => 's/0.0/0/'}],
 163    ['inc-zero-4',       qw(1 -0.0e-10 10), {EXIT => 1},{ERR => $err_inc_zero},
 164     {ERR_SUBST => 's/-0\.0e-10/0/'}],
 165
 166    # Ensure NaN arguments rejected.
 167    ['nan-first-1', qw(nan),       {EXIT => 1}, {ERR => $err_nan_arg}],
 168    ['nan-first-2', qw(NaN 2),     {EXIT => 1}, {ERR => $err_nan_arg},
 169     {ERR_SUBST => 's/NaN/nan/'}],
 170    ['nan-first-3', qw(nan 1 2),   {EXIT => 1}, {ERR => $err_nan_arg}],
 171    ['nan-first-4', qw(-- -nan),   {EXIT => 1}, {ERR => $err_nan_arg},
 172     {ERR_SUBST => 's/-nan/nan/'}],
 173    ['nan-inc-1',   qw(1 nan 2),   {EXIT => 1}, {ERR => $err_nan_arg}],
 174    ['nan-inc-2',   qw(1 -NaN 2),  {EXIT => 1}, {ERR => $err_nan_arg},
 175     {ERR_SUBST => 's/-NaN/nan/'}],
 176    ['nan-last-1',  qw(1 1 nan),   {EXIT => 1}, {ERR => $err_nan_arg}],
 177    ['nan-last-2',  qw(1 NaN),     {EXIT => 1}, {ERR => $err_nan_arg},
 178     {ERR_SUBST => 's/NaN/nan/'}],
 179    ['nan-last-3',  qw(0 -1 -NaN), {EXIT => 1}, {ERR => $err_nan_arg},
 180     {ERR_SUBST => 's/-NaN/nan/'}],
 181   );
 182
 183 # Append a newline to each entry in the OUT array.
 184 my $t;
 185 foreach $t (@Tests)
 186   {
 187     my $e;
 188     foreach $e (@$t)
 189       {
 190         $e->{OUT} = join ("\n", @{$e->{OUT}}) . "\n"
 191           if ref $e eq 'HASH' and exists $e->{OUT};
 192       }
 193   }
 194
 195 my $save_temps = $ENV{SAVE_TEMPS};
 196 my $verbose = $ENV{VERBOSE};
 197
 198 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
 199 exit $fail;