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