tests/misc/seq.pl

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