tests/tr/Test.pm

   1 # Test "tr".
   2
   3 # Copyright (C) 1996, 1997, 2000, 2002, 2004-2007 Free Software
   4 # 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 package Test;
  20 require 5.002;
  21 use strict;
  22
  23 $Test::input_via_stdin = 1;
  24
  25 my @tv = (
  26 # test flags  1 or 2 strings   input    expected output    expected return code
  27 #
  28 ['1',         q|'abcd' '[]*]'|,   'abcd',   ']]]]',              0],
  29 ['2',         q|'abc' '[%*]xyz'|,  'abc',    'xyz',              0],
  30 ['3',         q|'' '[.*]'|,        'abc',    'abc',              0],
  31 # Test --truncate-set1 behavior when string1 is longer than string2
  32 ['4', '-t ' . q|'abcd' 'xy'|,     'abcde', 'xycde',            0],
  33 # Test bsd behavior (the default) when string1 is longer than string2
  34 ['5',         q|'abcd' 'xy'|,     'abcde', 'xyyye',            0],
  35 # Do it the posix way
  36 ['6',         q|'abcd' 'x[y*]'|,  'abcde', 'xyyye',            0],
  37 #
  38 ['7', '-s ' . q|'a-p' '%[.*]$'|, 'abcdefghijklmnop', '%.$',       0],
  39 ['8', '-s ' . q|'a-p' '[.*]$'|, 'abcdefghijklmnop', '.$',         0],
  40 ['9', '-s ' . q|'a-p' '%[.*]'|, 'abcdefghijklmnop', '%.',         0],
  41 ['a', '-s ' . q|'[a-z]'|,        'aabbcc', 'abc',              0],
  42 ['b', '-s ' . q|'[a-c]'|,        'aabbcc', 'abc',              0],
  43 ['c', '-s ' . q|'[a-b]'|,        'aabbcc', 'abcc',             0],
  44 ['d', '-s ' . q|'[b-c]'|,        'aabbcc', 'aabc',             0],
  45 ['e', '-s ' . q|'[\0-\5]'|,
  46  "\0\0a\1\1b\2\2\2c\3\3\3d\4\4\4\4e\5\5",
  47  "\0a\1b\2c\3d\4e\5",  0],
  48 # tests of delete
  49 ['f', '-d ' . q|'[=[=]'|, '[[[[[[[]]]]]]]]', ']]]]]]]]', 0],
  50 ['g', '-d ' . q|'[=]=]'|, '[[[[[[[]]]]]]]]', '[[[[[[[', 0],
  51 ['h', '-d ' . q|'[:xdigit:]'|, '0123456789acbdefABCDEF', '', 0],
  52 ['i', '-d ' . q|'[:xdigit:]'|, 'w0x1y2z3456789acbdefABCDEFz', 'wxyzz', 0],
  53 ['j', '-d ' . q|'[:digit:]'|, '0123456789', '', 0],
  54 ['k', '-d ' . q|'[:digit:]'|, 'a0b1c2d3e4f5g6h7i8j9k', 'abcdefghijk', 0],
  55 ['l', '-d ' . q|'[:lower:]'|, 'abcdefghijklmnopqrstuvwxyz', '', 0],
  56 ['m', '-d ' . q|'[:upper:]'|, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', '', 0],
  57 ['n', '-d ' . q|'[:lower:][:upper:]'|,
  58  'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', '', 0],
  59 ['o', '-d ' . q|'[:alpha:]'|,
  60  'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ', '', 0],
  61 ['p', '-d ' . q|'[:alnum:]'|,
  62  'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789', '', 0],
  63 ['q', '-d ' . q|'[:alnum:]'|,
  64  '.abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.', '..', 0],
  65 ['r', '-ds ' . q|'[:alnum:]' '.'|,
  66  '.abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.', '.', 0],
  67
  68 # The classic example, with string2 BSD-style
  69 ['s', '-cs ' . q|'[:alnum:]' '\n'|,
  70  'The big black fox jumped over the fence.',
  71  "The\nbig\nblack\nfox\njumped\nover\nthe\nfence\n", 0],
  72
  73 # The classic example, POSIX-style
  74 ['t', '-cs ' . q|'[:alnum:]' '[\n*]'|,
  75  'The big black fox jumped over the fence.',
  76  "The\nbig\nblack\nfox\njumped\nover\nthe\nfence\n", 0],
  77 ['u', '-ds ' . q|'b' 'a'|,          'aabbaa', 'a',             0],
  78 ['v', '-ds ' . q|'[:xdigit:]' 'Z'|,
  79  'ZZ0123456789acbdefABCDEFZZ', 'Z', 0],
  80
  81 # Try some data with 8th bit set in case something is mistakenly sign-extended.
  82 ['w', '-ds ' . q|'\350' '\345'|,
  83  "\300\301\377\345\345\350\345",
  84  "\300\301\377\345", 0],
  85 ['x', '-s ' . q|'abcdefghijklmn' '[:*016]'|, 'abcdefghijklmnop', ':op', 0],
  86 ['y', '-d ' . q|'a-z'|, 'abc $code', ' $', 0],
  87 ['z', '-ds ' . q|'a-z' '$.'|, 'a.b.c $$$$code\\', '. $\\', 0],
  88
  89 # Make sure that a-a is accepted.
  90 ['range-a-a', q|'a-a' 'z'|,         'abc',    'zbc',               0],
  91 #
  92 ['null', q|'a' ''''|,          '',       '',                  1],
  93 ['upcase',q|'[:lower:]' '[:upper:]'|,   'abcxyzABCXYZ', 'ABCXYZABCXYZ', 0],
  94 ['dncase', q|'[:upper:]' '[:lower:]'|,  'abcxyzABCXYZ', 'abcxyzabcxyz', 0],
  95 #
  96 ['rep-cclass',   q|'a[=*2][=c=]' 'xyyz'|,       'a=c', 'xyz', 0],
  97 ['rep-1',   q|'[:*3][:digit:]' 'a-m'|,  ':1239', 'cefgm', 0],
  98 ['rep-2',   q|'a[b*512]c' '1[x*]2'|,    'abc', '1x2', 0],
  99 ['rep-3',   q|'a[b*513]c' '1[x*]2'|,    'abc', '1x2', 0],
 100 # Another couple octal repeat count tests.
 101 ['o-rep-1',   q|'[b*08]' '[x*]'|,       '', '', 1],
 102 ['o-rep-2',   q|'[b*010]cd' '[a*7]BC[x*]'|, 'bcd', 'BCx', 0],
 103
 104 ['esc',     q|'a\-z' 'A-Z'|,            'abc-z', 'AbcBC', 0],
 105 ['bs-055', q|'a\055b' def|,             "a\055b", 'def', 0],
 106 ['bs-at-end', q|'\' x|,                 "\\", 'x', 0],
 107
 108 #
 109 # From Ross
 110 ['ross-0a', '-cs ' . q|'[:upper:]' 'X[Y*]'|,    '', '', 1],
 111 ['ross-0b', '-cs ' . q|'[:cntrl:]' 'X[Y*]'|,    '', '', 1],
 112 ['ross-1a', '-cs ' . q|'[:upper:]' '[X*]'|, 'AMZamz123.-+AMZ', 'AMZXAMZ', 0],
 113 ['ross-1b', '-cs ' . q|'[:upper:][:digit:]' '[Z*]'|, '', '', 0],
 114 ['ross-2', '-dcs ' . q|'[:lower:]' 'n-rs-z'|, 'amzAMZ123.-+amz', 'amzamz', 0],
 115 ['ross-3', '-ds ' . q|'[:xdigit:]' '[:alnum:]'|,
 116  '.ZABCDEFGzabcdefg.0123456788899.GG', '.ZGzg..G', 0],
 117 ['ross-4', '-dcs ' . q|'[:alnum:]' '[:digit:]'|,        '', '', 0],
 118 ['ross-5', '-dc ' . q|'[:lower:]'|,             '', '', 0],
 119 ['ross-6', '-dc ' . q|'[:upper:]'|,             '', '', 0],
 120
 121 # Ensure that these fail.
 122 # Prior to 2.0.20, each would evoke a failed assertion.
 123 ['empty-eq', q|'[==]' x|,               '', '', 1],
 124 ['empty-cc', q|'[::]' x|,               '', '', 1],
 125
 126 # Weird repeat counts.
 127 ['repeat-bs-9',          q|abc '[b*\9]'|, 'abcd', '[b*d', 0],
 128 ['repeat-0',             q|abc '[b*0]'|, 'abcd', 'bbbd', 0],
 129 ['repeat-zeros',         q|abc '[b*00000000000000000000]'|, 'abcd', 'bbbd', 0],
 130 ['repeat-compl', '-c ' . q|'[a*65536]\n' '[b*]'|, 'abcd', 'abbb', 0],
 131 ['repeat-xC',    '-C ' . q|'[a*65536]\n' '[b*]'|, 'abcd', 'abbb', 0],
 132
 133 # From Glenn Fowler.
 134 ['fowler-1', q|ah -H|, 'aha', '-H-', 0],
 135
 136 # Prior to coreutils-6.10, this would provoke a failed assertion.
 137 ['no-abort-1', '-c ' . q|a '[b*256]'|, 'abc', 'abb', 0],
 138
 139 # Up to coreutils-6.9, tr rejected an unmatched [:lower:] or [:upper:] in SET1.
 140 ['s1-lower', q|'[:lower:]' '[.*]'|, '#$%123abcABC', '#$%123...ABC', 0],
 141 ['s1-upper', q|'[:upper:]' '[.*]'|, '#$%123abcABC', '#$%123abc...', 0],
 142 );
 143
 144 sub test_vector
 145 {
 146   my $t;
 147   foreach $t (@tv)
 148     {
 149       my ($test_name, $flags, $in, $exp, $ret) = @$t;
 150       $Test::input_via{$test_name} = {REDIR => 0, PIPE => 0};
 151     }
 152
 153   return @tv;
 154 }
 155
 156 1;