+ foreach my $x (sort { ord $a <=> ord $b } keys %lower) {
+ my $ok;
+ my $fold_ok;
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ $ok = $x =~ /[[:lower:]]/;
+ $fold_ok = $x =~ /[[:upper:]]/i;
+ }
+ else {
+ use locale;
+ $ok = $x =~ /[[:lower:]]/;
+ $fold_ok = $x =~ /[[:upper:]]/i;
+ }
+ push @failures, $x unless $ok;
+ push @fold_failures, $x unless $fold_ok;
+ }
+
+ $locales_test_number++;
+ $test_names{$locales_test_number} = 'Verify that /[[:lower:]]/ matches all alpha X for which lc(X) == X and uc(X) != X';
+ report_multi_result($Locale, $locales_test_number, \@failures);
+
+ $locales_test_number++;
+ $test_names{$locales_test_number} = 'Verify that /[[:upper:]]/i matches all alpha X for which lc(X) == X and uc(X) != X';
+ report_multi_result($Locale, $locales_test_number, \@fold_failures);
+
+ { # Find the alphabetic characters that are not considered alphabetics
+ # in the default (C) locale.
+
+ no locale;
+
+ @Added_alpha = ();
+ for (keys %UPPER, keys %lower, keys %BoThCaSe) {
+ push(@Added_alpha, $_) if (/\W/);
+ }
+ }
+
+ @Added_alpha = sort { ord $a <=> ord $b } @Added_alpha;
+
+ debug "Added_alpha = ", disp_chars(@Added_alpha), "\n";
+
+ # Cross-check the whole 8-bit character set.
+
+ ++$locales_test_number;
+ my @f;
+ $test_names{$locales_test_number} = 'Verify that \w and [:word:] are identical';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:word:]]/ == /\w/;
+ }
+ else {
+ push @f, $_ unless /[[:word:]]/ == /\w/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that \d and [:digit:] are identical';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:digit:]]/ == /\d/;
+ }
+ else {
+ push @f, $_ unless /[[:digit:]]/ == /\d/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that \s and [:space:] are identical';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:space:]]/ == /\s/;
+ }
+ else {
+ push @f, $_ unless /[[:space:]]/ == /\s/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:posix:] and [:^posix:] are mutually exclusive';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless (/[[:alpha:]]/ xor /[[:^alpha:]]/) ||
+ (/[[:alnum:]]/ xor /[[:^alnum:]]/) ||
+ (/[[:ascii:]]/ xor /[[:^ascii:]]/) ||
+ (/[[:blank:]]/ xor /[[:^blank:]]/) ||
+ (/[[:cntrl:]]/ xor /[[:^cntrl:]]/) ||
+ (/[[:digit:]]/ xor /[[:^digit:]]/) ||
+ (/[[:graph:]]/ xor /[[:^graph:]]/) ||
+ (/[[:lower:]]/ xor /[[:^lower:]]/) ||
+ (/[[:print:]]/ xor /[[:^print:]]/) ||
+ (/[[:space:]]/ xor /[[:^space:]]/) ||
+ (/[[:upper:]]/ xor /[[:^upper:]]/) ||
+ (/[[:word:]]/ xor /[[:^word:]]/) ||
+ (/[[:xdigit:]]/ xor /[[:^xdigit:]]/) ||
+
+ # effectively is what [:cased:] would be if it existed.
+ (/[[:upper:]]/i xor /[[:^upper:]]/i);
+ }
+ else {
+ push @f, $_ unless (/[[:alpha:]]/ xor /[[:^alpha:]]/) ||
+ (/[[:alnum:]]/ xor /[[:^alnum:]]/) ||
+ (/[[:ascii:]]/ xor /[[:^ascii:]]/) ||
+ (/[[:blank:]]/ xor /[[:^blank:]]/) ||
+ (/[[:cntrl:]]/ xor /[[:^cntrl:]]/) ||
+ (/[[:digit:]]/ xor /[[:^digit:]]/) ||
+ (/[[:graph:]]/ xor /[[:^graph:]]/) ||
+ (/[[:lower:]]/ xor /[[:^lower:]]/) ||
+ (/[[:print:]]/ xor /[[:^print:]]/) ||
+ (/[[:space:]]/ xor /[[:^space:]]/) ||
+ (/[[:upper:]]/ xor /[[:^upper:]]/) ||
+ (/[[:word:]]/ xor /[[:^word:]]/) ||
+ (/[[:xdigit:]]/ xor /[[:^xdigit:]]/) ||
+ (/[[:upper:]]/i xor /[[:^upper:]]/i);
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ # The rules for the relationships are given in:
+ # http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap07.html
+
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:lower:] contains at least a-z';
+ for ('a' .. 'z') {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:lower:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:lower:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:lower:] is a subset of [:alpha:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:lower:]]/ and ! /[[:alpha:]]/;
+ }
+ else {
+ push @f, $_ if /[[:lower:]]/ and ! /[[:alpha:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:upper:] contains at least A-Z';
+ for ('A' .. 'Z') {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:upper:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:upper:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:upper:] is a subset of [:alpha:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:upper:]]/ and ! /[[:alpha:]]/;
+ }
+ else {
+ push @f, $_ if /[[:upper:]]/ and ! /[[:alpha:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that /[[:lower:]]/i is a subset of [:alpha:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:lower:]]/i and ! /[[:alpha:]]/;
+ }
+ else {
+ push @f, $_ if /[[:lower:]]/i and ! /[[:alpha:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:alpha:] is a subset of [:alnum:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:alpha:]]/ and ! /[[:alnum:]]/;
+ }
+ else {
+ push @f, $_ if /[[:alpha:]]/ and ! /[[:alnum:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:digit:] contains at least 0-9';
+ for ('0' .. '9') {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:digit:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:digit:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:digit:] is a subset of [:alnum:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:digit:]]/ and ! /[[:alnum:]]/;
+ }
+ else {
+ push @f, $_ if /[[:digit:]]/ and ! /[[:alnum:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:digit:] matches either 10 or 20 code points';
+ report_result($Locale, $locales_test_number, @{$posixes{'digit'}} == 10 || @{$posixes{'digit'}} == 20);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that if there is a second set of digits in [:digit:], they are consecutive';
+ if (@{$posixes{'digit'}} == 20) {
+ my $previous_ord;
+ for (map { chr } 0..255) {
+ next unless /[[:digit:]]/;
+ next if /[0-9]/;
+ if (defined $previous_ord) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if ord $_ != $previous_ord + 1;
+ }
+ else {
+ push @f, $_ if ord $_ != $previous_ord + 1;
+ }
+ }
+ $previous_ord = ord $_;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ my @xdigit_digits; # :digit: & :xdigit:
+ $test_names{$locales_test_number} = 'Verify that [:xdigit:] contains one or two blocks of 10 consecutive [:digit:] chars';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ # For utf8 locales, we actually use a stricter test: that :digit:
+ # is a subset of :xdigit:, as we know that only 0-9 should match
+ push @f, $_ if /[[:digit:]]/ and ! /[[:xdigit:]]/;
+ }
+ else {
+ push @xdigit_digits, $_ if /[[:digit:]]/ and /[[:xdigit:]]/;
+ }
+ }
+ if (! $is_utf8_locale) {
+
+ # For non-utf8 locales, @xdigit_digits is a list of the characters
+ # that are both :xdigit: and :digit:. Because :digit: is stored in
+ # increasing code point order (unless the tests above failed),
+ # @xdigit_digits is as well. There should be exactly 10 or
+ # 20 of these.
+ if (@xdigit_digits != 10 && @xdigit_digits != 20) {
+ @f = @xdigit_digits;
+ }
+ else {
+
+ # Look for contiguity in the series, adding any wrong ones to @f
+ my @temp = @xdigit_digits;
+ while (@temp > 1) {
+ push @f, $temp[1] if ($temp[0] != $temp[1] - 1)
+
+ # Skip this test for the 0th character of
+ # the second block of 10, as it won't be
+ # contiguous with the previous block
+ && (! defined $xdigit_digits[10]
+ || $temp[1] != $xdigit_digits[10]);
+ shift @temp;
+ }
+ }
+ }
+
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:xdigit:] contains at least A-F, a-f';
+ for ('A' .. 'F', 'a' .. 'f') {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:xdigit:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:xdigit:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that any additional members of [:xdigit:], are in groups of 6 consecutive code points';
+ my $previous_ord;
+ my $count = 0;
+ for my $chr (map { chr } 0..255) {
+ next unless $chr =~ /[[:xdigit:]]/;
+ if ($is_utf8_locale) {
+ next if $chr =~ /[[:digit:]]/;
+ }
+ else {
+ next if grep { $chr eq $_ } @xdigit_digits;
+ }
+ next if $chr =~ /[A-Fa-f]/;
+ if (defined $previous_ord) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $chr if ord $chr != $previous_ord + 1;
+ }
+ else {
+ push @f, $chr if ord $chr != $previous_ord + 1;
+ }
+ }
+ $count++;
+ if ($count == 6) {
+ undef $previous_ord;
+ }
+ else {
+ $previous_ord = ord $chr;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:xdigit:] is a subset of [:graph:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:xdigit:]]/ and ! /[[:graph:]]/;
+ }
+ else {
+ push @f, $_ if /[[:xdigit:]]/ and ! /[[:graph:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ # Note that xdigit doesn't have to be a subset of alnum
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:punct:] is a subset of [:graph:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:punct:]]/ and ! /[[:graph:]]/;
+ }
+ else {
+ push @f, $_ if /[[:punct:]]/ and ! /[[:graph:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that the space character is not in [:graph:]';
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, " " if " " =~ /[[:graph:]]/;
+ }
+ else {
+ push @f, " " if " " =~ /[[:graph:]]/;
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:space:] contains at least [\f\n\r\t\cK ]';
+ for (' ', "\f", "\n", "\r", "\t", "\cK") {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:space:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:space:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:blank:] contains at least [\t ]';
+ for (' ', "\t") {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ unless /[[:blank:]]/;
+ }
+ else {
+ push @f, $_ unless /[[:blank:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:blank:] is a subset of [:space:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:blank:]]/ and ! /[[:space:]]/;
+ }
+ else {
+ push @f, $_ if /[[:blank:]]/ and ! /[[:space:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that [:graph:] is a subset of [:print:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:graph:]]/ and ! /[[:print:]]/;
+ }
+ else {
+ push @f, $_ if /[[:graph:]]/ and ! /[[:print:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that the space character is in [:print:]';
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, " " if " " !~ /[[:print:]]/;
+ }
+ else {
+ push @f, " " if " " !~ /[[:print:]]/;
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that isn\'t both [:cntrl:] and [:print:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if (/[[:print:]]/ and /[[:cntrl:]]/);
+ }
+ else {
+ push @f, $_ if (/[[:print:]]/ and /[[:cntrl:]]/);
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that isn\'t both [:alpha:] and [:digit:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:alpha:]]/ and /[[:digit:]]/;
+ }
+ else {
+ push @f, $_ if /[[:alpha:]]/ and /[[:digit:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that isn\'t both [:alnum:] and [:punct:]';
+ for (map { chr } 0..255) {
+ if ($is_utf8_locale) {
+ use locale ':not_characters';
+ push @f, $_ if /[[:alnum:]]/ and /[[:punct:]]/;
+ }
+ else {
+ push @f, $_ if /[[:alnum:]]/ and /[[:punct:]]/;
+ }
+ }
+ report_multi_result($Locale, $locales_test_number, \@f);
+
+ ++$locales_test_number;
+ undef @f;
+ $test_names{$locales_test_number} = 'Verify that isn\'t both [:xdigit:] and [:punct:]';
+ for (map { chr } 0..255) {