This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #122476] TODO test for isfoo() crash on Win32 with threads
[perl5.git] / ext / POSIX / t / is.t
CommitLineData
6c8d78fb
HS
1#!./perl -w
2
a78a7b01
NC
3use strict;
4use Test::More;
5use Config;
6
6c8d78fb 7BEGIN {
a78a7b01
NC
8 plan(skip_all => "\$^O eq '$^O'") if $^O eq 'VMS';
9 plan(skip_all => "POSIX is unavailable")
10 unless $Config{extensions} =~ /\bPOSIX\b/;
6c8d78fb
HS
11}
12
6c8d78fb 13use POSIX;
6c8d78fb 14
f14c76ed
RGS
15# E.g. \t might or might not be isprint() depending on the locale,
16# so let's reset to the default.
17setlocale(LC_ALL, 'C') if $Config{d_setlocale};
6c8d78fb 18
f14c76ed 19$| = 1;
6c8d78fb
HS
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.
27my %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" => [],
767bb2e0
ST
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) ],
6c8d78fb
HS
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.
64my %functions;
65foreach 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.
e04dff1a 74plan(tests => keys(%classes) * keys(%functions) + 2);
6c8d78fb 75
6c8d78fb
HS
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#
81foreach my $s (sort keys %classes) {
82 foreach my $f (sort keys %functions) {
83 my $expected = exists $classes{$s}->{$f};
2da736a2 84 my $actual = eval "no warnings 'deprecated'; POSIX::$f( \$s )";
6c8d78fb 85
a78a7b01 86 cmp_ok($actual, '==', $expected, "$f('$s')");
6c8d78fb
HS
87 }
88}
2da736a2
KW
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}
e04dff1a
TC
122
123SKIP:
124{
125 # [perl #122476] - is*() could crash when threads were involved on Win32
126 # this only crashed on Win32, only test there
127 # When the is*() functions are removed, also remove "iscrash"
128 skip("Not Win32", 1) unless $^O eq "MSWin32";
129 skip("No threads", 1) unless $Config{useithreads};
130 skip("No Win32API::File", 1)
131 unless $Config{extensions} =~ m(\bWin32API/File\b);
132
133 local $TODO = "this code crashes perl";
134 local $ENV{PERL5LIB} =
135 join($Config{path_sep},
136 map / / ? qq("$_") : $_, @INC);
137 my $result = `$^X t/iscrash`;
138 like($result, qr/\bok\b/, "is in threads didn't crash");
139}