tests/expr/expr.pl

   1 #!/usr/bin/perl
   2 # Basic tests for "expr".
   3
   4 # Copyright (C) 2001-2024 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 my $prog = 'expr';
  23
  24 # Turn off localization of executable's output.
  25 @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  26
  27 my $mb_locale = $ENV{LOCALE_FR_UTF8};
  28 ! defined $mb_locale || $mb_locale eq 'none'
  29   and $mb_locale = 'C';
  30
  31 my $big =      '98782897298723498732987928734';
  32 my $big_p1 =   '98782897298723498732987928735';
  33 my $big_sum = '197565794597446997465975857469';
  34 my $big_prod = '9758060798730154302876482828124348356960410232492450771490';
  35
  36 my @Tests =
  37     (
  38      ['a', '5 + 6', {OUT => '11'}],
  39      ['b', '5 - 6', {OUT => '-1'}],
  40      ['c', '5 \* 6', {OUT => '30'}],
  41      ['d', '100 / 6', {OUT => '16'}],
  42      ['e', '100 % 6', {OUT => '4'}],
  43      ['f', '3 + -2', {OUT => '1'}],
  44      ['g', '-2 + -2', {OUT => '-4'}],
  45
  46      # Verify option processing.
  47      # Added when option processing broke in the 7.0 beta release
  48      ['opt1', '-- -11 + 12', {OUT => '1'}],
  49      ['opt2', '-11 + 12', {OUT => '1'}],
  50      ['opt3', '-- -1 + 2', {OUT => '1'}],
  51      ['opt4', '-1 + 2', {OUT => '1'}],
  52      # This evoked a syntax error diagnostic before 2.0.12.
  53      ['opt5', '-- 2 + 2', {OUT => '4'}],
  54
  55      ['paren1', '\( 100 % 6 \)', {OUT => '4'}],
  56      ['paren2', '\( 100 % 6 \) - 8', {OUT => '-4'}],
  57      ['paren3', '9 / \( 100 % 6 \) - 8', {OUT => '-6'}],
  58      ['paren4', '9 / \( \( 100 % 6 \) - 8 \)', {OUT => '-2'}],
  59      ['paren5', '9 + \( 100 % 6 \)', {OUT => '13'}],
  60
  61      # Before 2.0.12, this would output '1'.
  62      ['0bang', '00 \< 0!', {OUT => '0'}, {EXIT => 1}],
  63
  64      # In 5.1.3 and earlier, these would exit with status 0.
  65      ['00', '00', {OUT => '00'}, {EXIT => 1}],
  66      ['minus0', '-0', {OUT => '-0'}, {EXIT => 1}],
  67
  68      # In 5.1.3 and earlier, these would report errors.
  69      ['andand', '0 \& 1 / 0', {OUT => '0'}, {EXIT => 1}],
  70      ['oror', '1 \| 1 / 0', {OUT => '1'}, {EXIT => 0}],
  71
  72      # In 5.1.3 and earlier, this would output the empty string.
  73      ['orempty', '"" \| ""', {OUT => '0'}, {EXIT => 1}],
  74
  75
  76      # This erroneously succeeded and output '3' before 2.0.12.
  77      ['fail-a', '3 + -', {ERR => "$prog: non-integer argument\n"},
  78       {EXIT => 2}],
  79
  80      # This erroneously succeeded before 5.3.1.
  81      ['bigcmp', '-- -2417851639229258349412352 \< 2417851639229258349412352',
  82       {OUT => '1'}, {EXIT => 0}],
  83
  84      # In 5.94 and earlier, anchors incorrectly matched newlines.
  85      ['anchor', "'a\nb' : 'a\$'", {OUT => '0'}, {EXIT => 1}],
  86
  87      # In 8.32, \( ... \) that did not match caused memory errors.
  88      ['emptysub', '"a" : "\\(b\\)*"', {OUT => ''}, {EXIT => 1}],
  89
  90      # These tests are taken from grep/tests/bre.tests.
  91      ['bre1', '"abc" : "a\\(b\\)c"', {OUT => 'b'}],
  92      ['bre2', '"a(" : "a("', {OUT => '2'}],
  93      ['bre3', '_ : "a\\("',
  94       {ERR => "$prog: Unmatched ( or \\(\n"}, {EXIT => 2}],
  95      ['bre4', '_ : "a\\(b"',
  96       {ERR => "$prog: Unmatched ( or \\(\n"}, {EXIT => 2}],
  97      ['bre5', '"a(b" : "a(b"', {OUT => '3'}],
  98      ['bre6', '"a)" : "a)"', {OUT => '2'}],
  99      ['bre7', '_ : "a\\)"',
 100       {ERR => "$prog: Unmatched ) or \\)\n"}, {EXIT => 2}],
 101      ['bre8', '_ : "\\)"',
 102       {ERR => "$prog: Unmatched ) or \\)\n"}, {EXIT => 2}],
 103      ['bre9', '"ab" : "a\\(\\)b"', {OUT => ''}, {EXIT => 1}],
 104      ['bre10', '"a^b" : "a^b"', {OUT => '3'}],
 105      ['bre11', '"a\$b" : "a\$b"', {OUT => '3'}],
 106      ['bre12', '"" : "\\($\\)\\(^\\)"', {OUT => ''}, {EXIT => 1}],
 107      ['bre13', '"b" : "a*\\(^b\$\\)c*"', {OUT => 'b'}],
 108      ['bre14', '"X|" : "X\\(|\\)" : "(" "X|" : "X\\(|\\)" ")"', {OUT => '1'}],
 109      ['bre15', '"X*" : "X\\(*\\)" : "(" "X*" : "X\\(*\\)" ")"', {OUT => '1'}],
 110      ['bre16', '"abc" : "\\(\\)"', {OUT => ''}, {EXIT => 1}],
 111      ['bre17', '"{1}a" : "\\(\\{1\\}a\\)"', {OUT => '{1}a'}],
 112      ['bre18', '"X*" : "X\\(*\\)" : "^*"', {OUT => '1'}],
 113      ['bre19', '"{1}" : "^\\{1\\}"', {OUT => '3'}],
 114      ['bre20', '"{" : "{"', {OUT => '1'}],
 115      ['bre21', '"abbcbd" : "a\\(b*\\)c\\1d"', {OUT => ''}, {EXIT => 1}],
 116      ['bre22', '"abbcbbbd" : "a\\(b*\\)c\\1d"', {OUT => ''}, {EXIT => 1}],
 117      ['bre23', '"abc" : "\\(.\\)\\1"', {OUT => ''}, {EXIT => 1}],
 118      ['bre24', '"abbccd" : "a\\(\\([bc]\\)\\2\\)*d"', {OUT => 'cc'}],
 119      ['bre25', '"abbcbd" : "a\\(\\([bc]\\)\\2\\)*d"',
 120       {OUT => ''}, {EXIT => 1}],
 121      ['bre26', '"abbbd" : "a\\(\\(b\\)*\\2\\)*d"', {OUT => 'bbb'}],
 122      ['bre27', '"aabcd" : "\\(a\\)\\1bcd"', {OUT => 'a'}],
 123      ['bre28', '"aabcd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}],
 124      ['bre29', '"aabd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}],
 125      ['bre30', '"aabcccd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}],
 126      ['bre31', '"aabcccd" : "\\(a\\)\\1bc*[ce]d"', {OUT => 'a'}],
 127      ['bre32', '"aabcccd" : "\\(a\\)\\1b\\(c\\)*cd\$"', {OUT => 'a'}],
 128      ['bre33', '"a*b" : "a\\(*\\)b"', {OUT => '*'}],
 129      ['bre34', '"ab" : "a\\(**\\)b"', {OUT => ''}, {EXIT => 1}],
 130      ['bre35', '"ab" : "a\\(***\\)b"', {OUT => ''}, {EXIT => 1}],
 131      ['bre36', '"*a" : "*a"', {OUT => '2'}],
 132      ['bre37', '"a" : "**a"', {OUT => '1'}],
 133      ['bre38', '"a" : "***a"', {OUT => '1'}],
 134      ['bre39', '"ab" : "a\\{1\\}b"', {OUT => '2'}],
 135      ['bre40', '"ab" : "a\\{1,\\}b"', {OUT => '2'}],
 136      ['bre41', '"aab" : "a\\{1,2\\}b"', {OUT => '3'}],
 137      ['bre42', '_ : "a\\{1"',
 138       {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}],
 139      ['bre43', '_ : "a\\{1a"',
 140       {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}],
 141      ['bre44', '_ : "a\\{1a\\}"',
 142       {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}],
 143      ['bre45', '"a" : "a\\{,2\\}"', {OUT => '1'}],
 144      ['bre46', '"a" : "a\\{,\\}"', {OUT => '1'}],
 145      ['bre47', '_ : "a\\{1,x\\}"',
 146       {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}],
 147      ['bre48', '_ : "a\\{1,x"',
 148       {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}],
 149      ['bre49', '_ : "a\\{32768\\}"',
 150       {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2},
 151       # Map AIX-6's different diagnostic to the one we expect:
 152       {ERR_SUBST =>
 153        's,Regular expression too big,Invalid content of \\\\{\\\\},'},
 154       ],
 155      ['bre50', '_ : "a\\{1,0\\}"',
 156       {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}],
 157      ['bre51', '"acabc" : ".*ab\\{0,0\\}c"', {OUT => '2'}],
 158      ['bre52', '"abcac" : "ab\\{0,1\\}c"', {OUT => '3'}],
 159      ['bre53', '"abbcac" : "ab\\{0,3\\}c"', {OUT => '4'}],
 160      ['bre54', '"abcac" : ".*ab\\{1,1\\}c"', {OUT => '3'}],
 161      ['bre55', '"abcac" : ".*ab\\{1,3\\}c"', {OUT => '3'}],
 162      ['bre56', '"abbcabc" : ".*ab\{2,2\}c"', {OUT => '4'}],
 163      ['bre57', '"abbcabc" : ".*ab\{2,4\}c"', {OUT => '4'}],
 164      ['bre58', '"aa" : "a\\{1\\}\\{1\\}"', {OUT => '1'}],
 165      ['bre59', '"aa" : "a*\\{1\\}"', {OUT => '2'}],
 166      ['bre60', '"aa" : "a\\{1\\}*"', {OUT => '2'}],
 167      ['bre61', '"acd" : "a\\(b\\)?c\\1d"', {OUT => ''}, {EXIT => 1}],
 168      ['bre62', '-- "-5" : "-\\{0,1\\}[0-9]*\$"', {OUT => '2'}],
 169
 170      ['fail-c', {ERR => "$prog: missing operand\n"
 171                  . "Try '$prog --help' for more information.\n"},
 172       {EXIT => 2}],
 173
 174      ['bignum-add', "$big + 1", {OUT => $big_p1}],
 175      ['bignum-add2', "$big + $big_p1", {OUT => $big_sum}],
 176      ['bignum-sub', "$big_p1 - 1", {OUT => $big}],
 177      ['bignum-sub2', "$big_sum - $big", {OUT => $big_p1}],
 178      ['bignum-mul', "$big_p1 '*' $big", {OUT => $big_prod}],
 179      ['bignum-div', "$big_prod / $big", {OUT => $big_p1}],
 180
 181
 182      # Test syntax error messages
 183      ['se0', '9 9',
 184       {ERR => "$prog: syntax error: unexpected argument '9'\n"}, {EXIT => 2}],
 185      ['se1', "2 a", {EXIT=>2},
 186       {ERR=>"$prog: syntax error: unexpected argument 'a'\n"}],
 187      ['se2', "2 '+'", {EXIT=>2},
 188       {ERR=>"$prog: syntax error: missing argument after '+'\n"}],
 189      ['se3', "2 :", {EXIT=>2},
 190       {ERR=>"$prog: syntax error: missing argument after ':'\n"}],
 191      ['se4', "length", {EXIT=>2},
 192       {ERR=>"$prog: syntax error: missing argument after 'length'\n"}],
 193      ['se5', "'(' 2 ", {EXIT=>2},
 194       {ERR=>"$prog: syntax error: expecting ')' after '2'\n"}],
 195      ['se6', "'(' 2 a", {EXIT=>2},
 196       {ERR=>"$prog: syntax error: expecting ')' instead of 'a'\n"}],
 197     );
 198
 199 # Append a newline to end of each expected 'OUT' string.
 200 my $t;
 201 foreach $t (@Tests)
 202   {
 203     my $arg1 = $t->[1];
 204     my $e;
 205     foreach $e (@$t)
 206       {
 207         $e->{OUT} .= "\n"
 208           if ref $e eq 'HASH' and exists $e->{OUT};
 209       }
 210   }
 211
 212 # Try multibyte locale in most tests.
 213 #
 214 if ($mb_locale ne 'C')
 215   {
 216     # Duplicate each test vector, appending "-mb" to the test name and
 217     # inserting {ENV => "LC_ALL=$mb_locale"} in the copy, so that we
 218     # provide coverage for multi-byte code paths.
 219     my @new;
 220     foreach my $t (@Tests)
 221       {
 222         # Don't add the quote varying tests to the multi-byte set
 223         $t->[0] =~ /^se/
 224         and next;
 225
 226         my @new_t = @$t;
 227         my $test_name = shift @new_t;
 228
 229         push @new, ["$test_name-mb", @new_t, {ENV => "LC_ALL=$mb_locale"}];
 230       }
 231     push @Tests, @new;
 232   }
 233
 234 my $save_temps = $ENV{SAVE_TEMPS};
 235 my $verbose = $ENV{VERBOSE};
 236
 237 my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
 238 exit $fail;