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