1N/A#!./perl -w
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require Config; import Config;
1N/A if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) {
1N/A print "1..0\n";
1N/A exit 0;
1N/A }
1N/A}
1N/A
1N/Ause POSIX;
1N/Ause strict ;
1N/A
1N/A# E.g. \t might or might not be isprint() depending on the locale,
1N/A# so let's reset to the default.
1N/Asetlocale(LC_ALL, 'C') if $Config{d_setlocale};
1N/A
1N/A$| = 1;
1N/A
1N/A# List of characters (and strings) to feed to the is<xxx> functions.
1N/A#
1N/A# The left-hand side (key) is a character or string.
1N/A# The right-hand side (value) is a list of character classes to which
1N/A# this string belongs. This is a *complete* list: any classes not
1N/A# listed, are expected to return '0' for the given string.
1N/Amy %classes =
1N/A (
1N/A 'a' => [ qw(print graph alnum alpha lower xdigit) ],
1N/A 'A' => [ qw(print graph alnum alpha upper xdigit) ],
1N/A 'z' => [ qw(print graph alnum alpha lower) ],
1N/A 'Z' => [ qw(print graph alnum alpha upper) ],
1N/A '0' => [ qw(print graph alnum digit xdigit) ],
1N/A '9' => [ qw(print graph alnum digit xdigit) ],
1N/A '.' => [ qw(print graph punct) ],
1N/A '?' => [ qw(print graph punct) ],
1N/A ' ' => [ qw(print space) ],
1N/A "\t" => [ qw(cntrl space) ],
1N/A "\001" => [ qw(cntrl) ],
1N/A
1N/A # Multi-character strings. These are logically ANDed, so the
1N/A # presence of different types of chars in one string will
1N/A # reduce the list on the right.
1N/A 'abc' => [ qw(print graph alnum alpha lower xdigit) ],
1N/A 'az' => [ qw(print graph alnum alpha lower) ],
1N/A 'aZ' => [ qw(print graph alnum alpha) ],
1N/A 'abc ' => [ qw(print) ],
1N/A
1N/A '012aF' => [ qw(print graph alnum xdigit) ],
1N/A
1N/A " \t" => [ qw(space) ],
1N/A
1N/A "abcde\001" => [],
1N/A
1N/A # An empty string. Always true (al least in old days) [bug #24554]
1N/A '' => [ qw(print graph alnum alpha lower upper digit xdigit
1N/A punct cntrl space) ],
1N/A );
1N/A
1N/A
1N/A# Pass 1: convert the above arrays to hashes. While doing so, obtain
1N/A# a complete list of all the 'is<xxx>' functions. At least, the ones
1N/A# listed above.
1N/Amy %functions;
1N/Aforeach my $s (keys %classes) {
1N/A $classes{$s} = { map {
1N/A $functions{"is$_"}++; # Keep track of all the 'is<xxx>' functions
1N/A "is$_" => 1; # Our return value: is<xxx>($s) should pass.
1N/A } @{$classes{$s}} };
1N/A}
1N/A
1N/A# Expected number of tests is one each for every combination of a
1N/A# known is<xxx> function and string listed above.
1N/Arequire './test.pl';
1N/Aplan(tests => keys(%classes) * keys(%functions));
1N/A
1N/A
1N/A#
1N/A# Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
1N/A# Only the character classes listed for that string should return 1. We
1N/A# always run all functions on every string, and expect to get 0 for the
1N/A# character classes not listed in the given string's hash value.
1N/A#
1N/Aforeach my $s (sort keys %classes) {
1N/A foreach my $f (sort keys %functions) {
1N/A my $expected = exists $classes{$s}->{$f};
1N/A my $actual = eval "POSIX::$f( \$s )";
1N/A
1N/A ok( $actual == $expected, "$f('$s') == $actual");
1N/A }
1N/A}