Commit | Line | Data |
6c8d78fb |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
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 | |
6c8d78fb |
13 | use POSIX; |
14 | use strict ; |
15 | |
f14c76ed |
16 | # E.g. \t might or might not be isprint() depending on the locale, |
17 | # so let's reset to the default. |
18 | setlocale(LC_ALL, 'C') if $Config{d_setlocale}; |
6c8d78fb |
19 | |
f14c76ed |
20 | $| = 1; |
6c8d78fb |
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. |
28 | my %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 | |
57 | |
58 | # Pass 1: convert the above arrays to hashes. While doing so, obtain |
59 | # a complete list of all the 'is<xxx>' functions. At least, the ones |
60 | # listed above. |
61 | my %functions; |
62 | foreach my $s (keys %classes) { |
63 | $classes{$s} = { map { |
64 | $functions{"is$_"}++; # Keep track of all the 'is<xxx>' functions |
65 | "is$_" => 1; # Our return value: is<xxx>($s) should pass. |
66 | } @{$classes{$s}} }; |
67 | } |
68 | |
69 | # Expected number of tests is one each for every combination of a |
70 | # known is<xxx> function and string listed above. |
71 | require './test.pl'; |
72 | plan(tests => keys(%classes) * keys(%functions)); |
73 | |
74 | |
75 | # |
76 | # Main test loop: Run all POSIX::is<xxx> tests on each string defined above. |
77 | # Only the character classes listed for that string should return 1. We |
78 | # always run all functions on every string, and expect to get 0 for the |
79 | # character classes not listed in the given string's hash value. |
80 | # |
81 | foreach my $s (sort keys %classes) { |
82 | foreach my $f (sort keys %functions) { |
83 | my $expected = exists $classes{$s}->{$f}; |
84 | my $actual = eval "POSIX::$f( \$s )"; |
85 | |
86 | ok( $actual == $expected, "$f('$s') == $actual"); |
87 | } |
88 | } |