This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
0ab328e2f158510f64846c954449d6f660b262b5
[perl5.git] / ext / POSIX / t / is.t
1 #!./perl -w
2
3 use strict;
4 use Test::More;
5 use Config;
6
7 BEGIN {
8     plan(skip_all => "\$^O eq '$^O'") if $^O eq 'VMS';
9     plan(skip_all => "POSIX is unavailable")
10         unless $Config{extensions} =~ /\bPOSIX\b/;
11 }
12
13 use POSIX;
14
15 # E.g. \t might or might not be isprint() depending on the locale,
16 # so let's reset to the default.
17 setlocale(LC_ALL, 'C') if $Config{d_setlocale};
18
19 $| = 1;
20
21 # List of characters (and strings) to feed to the is<xxx> functions.
22 #
23 # The left-hand side (key) is a character or string.
24 # The right-hand side (value) is a list of character classes to which
25 # this string belongs.  This is a *complete* list: any classes not
26 # listed, are expected to return '0' for the given string.
27 my %classes =
28   (
29    'a'    => [ qw(print graph alnum alpha lower xdigit) ],
30    'A'    => [ qw(print graph alnum alpha upper xdigit) ],
31    'z'    => [ qw(print graph alnum alpha lower) ],
32    'Z'    => [ qw(print graph alnum alpha upper) ],
33    '0'    => [ qw(print graph alnum digit xdigit) ],
34    '9'    => [ qw(print graph alnum digit xdigit) ],
35    '.'    => [ qw(print graph punct) ],
36    '?'    => [ qw(print graph punct) ],
37    ' '    => [ qw(print space) ],
38    "\t"   => [ qw(cntrl space) ],
39    "\001" => [ qw(cntrl) ],
40
41    # Multi-character strings.  These are logically ANDed, so the
42    # presence of different types of chars in one string will
43    # reduce the list on the right.
44    'abc'       => [ qw(print graph alnum alpha lower xdigit) ],
45    'az'        => [ qw(print graph alnum alpha lower) ],
46    'aZ'        => [ qw(print graph alnum alpha) ],
47    'abc '      => [ qw(print) ],
48
49    '012aF'     => [ qw(print graph alnum xdigit) ],
50
51    " \t"       => [ qw(space) ],
52
53    "abcde\001" => [],
54
55    # An empty string. Always true (al least in old days) [bug #24554]
56    ''     => [ qw(print graph alnum alpha lower upper digit xdigit
57                   punct cntrl space) ],
58   );
59
60
61 # Pass 1: convert the above arrays to hashes.  While doing so, obtain
62 # a complete list of all the 'is<xxx>' functions.  At least, the ones
63 # listed above.
64 my %functions;
65 foreach my $s (keys %classes) {
66     $classes{$s} = { map {
67         $functions{"is$_"}++;   # Keep track of all the 'is<xxx>' functions
68         "is$_" => 1;            # Our return value: is<xxx>($s) should pass.
69     } @{$classes{$s}} };
70 }
71
72 # Expected number of tests is one each for every combination of a
73 # known is<xxx> function and string listed above.
74 plan(tests => keys(%classes) * keys(%functions) + 1);
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 "no warnings 'deprecated'; POSIX::$f( \$s )";
85
86         cmp_ok($actual, '==', $expected, "$f('$s')");
87     }
88 }
89
90 {
91     my @warnings;
92     local $SIG {__WARN__} = sub { push @warnings, @_; };
93
94     foreach (0 .. 3) {
95         my $a;
96         $a =POSIX::isalnum("a");
97         $a =POSIX::isalpha("a");
98         $a =POSIX::iscntrl("a");
99         $a =POSIX::isdigit("a");
100         $a =POSIX::isgraph("a");
101         $a =POSIX::islower("a");
102         $a =POSIX::ispunct("a");
103         $a =POSIX::isspace("a");
104         $a =POSIX::isupper("a");
105         $a =POSIX::isxdigit("a");
106         $a =POSIX::isalnum("a");
107         $a =POSIX::isalpha("a");
108         $a =POSIX::iscntrl("a");
109         $a =POSIX::isdigit("a");
110         $a =POSIX::isgraph("a");
111         $a =POSIX::islower("a");
112         $a =POSIX::ispunct("a");
113         $a =POSIX::isspace("a");
114         $a =POSIX::isupper("a");
115         $a =POSIX::isxdigit("a");
116     }
117
118     # Each of the 10 classes should warn twice, because each has 2 lexical
119     # calls
120     is(scalar @warnings, 20);
121 }