Commit | Line | Data |
6c8d78fb |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
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 |
11 | use POSIX; |
12 | use 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. |
16 | setlocale(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. |
26 | my %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. |
63 | my %functions; |
64 | foreach 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 |
73 | require '../../t/test.pl'; |
6c8d78fb |
74 | plan(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 | # |
83 | foreach 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 | } |