1#!/usr/bin/perl 2# Basic tests for "expr". 3 4# Copyright (C) 2001-2020 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 19use strict; 20 21(my $program_name = $0) =~ s|.*/||; 22my $prog = 'expr'; 23 24# Turn off localization of executable's output. 25@ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3; 26 27my $mb_locale = $ENV{LOCALE_FR_UTF8}; 28! defined $mb_locale || $mb_locale eq 'none' 29 and $mb_locale = 'C'; 30 31my $big = '98782897298723498732987928734'; 32my $big_p1 = '98782897298723498732987928735'; 33my $big_sum = '197565794597446997465975857469'; 34my $big_prod = '9758060798730154302876482828124348356960410232492450771490'; 35 36my @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 # These tests are taken from grep/tests/bre.tests. 88 ['bre1', '"abc" : "a\\(b\\)c"', {OUT => 'b'}], 89 ['bre2', '"a(" : "a("', {OUT => '2'}], 90 ['bre3', '_ : "a\\("', 91 {ERR => "$prog: Unmatched ( or \\(\n"}, {EXIT => 2}], 92 ['bre4', '_ : "a\\(b"', 93 {ERR => "$prog: Unmatched ( or \\(\n"}, {EXIT => 2}], 94 ['bre5', '"a(b" : "a(b"', {OUT => '3'}], 95 ['bre6', '"a)" : "a)"', {OUT => '2'}], 96 ['bre7', '_ : "a\\)"', 97 {ERR => "$prog: Unmatched ) or \\)\n"}, {EXIT => 2}], 98 ['bre8', '_ : "\\)"', 99 {ERR => "$prog: Unmatched ) or \\)\n"}, {EXIT => 2}], 100 ['bre9', '"ab" : "a\\(\\)b"', {OUT => ''}, {EXIT => 1}], 101 ['bre10', '"a^b" : "a^b"', {OUT => '3'}], 102 ['bre11', '"a\$b" : "a\$b"', {OUT => '3'}], 103 ['bre12', '"" : "\\($\\)\\(^\\)"', {OUT => ''}, {EXIT => 1}], 104 ['bre13', '"b" : "a*\\(^b\$\\)c*"', {OUT => 'b'}], 105 ['bre14', '"X|" : "X\\(|\\)" : "(" "X|" : "X\\(|\\)" ")"', {OUT => '1'}], 106 ['bre15', '"X*" : "X\\(*\\)" : "(" "X*" : "X\\(*\\)" ")"', {OUT => '1'}], 107 ['bre16', '"abc" : "\\(\\)"', {OUT => ''}, {EXIT => 1}], 108 ['bre17', '"{1}a" : "\\(\\{1\\}a\\)"', {OUT => '{1}a'}], 109 ['bre18', '"X*" : "X\\(*\\)" : "^*"', {OUT => '1'}], 110 ['bre19', '"{1}" : "^\\{1\\}"', {OUT => '3'}], 111 ['bre20', '"{" : "{"', {OUT => '1'}], 112 ['bre21', '"abbcbd" : "a\\(b*\\)c\\1d"', {OUT => ''}, {EXIT => 1}], 113 ['bre22', '"abbcbbbd" : "a\\(b*\\)c\\1d"', {OUT => ''}, {EXIT => 1}], 114 ['bre23', '"abc" : "\\(.\\)\\1"', {OUT => ''}, {EXIT => 1}], 115 ['bre24', '"abbccd" : "a\\(\\([bc]\\)\\2\\)*d"', {OUT => 'cc'}], 116 ['bre25', '"abbcbd" : "a\\(\\([bc]\\)\\2\\)*d"', 117 {OUT => ''}, {EXIT => 1}], 118 ['bre26', '"abbbd" : "a\\(\\(b\\)*\\2\\)*d"', {OUT => 'bbb'}], 119 ['bre27', '"aabcd" : "\\(a\\)\\1bcd"', {OUT => 'a'}], 120 ['bre28', '"aabcd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}], 121 ['bre29', '"aabd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}], 122 ['bre30', '"aabcccd" : "\\(a\\)\\1bc*d"', {OUT => 'a'}], 123 ['bre31', '"aabcccd" : "\\(a\\)\\1bc*[ce]d"', {OUT => 'a'}], 124 ['bre32', '"aabcccd" : "\\(a\\)\\1b\\(c\\)*cd\$"', {OUT => 'a'}], 125 ['bre33', '"a*b" : "a\\(*\\)b"', {OUT => '*'}], 126 ['bre34', '"ab" : "a\\(**\\)b"', {OUT => ''}, {EXIT => 1}], 127 ['bre35', '"ab" : "a\\(***\\)b"', {OUT => ''}, {EXIT => 1}], 128 ['bre36', '"*a" : "*a"', {OUT => '2'}], 129 ['bre37', '"a" : "**a"', {OUT => '1'}], 130 ['bre38', '"a" : "***a"', {OUT => '1'}], 131 ['bre39', '"ab" : "a\\{1\\}b"', {OUT => '2'}], 132 ['bre40', '"ab" : "a\\{1,\\}b"', {OUT => '2'}], 133 ['bre41', '"aab" : "a\\{1,2\\}b"', {OUT => '3'}], 134 ['bre42', '_ : "a\\{1"', 135 {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}], 136 ['bre43', '_ : "a\\{1a"', 137 {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}], 138 ['bre44', '_ : "a\\{1a\\}"', 139 {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}], 140 ['bre45', '"a" : "a\\{,2\\}"', {OUT => '1'}], 141 ['bre46', '"a" : "a\\{,\\}"', {OUT => '1'}], 142 ['bre47', '_ : "a\\{1,x\\}"', 143 {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}], 144 ['bre48', '_ : "a\\{1,x"', 145 {ERR => "$prog: Unmatched \\{\n"}, {EXIT => 2}], 146 ['bre49', '_ : "a\\{32768\\}"', 147 {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}, 148 # Map AIX-6's different diagnostic to the one we expect: 149 {ERR_SUBST => 150 's,Regular expression too big,Invalid content of \\\\{\\\\},'}, 151 ], 152 ['bre50', '_ : "a\\{1,0\\}"', 153 {ERR => "$prog: Invalid content of \\{\\}\n"}, {EXIT => 2}], 154 ['bre51', '"acabc" : ".*ab\\{0,0\\}c"', {OUT => '2'}], 155 ['bre52', '"abcac" : "ab\\{0,1\\}c"', {OUT => '3'}], 156 ['bre53', '"abbcac" : "ab\\{0,3\\}c"', {OUT => '4'}], 157 ['bre54', '"abcac" : ".*ab\\{1,1\\}c"', {OUT => '3'}], 158 ['bre55', '"abcac" : ".*ab\\{1,3\\}c"', {OUT => '3'}], 159 ['bre56', '"abbcabc" : ".*ab\{2,2\}c"', {OUT => '4'}], 160 ['bre57', '"abbcabc" : ".*ab\{2,4\}c"', {OUT => '4'}], 161 ['bre58', '"aa" : "a\\{1\\}\\{1\\}"', {OUT => '1'}], 162 ['bre59', '"aa" : "a*\\{1\\}"', {OUT => '2'}], 163 ['bre60', '"aa" : "a\\{1\\}*"', {OUT => '2'}], 164 ['bre61', '"acd" : "a\\(b\\)?c\\1d"', {OUT => ''}, {EXIT => 1}], 165 ['bre62', '-- "-5" : "-\\{0,1\\}[0-9]*\$"', {OUT => '2'}], 166 167 ['fail-c', {ERR => "$prog: missing operand\n" 168 . "Try '$prog --help' for more information.\n"}, 169 {EXIT => 2}], 170 171 ['bignum-add', "$big + 1", {OUT => $big_p1}], 172 ['bignum-add2', "$big + $big_p1", {OUT => $big_sum}], 173 ['bignum-sub', "$big_p1 - 1", {OUT => $big}], 174 ['bignum-sub2', "$big_sum - $big", {OUT => $big_p1}], 175 ['bignum-mul', "$big_p1 '*' $big", {OUT => $big_prod}], 176 ['bignum-div', "$big_prod / $big", {OUT => $big_p1}], 177 178 179 # Test syntax error messages 180 ['se0', '9 9', 181 {ERR => "$prog: syntax error: unexpected argument '9'\n"}, {EXIT => 2}], 182 ['se1', "2 a", {EXIT=>2}, 183 {ERR=>"$prog: syntax error: unexpected argument 'a'\n"}], 184 ['se2', "2 '+'", {EXIT=>2}, 185 {ERR=>"$prog: syntax error: missing argument after '+'\n"}], 186 ['se3', "2 :", {EXIT=>2}, 187 {ERR=>"$prog: syntax error: missing argument after ':'\n"}], 188 ['se4', "length", {EXIT=>2}, 189 {ERR=>"$prog: syntax error: missing argument after 'length'\n"}], 190 ['se5', "'(' 2 ", {EXIT=>2}, 191 {ERR=>"$prog: syntax error: expecting ')' after '2'\n"}], 192 ['se6', "'(' 2 a", {EXIT=>2}, 193 {ERR=>"$prog: syntax error: expecting ')' instead of 'a'\n"}], 194 ); 195 196# If using big numbers fails, remove all /^bignum-/ tests 197qx!expr $big_prod '*' $big_prod '*' $big_prod! 198 or @Tests = grep {$_->[0] !~ /^bignum-/} @Tests; 199 200# Append a newline to end of each expected 'OUT' string. 201my $t; 202foreach $t (@Tests) 203 { 204 my $arg1 = $t->[1]; 205 my $e; 206 foreach $e (@$t) 207 { 208 $e->{OUT} .= "\n" 209 if ref $e eq 'HASH' and exists $e->{OUT}; 210 } 211 } 212 213# Try multibyte locale in most tests. 214# 215if ($mb_locale ne 'C') 216 { 217 # Duplicate each test vector, appending "-mb" to the test name and 218 # inserting {ENV => "LC_ALL=$mb_locale"} in the copy, so that we 219 # provide coverage for the distro-added multi-byte code paths. 220 my @new; 221 foreach my $t (@Tests) 222 { 223 # Don't add the quote varying tests to the multi-byte set 224 $t->[0] =~ /^se/ 225 and next; 226 227 my @new_t = @$t; 228 my $test_name = shift @new_t; 229 230 push @new, ["$test_name-mb", @new_t, {ENV => "LC_ALL=$mb_locale"}]; 231 } 232 push @Tests, @new; 233 } 234 235my $save_temps = $ENV{SAVE_TEMPS}; 236my $verbose = $ENV{VERBOSE}; 237 238my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose); 239exit $fail; 240