In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/663d437af9b7e1191e696b500650bce9e74fde08?hp=1e8db68a2c3919cf9d6a13d441408c3b71cb7464>
- Log ----------------------------------------------------------------- commit 663d437af9b7e1191e696b500650bce9e74fde08 Author: Karl Williamson <[email protected]> Date: Tue Nov 4 09:24:38 2014 -0700 perllocale: Nits and clarifications M pod/perllocale.pod commit 852b6749a72fd021129086ef7b4474195e2ebf33 Author: Karl Williamson <[email protected]> Date: Fri Oct 31 15:28:20 2014 -0600 lib/locale.t: Add knowledge about known bad locales Some platforms currently have locale tests that always fail due to platform-specific problems. For example, we know that some Lithuanian locales fail on Darwin because of a bad symbolic link there. This commit adds the capability for locale.t to know about such issues and not fail because of them. M lib/locale.t commit 3d3a881c1b0eb9c855d257a2eea1f72666e30fbc Author: Karl Williamson <[email protected]> Date: Mon Oct 27 21:18:45 2014 -0600 Raise warnings for poorly supported locales Perl only supports single-byte locales (except for UTF-8 ones), and has poor support for 7-bit locales that aren't supersets of ASCII (these should be exceedingly rare these days). This commit raises warnings in the new locale warning category when such a locale is entered. M locale.c M pod/perldelta.pod M pod/perldiag.pod M pod/perllocale.pod commit 0a5f4cb66924ede010109ddfdee419d80088a80b Author: Karl Williamson <[email protected]> Date: Mon Oct 27 21:16:10 2014 -0600 perldiag: Remove message that is not raised This message isn't raised these days. M pod/perldiag.pod commit f809440b17ffdfe5eae57d5448d30f3ce6a72874 Author: Karl Williamson <[email protected]> Date: Mon Oct 27 21:02:38 2014 -0600 Add 'locale' warning category This category will be used in future commits for warnings that are entirely because of locale issues. M lib/locale.pm M lib/warnings.pm M regen/warnings.pl M t/op/caller.t M warnings.h ----------------------------------------------------------------------- Summary of changes: lib/locale.pm | 2 +- lib/locale.t | 64 +++++++++++-- lib/warnings.pm | 275 +++++++++++++++++++++++++++-------------------------- locale.c | 82 ++++++++++++++++ pod/perldelta.pod | 6 ++ pod/perldiag.pod | 43 ++++----- pod/perllocale.pod | 46 +++++++-- regen/warnings.pl | 3 +- t/op/caller.t | 4 +- warnings.h | 11 ++- 10 files changed, 351 insertions(+), 185 deletions(-) diff --git a/lib/locale.pm b/lib/locale.pm index 886fb3b..61e77c7 100644 --- a/lib/locale.pm +++ b/lib/locale.pm @@ -1,6 +1,6 @@ package locale; -our $VERSION = '1.04'; +our $VERSION = '1.05'; use Config; $Carp::Internal{ (__PACKAGE__) } = 1; diff --git a/lib/locale.t b/lib/locale.t index 54dbd38..cb0873a 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -40,6 +40,13 @@ my $acceptable_failure_percentage = ($^O =~ / ^ ( AIX ) $ /ix) # The list of test numbers of the problematic tests. my %problematical_tests; +# If any %problematical_tests fails in one of these locales, it is +# considered a TODO. +my %known_bad_locales = ( + irix => qr/ ^ (?: cs | hu | sk ) $/x, + darwin => qr/ ^ lt_LT.ISO8859 /ix, + os390 => qr/ ^ italian /ix, + ); use Dumpvalue; @@ -722,6 +729,7 @@ my %posixes; my %Problem; my %Okay; +my %Known_bad_locale; # Failed test for a locale known to be bad my %Testing; my @Added_alpha; # Alphas that aren't in the C locale. my %test_names; @@ -867,11 +875,14 @@ sub report_result { my ($Locale, $i, $pass_fail, $message) = @_; $message //= ""; $message = " ($message)" if $message; - unless ($pass_fail) { + if ($pass_fail) { + push @{$Okay{$i}}, $Locale; + } + else { + $Known_bad_locale{$i}{$Locale} = 1 if exists $known_bad_locales{$^O} + && $Locale =~ $known_bad_locales{$^O}; $Problem{$i}{$Locale} = 1; debug "failed $i ($test_names{$i}) with locale '$Locale'$message\n"; - } else { - push @{$Okay{$i}}, $Locale; } } @@ -2222,11 +2233,15 @@ my $final_locales_test_number = $locales_test_number; # Recount the errors. +TEST_NUM: foreach $test_num ($first_locales_test_number..$final_locales_test_number) { if (%setlocale_failed) { print "not "; } - elsif ($Problem{$test_num} || !defined $Okay{$test_num} || !@{$Okay{$test_num}}) { + elsif ($Problem{$test_num} + || ! defined $Okay{$test_num} + || ! @{$Okay{$test_num}}) + { if (defined $not_necessarily_a_problem_test_number && $test_num == $not_necessarily_a_problem_test_number) { @@ -2234,16 +2249,40 @@ foreach $test_num ($first_locales_test_number..$final_locales_test_number) { print "# It usually indicates a problem in the environment,\n"; print "# not in Perl itself.\n"; } - if ($Okay{$test_num} && grep { $_ == $test_num } keys %problematical_tests) { + + # If there are any locales that pass this test, or are known-bad, it + # may be that there are enough passes that we TODO the failure. + if (($Okay{$test_num} || $Known_bad_locale{$test_num}) + && grep { $_ == $test_num } keys %problematical_tests) + { no warnings 'experimental::autoderef'; + + # Don't count the known-bad failures when calculating the + # percentage that fail. + my $known_failures = (exists $Known_bad_locale{$test_num}) + ? scalar(keys $Known_bad_locale{$test_num}) + : 0; + my $adjusted_failures = scalar(keys $Problem{$test_num}) + - $known_failures; + + # Specially handle failures where only known-bad locales fail. + # This makes the diagnositics clearer. + if ($adjusted_failures <= 0) { + print "not ok $test_num $test_names{$test_num} # TODO fails only on ", + "known bad locales: ", + join " ", keys $Known_bad_locale{$test_num}, "\n"; + next TEST_NUM; + } + # Round to nearest .1% - my $percent_fail = (int(.5 + (1000 * scalar(keys $Problem{$test_num}) + my $percent_fail = (int(.5 + (1000 * $adjusted_failures / scalar(@Locale)))) / 10; if ($percent_fail < $acceptable_failure_percentage) { if (! $debug) { $test_names{$test_num} .= 'TODO'; - print "# ", 100 - $percent_fail, "% of locales pass the following test, so it is likely that the failures\n"; + print "# ", 100 - $percent_fail, "% of locales not known to be problematic on this platform\n"; + print "# pass the following test, so it is likely that the failures\n"; print "# are errors in the locale definitions. The test is marked TODO, as the\n"; print "# problem is not likely to be Perl's\n"; } @@ -2418,6 +2457,12 @@ my $didwarn = 0; foreach ($first_locales_test_number..$final_locales_test_number) { if ($Problem{$_}) { my @f = sort keys %{ $Problem{$_} }; + + # Don't list the failures caused by known-bad locales. + if (exists $known_bad_locales{$^O}) { + @f = grep { $_ !~ $known_bad_locales{$^O} } @f; + next unless @f; + } my $f = join(" ", @f); $f =~ s/(.{50,60}) /$1\n#\t/g; print @@ -2496,6 +2541,11 @@ if ($didwarn) { } } +if (exists $known_bad_locales{$^O} && ! %Known_bad_locale) { + $test_num++; + print "ok $test_num $^O no longer has known bad locales # TODO\n"; +} + print "1..$test_num\n"; # eof diff --git a/lib/warnings.pm b/lib/warnings.pm index 05a1198..c86909c 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = '1.28'; +our $VERSION = '1.29'; # Verify that we're called correctly so that warnings will work. # see also strict.pm. @@ -95,148 +95,151 @@ our %Offsets = ( 'experimental::refaliasing'=> 120, 'experimental::win32_perlio'=> 122, - 'missing' => 124, - 'redundant' => 126, + 'locale' => 124, + 'missing' => 126, + 'redundant' => 128, ); our %Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..63] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [29] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [30] - 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22] - 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [31] - 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x05", # [51..58,60,61] - 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [56] - 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [52] - 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [53] - 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [57] - 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [60] - 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [54] - 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [58] - 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [55] - 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [61] - 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] - 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [47] - 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [46] - 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23] - 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24] - 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [5..11,59] - 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25] - 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [62] - 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [48] - 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [49] - 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [32] - 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [33] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [34] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [35] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [36] - 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18] - 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19] - 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [63] - 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [37] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [38] - 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25] - 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26] - 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27] - 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [50] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00", # [28..38,47] - 'syscalls' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [59] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [39] - 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [40] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [41] - 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [42] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [43] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00\x00", # [44,48..50] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [45] + 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..64] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30] + 'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] + 'closure' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] + 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22] + 'deprecated' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31] + 'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] + 'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] + 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x05\x00", # [51..58,60,61] + 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [56] + 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [52] + 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [53] + 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [57] + 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [60] + 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [54] + 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [58] + 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [55] + 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [61] + 'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] + 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [47] + 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [46] + 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23] + 'internal' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24] + 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [5..11,59] + 'layer' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'locale' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [62] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25] + 'misc' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [63] + 'newline' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [48] + 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [49] + 'numeric' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'once' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'overflow' => "\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pack' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00", # [32] + 'pipe' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17] + 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [34] + 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [36] + 'recursion' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19] + 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [64] + 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20] + 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [38] + 'severe' => "\x00\x00\x00\x00\x00\x54\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26] + 'substr' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27] + 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [50] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\x00\x00\x00\x00", # [28..38,47] + 'syscalls' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [59] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [39] + 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [41] + 'unopened' => "\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [42] + 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\x00\x00\x00", # [44,48..50] + 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [45] ); our %DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..63] - 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [29] - 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [30] - 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] - 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22] - 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [31] - 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] - 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\x0a", # [51..58,60,61] - 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [56] - 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [52] - 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [53] - 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [57] - 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [60] - 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [54] - 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [58] - 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [55] - 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [61] - 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] - 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [47] - 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [46] - 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23] - 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24] - 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [5..11,59] - 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] - 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25] - 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12] - 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [62] - 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] - 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [48] - 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [49] - 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13] - 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14] - 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15] - 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16] - 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [32] - 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] - 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17] - 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [33] - 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [34] - 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [35] - 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [36] - 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18] - 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19] - 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [63] - 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20] - 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [37] - 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [38] - 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25] - 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26] - 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27] - 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [50] - 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00", # [28..38,47] - 'syscalls' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [59] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [39] - 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [40] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [41] - 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] - 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [42] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [43] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00\x00", # [44,48..50] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [45] + 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..64] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [29] + 'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [30] + 'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6] + 'closure' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [1] + 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [22] + 'deprecated' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31] + 'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7] + 'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3] + 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\x0a\x00", # [51..58,60,61] + 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [56] + 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [52] + 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [53] + 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [57] + 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [60] + 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [54] + 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [58] + 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [55] + 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [61] + 'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4] + 'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [47] + 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [46] + 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [23] + 'internal' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [24] + 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [5..11,59] + 'layer' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [8] + 'locale' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [62] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [25] + 'misc' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [12] + 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [63] + 'newline' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [9] + 'non_unicode' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [48] + 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [49] + 'numeric' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [13] + 'once' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [14] + 'overflow' => "\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [15] + 'pack' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00", # [32] + 'pipe' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [17] + 'precedence' => "\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [34] + 'prototype' => "\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [36] + 'recursion' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [19] + 'redundant' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [64] + 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [20] + 'reserved' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [38] + 'severe' => "\x00\x00\x00\x00\x00\xa8\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [26] + 'substr' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [27] + 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [50] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\x00\x00\x00\x00", # [28..38,47] + 'syscalls' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [59] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [39] + 'threads' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [41] + 'unopened' => "\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [42] + 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\x00\x00\x00", # [44,48..50] + 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [45] ); -$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; -$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x05", # [2,56,52,53,57,60,54,58,55,61,4,22,23,25] -$LAST_BIT = 128 ; -$BYTES = 16 ; +$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; +$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x15\x15\x00", # [2,56,52,53,57,60,54,58,55,61,4,62,22,23,25] +$LAST_BIT = 130 ; +$BYTES = 17 ; $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; @@ -758,6 +761,8 @@ The current hierarchy is: | | | +- unopened | + +- locale + | +- misc | +- missing diff --git a/locale.c b/locale.c index 481628b..be15a69 100644 --- a/locale.c +++ b/locale.c @@ -280,6 +280,18 @@ Perl_new_ctype(pTHX_ const char *newctype) Copy(PL_fold_latin1, PL_fold_locale, 256, U8); } else { + /* Assume enough space for every character being bad. 4 spaces each + * for the 94 printable characters that are output like "'x' "; and 5 + * spaces each for "'\\' ", "'\t' ", and "'\n' "; plus a terminating + * NUL */ + char bad_chars_list[ (94 * 4) + (3 * 5) + 1 ]; + + bool check_for_problems = ckWARN_d(WARN_LOCALE); /* No warnings means + no check */ + bool multi_byte_locale = FALSE; /* Assume is a single-byte locale + to start */ + unsigned int bad_count = 0; /* Count of bad characters */ + for (i = 0; i < 256; i++) { if (isUPPER_LC((U8) i)) PL_fold_locale[i] = (U8) toLOWER_LC((U8) i); @@ -287,6 +299,76 @@ Perl_new_ctype(pTHX_ const char *newctype) PL_fold_locale[i] = (U8) toUPPER_LC((U8) i); else PL_fold_locale[i] = (U8) i; + + /* If checking for locale problems, see if the native ASCII-range + * printables plus \n and \t are in their expected categories in + * the new locale. If not, this could mean big trouble, upending + * Perl's and most programs' assumptions, like having a + * metacharacter with special meaning become a \w. Fortunately, + * it's very rare to find locales that aren't supersets of ASCII + * nowadays. It isn't a problem for most controls to be changed + * into something else; we check only \n and \t, though perhaps \r + * could be an issue as well. */ + if (check_for_problems + && (isGRAPH_A(i) || isBLANK_A(i) || i == '\n')) + { + if ((isALPHANUMERIC_A(i) && ! isALPHANUMERIC_LC(i)) + || (isPUNCT_A(i) && ! isPUNCT_LC(i)) + || (isBLANK_A(i) && ! isBLANK_LC(i)) + || (i == '\n' && ! isCNTRL_LC(i))) + { + if (bad_count) { /* Separate multiple entries with a + blank */ + bad_chars_list[bad_count++] = ' '; + } + bad_chars_list[bad_count++] = '\''; + if (isPRINT_A(i)) { + bad_chars_list[bad_count++] = (char) i; + } + else { + bad_chars_list[bad_count++] = '\\'; + if (i == '\n') { + bad_chars_list[bad_count++] = 'n'; + } + else { + assert(i == '\t'); + bad_chars_list[bad_count++] = 't'; + } + } + bad_chars_list[bad_count++] = '\''; + bad_chars_list[bad_count] = '\0'; + } + } + } + +#ifdef MB_CUR_MAX + /* We only handle single-byte locales (outside of UTF-8 ones; so if + * this locale has requires than one byte, there are going to be + * problems */ + if (check_for_problems && MB_CUR_MAX > 1) { + multi_byte_locale = TRUE; + } +#endif + + if (bad_count || multi_byte_locale) { + setlocale(LC_CTYPE, "C"); + Perl_warner(aTHX_ packWARN(WARN_LOCALE), + "Locale '%s' may not work well.%s%s%s\n", + newctype, + (multi_byte_locale) + ? " Some characters in it are not recognized by" + " Perl." + : "", + (bad_count) + ? "\nThe following characters (and maybe others)" + " may not have the same meaning as the Perl" + " program expects:\n" + : "", + (bad_count) + ? bad_chars_list + : "" + ); + setlocale(LC_CTYPE, newctype); } } diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 3e23064..4623ce0 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -218,6 +218,12 @@ XXX L<message|perldiag/"message"> L<Use of literal non-graphic characters in variable names is deprecated|perldiag/"Use of literal non-graphic characters in variable names is deprecated"> +=item * + +A new C<locale> warning category has been created, with only one warning +message currently in it: +L<Locale '%s' may not work well.%s|perldiag/Locale '%s' may not work well.%s> + =back =head2 Changes to Existing Diagnostics diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 4c61146..44c8aea 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2929,6 +2929,25 @@ not-a-number value). than it can reliably handle and C<localtime> probably returned the wrong date. +=item Locale '%s' may not work well.%s + +(W locale) The named locale that Perl is now trying to use is not fully +compatible with Perl. The second C<%s> gives a reason. + +By far the most common reason is that the locale has characters in it +that are represented by more than one byte. The only such locales that +Perl can handle are the UTF-8 locales. Most likely the specified locale +is a non-UTF-8 one for an East Asian language such as Chinese or +Japanese. If the locale is a superset of ASCII, the ASCII portion of it +may work in Perl. Read on for problems when it isn't a superset of +ASCII. + +Some essentially obsolete locales that aren't supersets of ASCII, mainly +those in ISO 646 or other 7-bit locales, such as ASMO 449, can also have +problems, depending on what portions of the ASCII character set get +changed by the locale and are also used by the program. +The warning message lists the determinable conflicting characters. + =item Lookbehind longer than %d not implemented in regex m/%s/ (F) There is currently a limit on the length of string which lookbehind can @@ -4661,30 +4680,6 @@ the sub name and via the prototype attribute. The prototype in parentheses is useless, since it will be replaced by the prototype from the attribute before it's ever used. -=item \p{} uses Unicode rules, not locale rules - -(W) You compiled a regular expression that contained a Unicode property -match (C<\p> or C<\P>), but the regular expression is also being told to -use the run-time locale, not Unicode. Instead, use a POSIX character -class, which should know about the locale's rules. -(See L<perlrecharclass/POSIX Character Classes>.) - -Even if the run-time locale is ISO 8859-1 (Latin1), which is a subset of -Unicode, some properties will give results that are not valid for that -subset. - -Here are a couple of examples to help you see what's going on. If the -locale is ISO 8859-7, the character at code point 0xD7 is the "GREEK -CAPITAL LETTER CHI". But in Unicode that code point means the -"MULTIPLICATION SIGN" instead, and C<\p> always uses the Unicode -meaning. That means that C<\p{Alpha}> won't match, but C<[[:alpha:]]> -should. Only in the Latin1 locale are all the characters in the same -positions as they are in Unicode. But, even here, some properties give -incorrect results. An example is C<\p{Changes_When_Uppercased}> which -is true for "LATIN SMALL LETTER Y WITH DIAERESIS", but since the upper -case of that character is not in Latin1, in that locale it doesn't -change when upper cased. - =item push on reference is experimental (S experimental::autoderef) C<push> with a scalar argument is experimental diff --git a/pod/perllocale.pod b/pod/perllocale.pod index c43ba5e..d083c09 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -191,7 +191,7 @@ follows: =item * -The current locale is also used when going outside of Perl with +The current locale is used when going outside of Perl with operations like L<system()|perlfunc/system LIST> or L<qxE<sol>E<sol>|perlop/qxE<sol>STRINGE<sol>>, if those operations are locale-sensitive. @@ -406,6 +406,10 @@ C<POSIX::setlocale()> function: # restore the old locale setlocale(LC_CTYPE, $old_locale); +This simultaneously affects all threads of the program, so it may be +problematic to use locales in threaded applications except where there +is a single locale applicable to all threads. + The first argument of C<setlocale()> gives the B<category>, the second the B<locale>. The category tells in what aspect of data processing you want to apply locale-specific rules. Category names are discussed in @@ -572,7 +576,7 @@ alphabetically in your system is called). You can test out changing these variables temporarily, and if the new settings seem to help, put those settings into your shell startup -files. Consult your local documentation for the exact details. For in +files. Consult your local documentation for the exact details. For Bourne-like shells (B<sh>, B<ksh>, B<bash>, B<zsh>): LC_ALL=en_US.ISO8859-1 @@ -584,7 +588,7 @@ locale "En_US"--and in Cshish shells (B<csh>, B<tcsh>) setenv LC_ALL en_US.ISO8859-1 -or if you have the "env" application you can do in any shell +or if you have the "env" application you can do (in any shell) env LC_ALL=en_US.ISO8859-1 perl ... @@ -847,23 +851,30 @@ information on all these.) The C<LC_CTYPE> locale also provides the map used in transliterating characters between lower and uppercase. This affects the case-mapping -functions--C<fc()>, C<lc()>, C<lcfirst()>, C<uc()>, and C<ucfirst()>; case-mapping +functions--C<fc()>, C<lc()>, C<lcfirst()>, C<uc()>, and C<ucfirst()>; +case-mapping interpolation with C<\F>, C<\l>, C<\L>, C<\u>, or C<\U> in double-quoted strings and C<s///> substitutions; and case-independent regular expression pattern matching using the C<i> modifier. Finally, C<LC_CTYPE> affects the (deprecated) POSIX character-class test functions--C<POSIX::isalpha()>, C<POSIX::islower()>, and so on. For -example, if you move from the "C" locale to a 7-bit Scandinavian one, -you may find--possibly to your surprise--that "|" moves from the +example, if you move from the "C" locale to a 7-bit ISO 646 one, +you may find--possibly to your surprise--that C<"|"> moves from the C<POSIX::ispunct()> class to C<POSIX::isalpha()>. Unfortunately, this creates big problems for regular expressions. "|" still -means alternation even though it matches C<\w>. +means alternation even though it matches C<\w>. Starting in v5.22, a +warning will be raised when such a locale is switched into. More +details are given several paragraphs further down. Starting in v5.20, Perl supports UTF-8 locales for C<LC_CTYPE>, but otherwise Perl only supports single-byte locales, such as the ISO 8859 series. This means that wide character locales, for example for Asian -languages, are not supported. The UTF-8 locale support is actually a +languages, are not well-supported. (If the platform has the capability +for Perl to detect such a locale, starting in Perl v5.22, +L<Perl will warn, default enabled|warnings/Category Hierarchy>, +using the C<locale> warning category, whenever such a locale is switched +into.) The UTF-8 locale support is actually a superset of POSIX locales, because it is really full Unicode behavior as if no locale were in effect at all (except for tainting; see L</SECURITY>). POSIX locales, even UTF-8 ones, @@ -876,11 +887,26 @@ For releases v5.16 and v5.18, C<S<use locale 'not_characters>> could be used as a workaround for this (see L</Unicode and UTF-8>). Note that there are quite a few things that are unaffected by the -current locale. All the escape sequences for particular characters, +current locale. Any literal character is the native character for the +given platform. Hence 'A' means the character at code point 65 on ASCII +platforms, and 193 on EBCDIC. That may or may not be an 'A' in the +current locale, if that locale even has an 'A'. +Similarly, all the escape sequences for particular characters, C<\n> for example, always mean the platform's native one. This means, for example, that C<\N> in regular expressions (every character but new-line) works on the platform character set. +Starting in v5.22, Perl will by default warn when switching into a +locale that redefines any ASCII printable character (plus C<\t> and +C<\n>) into a different class than expected. This is unlikely to +happen on modern locales, but can happen with the ISO 646 and other +7-bit locales that are essentially obsolete. Things may still work, +depending on what features of Perl are used by the program. For +example, in the example from above where C<"|"> becomes a C<\w>, and +there are no regular expressions where this matters, the program may +still work properly. The warning lists all the characters that +it can determine could be adversely affected. + B<Note:> A broken or malicious C<LC_CTYPE> locale definition may result in clearly ineligible characters being considered to be alphanumeric by your application. For strict matching of (mundane) ASCII letters and @@ -1514,7 +1540,7 @@ byte, and Unicode rules for those that can't is not uniformly applied. Pre-v5.12, it was somewhat haphazard; in v5.12 it was applied fairly consistently to regular expression matching except for bracketed character classes; in v5.14 it was extended to all regex matches; and in -v5.16 to the casing operations such as C<"\L"> and C<uc()>. For +v5.16 to the casing operations such as C<\L> and C<uc()>. For collation, in all releases, the system's C<strxfrm()> function is called, and whatever it does is what you get. diff --git a/regen/warnings.pl b/regen/warnings.pl index 4e3a624..96e6d06 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -108,6 +108,7 @@ my $tree = { 'missing' => [ 5.021, DEFAULT_OFF], 'redundant' => [ 5.021, DEFAULT_OFF], + 'locale' => [ 5.021, DEFAULT_ON], #'default' => [ 5.008, DEFAULT_ON ], }], @@ -477,7 +478,7 @@ read_only_bottom_close_and_rename($pm); __END__ package warnings; -our $VERSION = '1.28'; +our $VERSION = '1.29'; # Verify that we're called correctly so that warnings will work. # see also strict.pm. diff --git a/t/op/caller.t b/t/op/caller.t index e0534ba..3f94f8c 100644 --- a/t/op/caller.t +++ b/t/op/caller.t @@ -111,8 +111,8 @@ sub testwarn { # The repetition number must be set to the value of $BYTES in # lib/warnings.pm - BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 16, 'all bits off via "no warnings"' ) } - testwarn("\0" x 16, 'no bits'); + BEGIN { check_bits( ${^WARNING_BITS}, "\0" x 17, 'all bits off via "no warnings"' ) } + testwarn("\0" x 17, 'no bits'); use warnings; BEGIN { check_bits( ${^WARNING_BITS}, $default, diff --git a/warnings.h b/warnings.h index b288bd5..7495f82 100644 --- a/warnings.h +++ b/warnings.h @@ -106,12 +106,13 @@ #define WARN_EXPERIMENTAL__REFALIASING 60 #define WARN_EXPERIMENTAL__WIN32_PERLIO 61 -#define WARN_MISSING 62 -#define WARN_REDUNDANT 63 +#define WARN_LOCALE 62 +#define WARN_MISSING 63 +#define WARN_REDUNDANT 64 -#define WARNsize 16 -#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125" -#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" +#define WARNsize 17 +#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125\125" +#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" #define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) -- Perl5 Master Repository
