tests/tr/Test.pm

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