1*0Sstevel@tonic-gate#!./perl -w 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate require Config; import Config; 7*0Sstevel@tonic-gate if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { 8*0Sstevel@tonic-gate print "1..0\n"; 9*0Sstevel@tonic-gate exit 0; 10*0Sstevel@tonic-gate } 11*0Sstevel@tonic-gate} 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gateuse POSIX; 14*0Sstevel@tonic-gateuse strict ; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate# E.g. \t might or might not be isprint() depending on the locale, 17*0Sstevel@tonic-gate# so let's reset to the default. 18*0Sstevel@tonic-gatesetlocale(LC_ALL, 'C') if $Config{d_setlocale}; 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gate$| = 1; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate# List of characters (and strings) to feed to the is<xxx> functions. 23*0Sstevel@tonic-gate# 24*0Sstevel@tonic-gate# The left-hand side (key) is a character or string. 25*0Sstevel@tonic-gate# The right-hand side (value) is a list of character classes to which 26*0Sstevel@tonic-gate# this string belongs. This is a *complete* list: any classes not 27*0Sstevel@tonic-gate# listed, are expected to return '0' for the given string. 28*0Sstevel@tonic-gatemy %classes = 29*0Sstevel@tonic-gate ( 30*0Sstevel@tonic-gate 'a' => [ qw(print graph alnum alpha lower xdigit) ], 31*0Sstevel@tonic-gate 'A' => [ qw(print graph alnum alpha upper xdigit) ], 32*0Sstevel@tonic-gate 'z' => [ qw(print graph alnum alpha lower) ], 33*0Sstevel@tonic-gate 'Z' => [ qw(print graph alnum alpha upper) ], 34*0Sstevel@tonic-gate '0' => [ qw(print graph alnum digit xdigit) ], 35*0Sstevel@tonic-gate '9' => [ qw(print graph alnum digit xdigit) ], 36*0Sstevel@tonic-gate '.' => [ qw(print graph punct) ], 37*0Sstevel@tonic-gate '?' => [ qw(print graph punct) ], 38*0Sstevel@tonic-gate ' ' => [ qw(print space) ], 39*0Sstevel@tonic-gate "\t" => [ qw(cntrl space) ], 40*0Sstevel@tonic-gate "\001" => [ qw(cntrl) ], 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate # Multi-character strings. These are logically ANDed, so the 43*0Sstevel@tonic-gate # presence of different types of chars in one string will 44*0Sstevel@tonic-gate # reduce the list on the right. 45*0Sstevel@tonic-gate 'abc' => [ qw(print graph alnum alpha lower xdigit) ], 46*0Sstevel@tonic-gate 'az' => [ qw(print graph alnum alpha lower) ], 47*0Sstevel@tonic-gate 'aZ' => [ qw(print graph alnum alpha) ], 48*0Sstevel@tonic-gate 'abc ' => [ qw(print) ], 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate '012aF' => [ qw(print graph alnum xdigit) ], 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate " \t" => [ qw(space) ], 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate "abcde\001" => [], 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate # An empty string. Always true (al least in old days) [bug #24554] 57*0Sstevel@tonic-gate '' => [ qw(print graph alnum alpha lower upper digit xdigit 58*0Sstevel@tonic-gate punct cntrl space) ], 59*0Sstevel@tonic-gate ); 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate# Pass 1: convert the above arrays to hashes. While doing so, obtain 63*0Sstevel@tonic-gate# a complete list of all the 'is<xxx>' functions. At least, the ones 64*0Sstevel@tonic-gate# listed above. 65*0Sstevel@tonic-gatemy %functions; 66*0Sstevel@tonic-gateforeach my $s (keys %classes) { 67*0Sstevel@tonic-gate $classes{$s} = { map { 68*0Sstevel@tonic-gate $functions{"is$_"}++; # Keep track of all the 'is<xxx>' functions 69*0Sstevel@tonic-gate "is$_" => 1; # Our return value: is<xxx>($s) should pass. 70*0Sstevel@tonic-gate } @{$classes{$s}} }; 71*0Sstevel@tonic-gate} 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate# Expected number of tests is one each for every combination of a 74*0Sstevel@tonic-gate# known is<xxx> function and string listed above. 75*0Sstevel@tonic-gaterequire './test.pl'; 76*0Sstevel@tonic-gateplan(tests => keys(%classes) * keys(%functions)); 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gate# 80*0Sstevel@tonic-gate# Main test loop: Run all POSIX::is<xxx> tests on each string defined above. 81*0Sstevel@tonic-gate# Only the character classes listed for that string should return 1. We 82*0Sstevel@tonic-gate# always run all functions on every string, and expect to get 0 for the 83*0Sstevel@tonic-gate# character classes not listed in the given string's hash value. 84*0Sstevel@tonic-gate# 85*0Sstevel@tonic-gateforeach my $s (sort keys %classes) { 86*0Sstevel@tonic-gate foreach my $f (sort keys %functions) { 87*0Sstevel@tonic-gate my $expected = exists $classes{$s}->{$f}; 88*0Sstevel@tonic-gate my $actual = eval "POSIX::$f( \$s )"; 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gate ok( $actual == $expected, "$f('$s') == $actual"); 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate} 93