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