In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d6609144cb1976a0816871e44add62ea336ab4de?hp=776d1892d1402c59628f8b85b836ecd763000aa9>
- Log ----------------------------------------------------------------- commit d6609144cb1976a0816871e44add62ea336ab4de Author: Karl Williamson <[email protected]> Date: Mon Jan 12 15:21:51 2015 -0700 t/re/reg_mesg.t: White-space only Indent, and wrap lines M t/re/reg_mesg.t commit 4de2581db11ba09e07148516c5ba817a7c29b31a Author: Karl Williamson <[email protected]> Date: Mon Jan 12 15:13:02 2015 -0700 regcomp.c: Fix comment typos M regcomp.c commit f3c7620ac2e8c2e68faab8b1265a190a115a2ba2 Author: Karl Williamson <[email protected]> Date: Mon Jan 12 15:12:24 2015 -0700 dquote_static.c: Rmv obsolete comment M dquote_static.c commit 67cdf558540fcb50072632cb50aa953c0583f350 Author: Karl Williamson <[email protected]> Date: Mon Jan 5 13:17:58 2015 -0700 Add 'strict' subpragma to 'use re' This subpragma is to allow p5p to add warnings/errors for regex patterns without having to worry about backwards compatibility. And it allows users who want to have the latest checks on their code to do so. An experimental warning is raised by default when it is used, not because the subpragma might go away, but because what it catches is subject to change from release-to-release, and so the user is acknowledging that they waive the right to backwards compatibility. I will be working in the near term to make some changes to what is detected by this. Note that there is no indication in the pattern stringification that it was compiled under this. This means I didn't have to figure out how to stringify it. It is fine because using this doesn't affect what the pattern gets compiled into, if successful. And interpolating the stringified pattern under either strict or non-strict should both just work. M MANIFEST M ext/re/re.pm A ext/re/t/strict.t M pod/perldelta.pod M pod/perldiag.pod M pod/perlre.pod M pod/perlrequick.pod M pod/perlretut.pod M regcomp.c M t/re/reg_mesg.t commit af631a26a8f5a7d7136bf909c27dbba1a2d49690 Author: Karl Williamson <[email protected]> Date: Mon Jan 5 11:59:04 2015 -0700 regcomp.c: Add 'strict' parameter to S_regclass() This function has the capability to do strict checking, with the variable 'strict', but it is initialized based on another parameter's value. This commit causes 'strict' to be passed in, so it is independent of other parameters. M embed.fnc M embed.h M proto.h M regcomp.c commit d262c0c7f39a7648b418423cba7b24c6e638c4ee Author: Karl Williamson <[email protected]> Date: Sun Jan 4 21:29:10 2015 -0700 Reserve a bit for 'the re strict subpragma. This is another step in the process M op.h M op_reg_common.h M regexp.h M regnodes.h commit a4fbcc27c3bd768277fb2cfbb312f8ada31e3440 Author: Karl Williamson <[email protected]> Date: Sun Jan 4 09:55:35 2015 -0700 Add new warnings category for "use re 'strict'" This is a step in the process of adding that subpragma. M lib/B/Deparse.t M lib/warnings.pm M regen/warnings.pl M warnings.h commit 879eb60498cb197a521d2354c56143b2cff61deb Author: Karl Williamson <[email protected]> Date: Sun Jan 11 10:06:01 2015 -0700 Output warning in qr// only once This warning is being output in both passes of pattern compilation M dquote_static.c M t/lib/warnings/toke ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dquote_static.c | 4 +- embed.fnc | 5 +- embed.h | 2 +- ext/re/re.pm | 74 ++++++++++++- ext/re/t/strict.t | 66 +++++++++++ lib/B/Deparse.t | 12 +- lib/warnings.pm | 299 +++++++++++++++++++++++++------------------------- op.h | 2 +- op_reg_common.h | 16 ++- pod/perldelta.pod | 11 ++ pod/perldiag.pod | 8 ++ pod/perlre.pod | 3 + pod/perlrequick.pod | 8 ++ pod/perlretut.pod | 4 + proto.h | 2 +- regcomp.c | 36 ++++-- regen/warnings.pl | 2 + regexp.h | 2 +- regnodes.h | 6 +- t/lib/warnings/toke | 3 - t/re/reg_mesg.t | 308 +++++++++++++++++++++++++++++++++++++--------------- warnings.h | 23 ++-- 23 files changed, 611 insertions(+), 286 deletions(-) create mode 100644 ext/re/t/strict.t diff --git a/MANIFEST b/MANIFEST index fbca8eb..6223b4c 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3857,6 +3857,7 @@ ext/re/t/re_funcs_u.t See if exportable 're' funcs in universal.c work ext/re/t/regop.pl generate debug output for various patterns ext/re/t/regop.t test RE optimizations by scraping debug output ext/re/t/re.t see if re pragma works +ext/re/t/strict.t see if re 'strict' subpragma works ext/SDBM_File/biblio SDBM kit ext/SDBM_File/CHANGES SDBM kit ext/SDBM_File/COMPARE SDBM kit diff --git a/dquote_static.c b/dquote_static.c index 5fe7f0b..16227c1 100644 --- a/dquote_static.c +++ b/dquote_static.c @@ -188,7 +188,7 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg, /* Documentation to be supplied when interface nailed down finally * This returns FALSE if there is an error which the caller need not recover - * from; , otherwise TRUE. In either case the caller should look at *len + * from; , otherwise TRUE. * On input: * s is the address of a pointer to a NULL terminated string that begins * with 'x', and the previous character was a backslash. At exit, *s @@ -223,7 +223,7 @@ S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg, assert(**s == 'x'); (*s)++; - if (strict) { + if (strict || ! output_warning) { flags |= PERL_SCAN_SILENT_ILLDIGIT; } diff --git a/embed.fnc b/embed.fnc index 187d113..dc2ed43 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2121,10 +2121,11 @@ Es |void |set_ANYOF_arg |NN RExC_state_t* const pRExC_state \ Es |AV* |add_multi_match|NULLOK AV* multi_char_matches \ |NN SV* multi_string \ |const STRLEN cp_count -Es |regnode*|regclass |NN RExC_state_t *pRExC_state \ +Es |regnode*|regclass |NN RExC_state_t *pRExC_state \ |NN I32 *flagp|U32 depth|const bool stop_at_1 \ |bool allow_multi_fold \ - |const bool silence_non_portable \ + |const bool silence_non_portable \ + |const bool strict \ |NULLOK SV** ret_invlist Es |void|add_above_Latin1_folds|NN RExC_state_t *pRExC_state|const U8 cp \ |NN SV** invlist diff --git a/embed.h b/embed.h index 70cab3e..c1f98be 100644 --- a/embed.h +++ b/embed.h @@ -989,7 +989,7 @@ #define reganode(a,b,c) S_reganode(aTHX_ a,b,c) #define regatom(a,b,c) S_regatom(aTHX_ a,b,c) #define regbranch(a,b,c,d) S_regbranch(aTHX_ a,b,c,d) -#define regclass(a,b,c,d,e,f,g) S_regclass(aTHX_ a,b,c,d,e,f,g) +#define regclass(a,b,c,d,e,f,g,h) S_regclass(aTHX_ a,b,c,d,e,f,g,h) #define reginsert(a,b,c,d) S_reginsert(aTHX_ a,b,c,d) #define regnode_guts(a,b,c,d) S_regnode_guts(aTHX_ a,b,c,d) #define regpatws S_regpatws diff --git a/ext/re/re.pm b/ext/re/re.pm index bee65d2..5ddaa21 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -4,7 +4,7 @@ package re; use strict; use warnings; -our $VERSION = "0.29"; +our $VERSION = "0.30"; our @ISA = qw(Exporter); our @EXPORT_OK = ('regmust', qw(is_regexp regexp_pattern @@ -25,6 +25,7 @@ my %reflags = ( x => 1 << ($PMMOD_SHIFT + 3), n => 1 << ($PMMOD_SHIFT + 5), p => 1 << ($PMMOD_SHIFT + 6), + strict => 1 << ($PMMOD_SHIFT + 10), # special cases: d => 0, l => 1, @@ -141,6 +142,31 @@ sub bits { } elsif ($EXPORT_OK{$s}) { require Exporter; re->export_to_level(2, 're', $s); + } elsif ($s eq 'strict') { + if ($on) { + $^H{reflags} |= $reflags{$s}; + warnings::warnif('experimental::re_strict', + "\"use re 'strict'\" is experimental"); + + # Turn on warnings if not already done. + if (! warnings::enabled('regexp')) { + require warnings; + warnings->import('regexp'); + $^H{re_strict} = 1; + } + } + else { + $^H{reflags} &= ~$reflags{$s}; + + # Turn off warnings if we turned them on. + warnings->unimport('regexp') if $^H{re_strict}; + } + if ($^H{reflags}) { + $^H |= $flags_hint; + } + else { + $^H &= ~$flags_hint; + } } elsif ($s =~ s/^\///) { my $reflags = $^H{reflags} || 0; my $seen_charset; @@ -263,6 +289,8 @@ re - Perl pragma to alter regular expression behaviour # switch) } + use re 'strict'; # Raise warnings for more conditions + use re '/ix'; "FOO" =~ / foo /; # /ix implied no re '/x'; @@ -324,6 +352,50 @@ interpolation. Thus: I<is> allowed if $pat is a precompiled regular expression, even if $pat contains C<(?{ ... })> assertions or C<(??{ ... })> subexpressions. +=head2 'strict' mode + +When C<use re 'strict'> is in effect, stricter checks are applied than +otherwise when compiling regular expressions patterns. These may cause more +warnings to be raised than otherwise, and more things to be fatal instead of +just warnings. The purpose of this is to find and report at compile time some +things, which may be legal, but have a reasonable possibility of not being the +programmer's actual intent. This automatically turns on the C<"regexp"> +warnings category (if not already on) within its scope. + +As an example of something that is caught under C<"strict'> but not otherwise +is the pattern + + qr/\xABC/ + +The C<"\x"> construct without curly braces should be followed by exactly two +hex digits; this one is followed by three. This currently evaluates as +equivalent to + + qr/\x{AB}C/ + +that is, the character whose code point value is C<0xAB>, followed by the +letter C<C>. But since C<C> is a a hex digit, there is a reasonable chance +that the intent was + + qr/\x{ABC}/ + +that is the single character at C<0xABC>. Under C<'strict'> it is an error to +not follow C<\x> with exactly two hex digits. When not under C<'strict'> a +warning is generated if there is only one hex digit, and no warning is raised +if there are more than two. + +It is expected that what exactly C<'strict'> does will evolve over time as we +gain experience with it. This means that programs that compile under it in +today's Perl may not compile, or may have more or fewer warnings, in future +Perls. There is no backwards compatibility promises with regards to it. For +this reason, using it will raise a C<experimental::re_strict> class warning, +unless that category is turned off. + +Note that if a pattern compiled within C<'strict'> is recompiled, say by +interpolating into another pattern, outside of C<'strict'>, it is not checked +again for strictness. This is because if it works under strict it must work +under non-strict. + =head2 '/flags' mode When C<use re '/flags'> is specified, the given flags are automatically diff --git a/ext/re/t/strict.t b/ext/re/t/strict.t new file mode 100644 index 0000000..dd9c811 --- /dev/null +++ b/ext/re/t/strict.t @@ -0,0 +1,66 @@ +#!./perl + +# Most of the strict effects are tested for in t/re/reg_mesgs.t + +BEGIN { + require Config; + if (($Config::Config{'extensions'} !~ /\bre\b/) ){ + print "1..0 # Skip -- Perl configured without re module\n"; + exit 0; + } +} + +use strict; + +use Test::More tests => 9; +BEGIN { require_ok( 're' ); } + +{ + my @w; + no warnings; + local $SIG{__WARN__}; + BEGIN { $SIG{__WARN__} = sub { push @w, @_ } }; + qr/\b*/; + BEGIN { is(scalar @w, 0, 'No default-on warnings for qr/\b*/'); } + BEGIN {undef @w; } + + { + use re 'strict'; + qr/\b*/; + + BEGIN { is(scalar @w, 1, 'use re "strict" turns on warnings'); } + } + + BEGIN {undef @w; } + qr/\b*/; + BEGIN { is(scalar @w, 0, 'dropping out of "strict" scope reverts warnings default'); } + + { + use re 'strict'; + qr/\b*/; + + BEGIN { is(scalar @w, 1, 'use re "strict" turns on warnings'); } + + no re 'strict'; + BEGIN {undef @w; } + qr/\b*/; + BEGIN { is(scalar @w, 0, 'turning off "strict" scope reverts warnings default'); } + } + + { + use warnings 'regexp'; + BEGIN {undef @w; } + qr/\b*/; + BEGIN { is(scalar @w, 1, 'use warnings "regexp" works'); } + + use re 'strict'; + BEGIN {undef @w; } + qr/\b*/; + BEGIN { is(scalar @w, 1, 'use re "strict" keeps warnings on'); } + + no re 'strict'; + BEGIN {undef @w; } + qr/\b*/; + BEGIN { is(scalar @w, 1, 'turning off "strict" scope doesn\'t affect warnings that were already on'); } + } +} diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index d7b19c1..95a09e6 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -1857,12 +1857,12 @@ my sub f {} print f(); >>>> use feature 'lexical_subs'; -BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x55\x01"} +BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x54\x05"} my sub f { - BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x01"} + BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x04"} } -BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x01"} +BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x04"} print f(); #### # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version" @@ -1873,13 +1873,13 @@ state sub f {} print f(); >>>> use feature 'lexical_subs'; -BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x55\x01"} +BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x54\x05"} CORE::state sub f { - BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x01"} + BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x04"} use feature 'state'; } -BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x05\x01"} +BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x54\x15\x04"} use feature 'state'; print f(); #### diff --git a/lib/warnings.pm b/lib/warnings.pm index 685c036..833a899 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -94,161 +94,164 @@ our %Offsets = ( # Warnings Categories added in Perl 5.021 'everything' => 120, - 'experimental::refaliasing'=> 122, - 'experimental::win32_perlio'=> 124, - 'locale' => 126, - 'missing' => 128, - 'redundant' => 130, - 'extra' => 132, - 'void_unusual' => 134, + 'experimental::re_strict'=> 122, + 'experimental::refaliasing'=> 124, + 'experimental::win32_perlio'=> 126, + 'locale' => 128, + 'missing' => 130, + 'redundant' => 132, + 'extra' => 134, + 'void_unusual' => 136, ); our %Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x05", # [0..59,61..65] - '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] - 'everything' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..67] - '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\x14\x00", # [51..58,61,62] - '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\x04\x00", # [61] - '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\x10\x00", # [62] - 'extra' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50", # [66,67] - '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\x40\x00", # [63] - '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\x00\x01", # [64] - '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\x04", # [65] - '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] - 'void_unusual' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [67] + 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x15\x00", # [0..59,61..66] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\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\x00", # [30] + 'closed' => "\x00\x10\x00\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\x00", # [1] + 'debugging' => "\x00\x00\x00\x00\x00\x10\x00\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\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31] + 'everything' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x01", # [0..68] + 'exec' => "\x00\x40\x00\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\x00", # [3] + 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x15\x54\x00\x00", # [51..58,61..63] + 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [56] + 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [52] + 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [53] + 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [57] + 'experimental::re_strict'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00", # [61] + 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [62] + 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [54] + 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [58] + 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [55] + 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [63] + 'extra' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x01", # [67,68] + 'glob' => "\x00\x01\x00\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\x00", # [47] + 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [46] + 'inplace' => "\x00\x00\x00\x00\x00\x40\x00\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\x00", # [24] + 'io' => "\x00\x54\x55\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [5..11,59] + 'layer' => "\x00\x00\x01\x00\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\x00\x01\x00", # [64] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x04\x00\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\x00", # [12] + 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [65] + 'newline' => "\x00\x00\x04\x00\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\x00", # [48] + 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [49] + 'numeric' => "\x00\x00\x00\x04\x00\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\x00", # [14] + 'overflow' => "\x00\x00\x00\x40\x00\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\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\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\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x04\x00\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\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\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\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\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\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x40\x00\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\x10\x00", # [66] + 'regexp' => "\x00\x00\x00\x00\x00\x01\x00\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\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\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\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x10\x00\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\x00", # [27] + 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [50] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\x55\x55\x15\x00\x40\x00\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\x00", # [59] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\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\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\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\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\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\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x15\x00\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\x00", # [45] + 'void_unusual' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [68] ); our %DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xa8\x0a", # [0..59,61..65] - '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] - 'everything' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..67] - '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\x28\x00", # [51..58,61,62] - '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\x08\x00", # [61] - '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\x20\x00", # [62] - 'extra' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0", # [66,67] - '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\x80\x00", # [63] - '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\x00\x02", # [64] - '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\x08", # [65] - '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] - 'void_unusual' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [67] + 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xa8\x2a\x00", # [0..59,61..66] + 'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\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\x00", # [30] + 'closed' => "\x00\x20\x00\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\x00", # [1] + 'debugging' => "\x00\x00\x00\x00\x00\x20\x00\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\x00", # [2] + 'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31] + 'everything' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x02", # [0..68] + 'exec' => "\x00\x80\x00\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\x00", # [3] + 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\x2a\xa8\x00\x00", # [51..58,61..63] + 'experimental::autoderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [56] + 'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [52] + 'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [53] + 'experimental::postderef'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [57] + 'experimental::re_strict'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00", # [61] + 'experimental::refaliasing'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [62] + 'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [54] + 'experimental::signatures'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [58] + 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [55] + 'experimental::win32_perlio'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [63] + 'extra' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x02", # [67,68] + 'glob' => "\x00\x02\x00\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\x00", # [47] + 'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [46] + 'inplace' => "\x00\x00\x00\x00\x00\x80\x00\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\x00", # [24] + 'io' => "\x00\xa8\xaa\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [5..11,59] + 'layer' => "\x00\x00\x02\x00\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\x00\x02\x00", # [64] + 'malloc' => "\x00\x00\x00\x00\x00\x00\x08\x00\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\x00", # [12] + 'missing' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [65] + 'newline' => "\x00\x00\x08\x00\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\x00", # [48] + 'nonchar' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [49] + 'numeric' => "\x00\x00\x00\x08\x00\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\x00", # [14] + 'overflow' => "\x00\x00\x00\x80\x00\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\x00", # [16] + 'parenthesis' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\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\x00", # [10] + 'portable' => "\x00\x00\x00\x00\x08\x00\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\x00", # [33] + 'printf' => "\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\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\x00", # [35] + 'qw' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\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\x00", # [18] + 'redefine' => "\x00\x00\x00\x00\x80\x00\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\x20\x00", # [66] + 'regexp' => "\x00\x00\x00\x00\x00\x02\x00\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\x00", # [37] + 'semicolon' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\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\x00", # [21..25] + 'signal' => "\x00\x00\x00\x00\x00\x00\x20\x00\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\x00", # [27] + 'surrogate' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [50] + 'syntax' => "\x00\x00\x00\x00\x00\x00\x00\xaa\xaa\x2a\x00\x80\x00\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\x00", # [59] + 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\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\x00", # [40] + 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\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\x00", # [11] + 'unpack' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\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\x00", # [43] + 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x2a\x00\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\x00", # [45] + 'void_unusual' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [68] ); -$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\x54\x00", # [2,56,52,53,57,61,54,58,55,62,4,63,22,23,25] -$LAST_BIT = 136 ; -$BYTES = 17 ; +$NONE = "\0\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\x54\x01\x00", # [2,56,52,53,57,61,62,54,58,55,63,4,64,22,23,25] +$LAST_BIT = 138 ; +$BYTES = 18 ; $All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ; @@ -817,6 +820,8 @@ The current hierarchy is: | | | | | +- experimental::postderef | | | + | | +- experimental::re_strict + | | | | | +- experimental::refaliasing | | | | | +- experimental::regex_sets diff --git a/op.h b/op.h index 1c00168..624fa16 100644 --- a/op.h +++ b/op.h @@ -319,7 +319,7 @@ struct pmop { * allocate off the low end until you get to PMf_BASE_SHIFT+0. If that isn't * enough, move PMf_BASE_SHIFT down (if possible) and add the new bit at the * other end instead; this preserves binary compatibility. */ -#define PMf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+3) +#define PMf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+2) /* 'use re "taint"' in scope: taint $1 etc. if target tainted */ #define PMf_RETAINT (1U<<(PMf_BASE_SHIFT+5)) diff --git a/op_reg_common.h b/op_reg_common.h index 956a5b8..99f9f9d 100644 --- a/op_reg_common.h +++ b/op_reg_common.h @@ -83,22 +83,25 @@ get_regex_charset(const U32 flags) return (regex_charset) ((flags & RXf_PMf_CHARSET) >> _RXf_PMf_CHARSET_SHIFT); } -#define _RXf_PMf_SHIFT_COMPILETIME (RXf_PMf_STD_PMMOD_SHIFT+10) +#define RXf_PMf_STRICT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+10)) + +#define _RXf_PMf_SHIFT_COMPILETIME (RXf_PMf_STD_PMMOD_SHIFT+11) + /* Set in Perl_pmruntime if op_flags & OPf_SPECIAL, i.e. split. Will be used by regex engines to check whether they should set RXf_SKIPWHITE */ -#define RXf_PMf_SPLIT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+10)) +#define RXf_PMf_SPLIT (1U<<(RXf_PMf_STD_PMMOD_SHIFT+11)) /* Next available bit after the above. Name begins with '_' so won't be * exported by B */ -#define _RXf_PMf_SHIFT_NEXT (RXf_PMf_STD_PMMOD_SHIFT+11) +#define _RXf_PMf_SHIFT_NEXT (RXf_PMf_STD_PMMOD_SHIFT+12) /* Mask of the above bits. These need to be transferred from op_pmflags to * re->extflags during compilation */ -#define RXf_PMf_COMPILETIME (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_KEEPCOPY|RXf_PMf_NOCAPTURE|RXf_PMf_CHARSET) +#define RXf_PMf_COMPILETIME (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_KEEPCOPY|RXf_PMf_NOCAPTURE|RXf_PMf_CHARSET|RXf_PMf_STRICT) #define RXf_PMf_FLAGCOPYMASK (RXf_PMf_COMPILETIME|RXf_PMf_SPLIT) #if 0 /* Temporary to get Jenkins happy again */ @@ -120,9 +123,10 @@ get_regex_charset(const U32 flags) #define PMf_NOCAPTURE (1U<<5) #define PMf_KEEPCOPY (1U<<6) #define PMf_CHARSET (7U<<7) -#define PMf_SPLIT (1U<<10) +#define PMf_STRICT (1U<<10) +#define PMf_SPLIT (1U<<11) -#if PMf_MULTILINE != RXf_PMf_MULTILINE || PMf_SINGLELINE != RXf_PMf_SINGLELINE || PMf_FOLD != RXf_PMf_FOLD || PMf_EXTENDED != RXf_PMf_EXTENDED || PMf_EXTENDED_MORE != RXf_PMf_EXTENDED_MORE || PMf_KEE ... [127 chars truncated] +#if PMf_MULTILINE != RXf_PMf_MULTILINE || PMf_SINGLELINE != RXf_PMf_SINGLELINE || PMf_FOLD != RXf_PMf_FOLD || PMf_EXTENDED != RXf_PMf_EXTENDED || PMf_EXTENDED_MORE != RXf_PMf_EXTENDED_MORE || PMf_KEE ... [159 chars truncated] # error RXf_PMf defines are wrong #endif diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 4e44922..73d808c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -57,6 +57,17 @@ See L<perlre/"n"> for more information. C<prototype()> with no arguments now infers C<$_>. [perl #123514] +=head2 C<use re 'strict'> + +This applies stricter syntax rules to regular expression patterns +compiled within its scope, which hopefully will alert you to typos and +other unintentional behavior that backwards-compatibility issues prevent +us from doing in normal regular expression compilations. Because the +behavior of this is subject to change in future Perl releases as we gain +experience, using this pragma will raise a category +C<experimental:re_strict> warning. +See L<'strict' in re|re/'strict' mode>. + =head1 Security XXX Any security-related notices go here. In particular, any security diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 84577ae..650839c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -6733,6 +6733,14 @@ optimized into C<"that " . $foo>, and the warning will refer to the C<concatenation (.)> operator, even though there is no C<.> in your program. +=item "use re 'strict'" is experimental + +(S experimental::re_strict) The things that are different when a regular +expression pattern is compiled under C<'strict'> are subject to change +in future Perl releases in incompatible ways. This means that a pattern +that compiles today may not in a future Perl release. This warning is +to alert you to that risk. + =item Use \x{...} for more than two hex characters in regex; marked by S<<-- HERE> in m/%s/ diff --git a/pod/perlre.pod b/pod/perlre.pod index dfd47cd..21e0f04 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -16,6 +16,9 @@ operations, plus various examples of the same, see discussions of C<m//>, C<s///>, C<qr//> and C<??> in L<perlop/"Regexp Quote-Like Operators">. +New in v5.22, L<C<use re 'strict'>|re/'strict' mode> applies stricter +rules than otherwise when compiling regular expression patterns. It can +find things that, while legal, may not be what you intended. =head2 Modifiers diff --git a/pod/perlrequick.pod b/pod/perlrequick.pod index 008ef33..30c3238 100644 --- a/pod/perlrequick.pod +++ b/pod/perlrequick.pod @@ -495,6 +495,14 @@ the matched substrings from the groupings as well: Since the first character of $x matched the regex, C<split> prepended an empty initial element to the list. +=head2 C<use re 'strict'> + +New in v5.22, this applies stricter rules than otherwise when compiling +regular expression patterns. It can find things that, while legal, may +not be what you intended. + +See L<'strict' in re|re/'strict' mode>. + =head1 BUGS None. diff --git a/pod/perlretut.pod b/pod/perlretut.pod index 957b296..c5d8891 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -49,6 +49,10 @@ is harder to pronounce. The Perl pod documentation is evenly split on regexp vs regex; in Perl, there is more than one way to abbreviate it. We'll use regexp in this tutorial. +New in v5.22, L<C<use re 'strict'>|re/'strict' mode> applies stricter +rules than otherwise when compiling regular expression patterns. It can +find things that, while legal, may not be what you intended. + =head1 Part 1: The basics =head2 Simple word matching diff --git a/proto.h b/proto.h index 58724ac..f113827 100644 --- a/proto.h +++ b/proto.h @@ -7103,7 +7103,7 @@ STATIC regnode* S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 fir #define PERL_ARGS_ASSERT_REGBRANCH \ assert(pRExC_state); assert(flagp) -STATIC regnode* S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, const bool stop_at_1, bool allow_multi_fold, const bool silence_non_portable, SV** ret_invlist) +STATIC regnode* S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, const bool stop_at_1, bool allow_multi_fold, const bool silence_non_portable, const bool strict, SV** ret_invlist) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_REGCLASS \ diff --git a/regcomp.c b/regcomp.c index cb6322a..0b2abf7 100644 --- a/regcomp.c +++ b/regcomp.c @@ -184,6 +184,7 @@ struct RExC_state_t { scan_frame *frame_head; scan_frame *frame_last; U32 frame_count; + U32 strict; #ifdef ADD_TO_REGEXEC char *starttry; /* -Dr: where regtry was called. */ #define RExC_starttry (pRExC_state->starttry) @@ -253,6 +254,7 @@ struct RExC_state_t { #define RExC_frame_head (pRExC_state->frame_head) #define RExC_frame_last (pRExC_state->frame_last) #define RExC_frame_count (pRExC_state->frame_count) +#define RExC_strict (pRExC_state->strict) /* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set * a flag to disable back-off on the fixed/floating substrings - if it's @@ -6532,6 +6534,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_uni_semantics = 0; RExC_contains_locale = 0; RExC_contains_i = 0; + RExC_strict = cBOOL(pm_flags & RXf_PMf_STRICT); pRExC_state->runtime_code_qr = NULL; RExC_frame_head= NULL; RExC_frame_last= NULL; @@ -11648,6 +11651,7 @@ tryagain: FALSE, /* means parse the whole char class */ TRUE, /* allow multi-char folds */ FALSE, /* don't silence non-portable warnings. */ + RExC_strict, NULL); if (*RExC_parse != ']') { RExC_parse = oregcomp_parse; @@ -11883,6 +11887,7 @@ tryagain: FALSE, /* don't silence non-portable warnings. It would be a bug if these returned non-portables */ + RExC_strict, NULL); /* regclass() can only return RESTART_UTF8 if multi-char folds are allowed. */ @@ -12257,7 +12262,7 @@ tryagain: &result, &error_msg, PASS2, /* out warnings */ - FALSE, /* not strict */ + RExC_strict, TRUE, /* Output warnings for non- portables */ @@ -12286,8 +12291,8 @@ tryagain: &result, &error_msg, PASS2, /* out warnings */ - FALSE, /* not strict */ - TRUE, /* Output warnings + RExC_strict, + TRUE, /* Silence warnings for non- portables */ UTF); @@ -12320,8 +12325,8 @@ tryagain: * from \1 - \9 is a backreference, any multi-digit * escape which does not start with 0 and which when * evaluated as decimal could refer to an already - * parsed capture buffer is a backslash. Anything else - * is octal. + * parsed capture buffer is a back reference. Anything + * else is octal. * * Note this implies that \118 could be interpreted as * 118 OR as "\11" . "8" depending on whether there @@ -13178,7 +13183,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, posix class */ FALSE, /* don't allow multi-char folds */ TRUE, /* silence non-portable warnings. */ - ¤t)) + TRUE, /* strict */ + ¤t + )) FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf"", (UV) *flagp); @@ -13345,7 +13352,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, TRUE, /* means parse just the next thing */ FALSE, /* don't allow multi-char folds */ FALSE, /* don't silence non-portable warnings. */ - ¤t)) + TRUE, /* strict */ + ¤t + )) FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf"", (UV) *flagp); /* regclass() will return with parsing just the \ sequence, @@ -13368,7 +13377,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, only if not a posix class */ FALSE, /* don't allow multi-char folds */ FALSE, /* don't silence non-portable warnings. */ - ¤t)) + TRUE, /* strict */ + ¤t + )) FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf"", (UV) *flagp); /* function call leaves parse pointing to the ']', except if we @@ -13569,7 +13580,9 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, TRUE, /* silence non-portable warnings. The above may very well have generated non-portable code points, but they're valid on this machine */ - NULL); + FALSE, /* similarly, no need for strict */ + NULL + ); if (!node) FAIL2("panic: regclass returned NULL to handle_sets, flags=%#"UVxf, PTR2UV(flagp)); @@ -13705,7 +13718,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, const bool silence_non_portable, /* Don't output warnings about too large characters */ - SV** ret_invlist) /* Return an inversion list, not a node */ + const bool strict, + SV** ret_invlist /* Return an inversion list, not a node */ + ) { /* parse a bracketed class specification. Most of these will produce an * ANYOF node; but something like [a] will produce an EXACT node; [aA], an @@ -13762,7 +13777,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, char * stop_ptr = RExC_end; /* where to stop parsing */ const bool skip_white = cBOOL(ret_invlist); /* ignore unescaped white space? */ - const bool strict = cBOOL(ret_invlist); /* Apply strict parsing rules? */ /* Unicode properties are stored in a swash; this holds the current one * being parsed. If this swash is the only above-latin1 component of the diff --git a/regen/warnings.pl b/regen/warnings.pl index a6b8c02..2c23c46 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -104,6 +104,8 @@ my $tree = { [ 5.021, DEFAULT_ON ], 'experimental::refaliasing' => [ 5.021, DEFAULT_ON ], + 'experimental::re_strict' => + [ 5.021, DEFAULT_ON ], }], 'missing' => [ 5.021, DEFAULT_OFF], diff --git a/regexp.h b/regexp.h index 3348e17..eb114e9 100644 --- a/regexp.h +++ b/regexp.h @@ -391,7 +391,7 @@ and check for NULL. * For the regexp bits, PL_reg_extflags_name[] in regnodes.h has a comment * giving which bits are used/unused */ -#define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT + 3) +#define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT + 2) /* What we have seen */ #define RXf_NO_INPLACE_SUBST (1U<<(RXf_BASE_SHIFT+2)) diff --git a/regnodes.h b/regnodes.h index 94616a6..439fa8d 100644 --- a/regnodes.h +++ b/regnodes.h @@ -642,7 +642,7 @@ EXTCONST char * const PL_reg_name[] = { EXTCONST char * PL_reg_extflags_name[]; #else EXTCONST char * const PL_reg_extflags_name[] = { - /* Bits in extflags defined: 11111111111111110000011111111111 */ + /* Bits in extflags defined: 11111111111111110000111111111111 */ "MULTILINE", /* 0x00000001 */ "SINGLELINE", /* 0x00000002 */ "FOLD", /* 0x00000004 */ @@ -653,8 +653,8 @@ EXTCONST char * const PL_reg_extflags_name[] = { "CHARSET0", /* 0x00000080 : "CHARSET" - 0x00000380 */ "CHARSET1", /* 0x00000100 : "CHARSET" - 0x00000380 */ "CHARSET2", /* 0x00000200 : "CHARSET" - 0x00000380 */ - "SPLIT", /* 0x00000400 */ - "UNUSED_BIT_11", /* 0x00000800 */ + "STRICT", /* 0x00000400 */ + "SPLIT", /* 0x00000800 */ "UNUSED_BIT_12", /* 0x00001000 */ "UNUSED_BIT_13", /* 0x00002000 */ "UNUSED_BIT_14", /* 0x00004000 */ diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index cf0d020..4e15f75 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -1480,11 +1480,8 @@ print "aq" =~ m[^a\[a-z\]$], "H\n"; print "aq" =~ m(^a\(q\)$), "I\n"; EXPECT Illegal hexadecimal digit '\' ignored at - line 5. -Illegal hexadecimal digit '\' ignored at - line 5. -Illegal hexadecimal digit '\' ignored at - line 7. Illegal hexadecimal digit '\' ignored at - line 7. Illegal hexadecimal digit '\' ignored at - line 9. -Illegal hexadecimal digit '\' ignored at - line 9. A B 1C diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index e61e8ef..d322943 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -57,7 +57,9 @@ utf8::encode($utf8); sub mark_as_utf8 { my @ret; - while ( my ($pat, $msg) = splice(@_, 0, 2) ) { + for (my $i = 0; $i < @_; $i += 2) { + my $pat = $_[$i]; + my $msg = $_[$i+1]; my $l1_pat = $pat =~ s/$utf8/$l1/gr; my $l1_msg; $pat = "use utf8; $pat"; @@ -240,6 +242,90 @@ my @death = '/((?# This is a comment in the middle of a token)*FAIL)/' => 'In \'(*VERB...)\', the \'(\' and \'*\' must be adjacent {#} m/((?# This is a comment in the middle of a token)*{#}FAIL)/', ); +# These are messages that are warnings when not strict; death under 'use re +# "strict". See comment before @warnings as to why some have a \x{100} in +# them. This array has 3 elements per construct. [0] is the regex to use; +# [1] is the message under no strict, and [2] is under strict. +my @death_only_under_strict = ( + 'm/\xABC/' => "", + => 'Use \x{...} for more than two hex characters {#} m/\xABC{#}/', + 'm/[\xABC]/' => "", + => 'Use \x{...} for more than two hex characters {#} m/[\xABC{#}]/', + + # XXX This is a confusing error message. The G isn't ignored; it just + # terminates the \x. Also some messages below are missing the <-- HERE, + # aren't all category 'regexp'. (Hence we have to turn off 'digit' + # messages as well below) + 'm/\xAG/' => 'Illegal hexadecimal digit \'G\' ignored', + => 'Non-hex character {#} m/\xAG{#}/', + 'm/[\xAG]/' => 'Illegal hexadecimal digit \'G\' ignored', + => 'Non-hex character {#} m/[\xAG{#}]/', + 'm/\o{789}/' => 'Non-octal character \'8\'. Resolved as "\o{7}"', + => 'Non-octal character {#} m/\o{78{#}9}/', + 'm/[\o{789}]/' => 'Non-octal character \'8\'. Resolved as "\o{7}"', + => 'Non-octal character {#} m/[\o{78{#}9}]/', + 'm/\x{}/' => "", + => 'Number with no digits {#} m/\x{}{#}/', + 'm/[\x{}]/' => "", + => 'Number with no digits {#} m/[\x{}{#}]/', + 'm/\x{ABCDEFG}/' => 'Illegal hexadecimal digit \'G\' ignored', + => 'Non-hex character {#} m/\x{ABCDEFG{#}}/', + 'm/[\x{ABCDEFG}]/' => 'Illegal hexadecimal digit \'G\' ignored', + => 'Non-hex character {#} m/[\x{ABCDEFG{#}}]/', + 'm/[[:ascii]]/' => "", + => 'Unmatched \':\' in POSIX class {#} m/[[:ascii{#}]]/', + 'm/[\N{}]/' => 'Ignoring zero length \\N{} in character class {#} m/[\\N{}{#}]/', + => 'Zero length \\N{} {#} m/[\\N{}]{#}/', + "m'[\\y]\\x{100}'" => 'Unrecognized escape \y in character class passed through {#} m/[\y{#}]\x{100}/', + => 'Unrecognized escape \y in character class {#} m/[\y{#}]\x{100}/', + 'm/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', + => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', + 'm/[\w-x]\x{100}/' => 'False [] range "\w-" {#} m/[\w-{#}x]\x{100}/', + => 'False [] range "\w-" {#} m/[\w-{#}x]\x{100}/', + 'm/[a-\pM]\x{100}/' => 'False [] range "a-\pM" {#} m/[a-\pM{#}]\x{100}/', + => 'False [] range "a-\pM" {#} m/[a-\pM{#}]\x{100}/', + 'm/[\pM-x]\x{100}/' => 'False [] range "\pM-" {#} m/[\pM-{#}x]\x{100}/', + => 'False [] range "\pM-" {#} m/[\pM-{#}x]\x{100}/', + 'm/[^\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[^\N{U+100.300}{#}]/', + => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[^\N{U+100.300{#}}]/', + 'm/[\x03-\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\x03-\N{U+100.300}{#}]/', + => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[\x03-\N{U+100.300{#}}]/', + 'm/[\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}-\x{10FFFF}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\N{U+100.300}{#}-\x{10FFFF}]/', + => '\N{} in inverted character class or as a range end-point is restricted to one character {#} m/[\N{U+100.300{#}}-\x{10FFFF}]/', + '/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/', + => 'Need exactly 3 octal digits {#} m/[\08{#}]/', + '/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/', + => 'Need exactly 3 octal digits {#} m/[\018{#}]/', + '/[\_\0]/' => "", + => 'Need exactly 3 octal digits {#} m/[\_\0]{#}/', + '/[\07]/' => "", + => 'Need exactly 3 octal digits {#} m/[\07]{#}/', + '/[\0005]/' => "", + => 'Need exactly 3 octal digits {#} m/[\0005]{#}/', + '/[\8\9]\x{100}/' => ['Unrecognized escape \8 in character class passed through {#} m/[\8{#}\9]\x{100}/', + 'Unrecognized escape \9 in character class passed through {#} m/[\8\9{#}]\x{100}/', + ], + => 'Unrecognized escape \8 in character class {#} m/[\8{#}\9]\x{100}/', + '/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', + => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', + '/[\d-b]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}b]\x{100}/', + => 'False [] range "\d-" {#} m/[\d-{#}b]\x{100}/', + '/[\s-\d]\x{100}/' => 'False [] range "\s-" {#} m/[\s-{#}\d]\x{100}/', + => 'False [] range "\s-" {#} m/[\s-{#}\d]\x{100}/', + '/[\d-\s]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}\s]\x{100}/', + => 'False [] range "\d-" {#} m/[\d-{#}\s]\x{100}/', + '/[a-[:digit:]]\x{100}/' => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]\x{100}/', + => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]\x{100}/', + '/[[:digit:]-b]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]\x{100}/', + => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]\x{100}/', + '/[[:alpha:]-[:digit:]]\x{100}/' => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]\x{100}/', + => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]\x{100}/', + '/[[:digit:]-[:alpha:]]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/', + => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/', + '/[a\zb]\x{100}/' => 'Unrecognized escape \z in character class passed through {#} m/[a\z{#}b]\x{100}/', + => 'Unrecognized escape \z in character class {#} m/[a\z{#}b]\x{100}/', +); + # These need the character 'ã' as a marker for mark_as_utf8() my @death_utf8 = mark_as_utf8( '/ã[[=ã=]]ã/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/ã[[=ã=]{#}]ã/', @@ -323,6 +409,22 @@ my @death_utf8 = mark_as_utf8( ); push @death, @death_utf8; +my @death_utf8_only_under_strict = ( + "m'ã[\\y]ã'" => 'Unrecognized escape \y in character class passed through {#} m/ã[\y{#}]ã/', + => 'Unrecognized escape \y in character class {#} m/ã[\y{#}]ã/', + 'm/ã[ã-\d]ã/' => 'False [] range "ã-\d" {#} m/ã[ã-\d{#}]ã/', + => 'False [] range "ã-\d" {#} m/ã[ã-\d{#}]ã/', + 'm/ã[\w-ã]ã/' => 'False [] range "\w-" {#} m/ã[\w-{#}ã]ã/', + => 'False [] range "\w-" {#} m/ã[\w-{#}ã]ã/', + 'm/ã[ã-\pM]ã/' => 'False [] range "ã-\pM" {#} m/ã[ã-\pM{#}]ã/', + => 'False [] range "ã-\pM" {#} m/ã[ã-\pM{#}]ã/', + '/ã[ã-[:digit:]]ã/' => 'False [] range "ã-[:digit:]" {#} m/ã[ã-[:digit:]{#}]ã/', + => 'False [] range "ã-[:digit:]" {#} m/ã[ã-[:digit:]{#}]ã/', + '/ã[\d-\s]ã/' => 'False [] range "\d-" {#} m/ã[\d-{#}\s]ã/', + => 'False [] range "\d-" {#} m/ã[\d-{#}\s]ã/', + '/ã[a\zb]ã/' => 'Unrecognized escape \z in character class passed through {#} m/ã[a\z{#}b]ã/', + => 'Unrecognized escape \z in character class {#} m/ã[a\z{#}b]ã/', +); # Tests involving a user-defined charnames translator are in pat_advanced.t # In the following arrays of warnings, the value can be an array of things to @@ -338,20 +440,10 @@ push @death, @death_utf8; my @warning = ( 'm/\b*\x{100}/' => '\b* matches null string many times {#} m/\b*{#}\x{100}/', 'm/[:blank:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:blank:]{#}\x{100}/', - "m'[\\y]\\x{100}'" => 'Unrecognized escape \y in character class passed through {#} m/[\y{#}]\x{100}/', - 'm/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', - 'm/[\w-x]\x{100}/' => 'False [] range "\w-" {#} m/[\w-{#}x]\x{100}/', - 'm/[a-\pM]\x{100}/' => 'False [] range "a-\pM" {#} m/[a-\pM{#}]\x{100}/', - 'm/[\pM-x]\x{100}/' => 'False [] range "\pM-" {#} m/[\pM-{#}x]\x{100}/', - 'm/[^\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[^\N{U+100.300}{#}]/', - 'm/[\x03-\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\x03-\N{U+100.300}{#}]/', - 'm/[\N{LATIN CAPITAL LETTER A WITH MACRON AND GRAVE}-\x{10FFFF}]/' => 'Using just the first character returned by \N{} in character class {#} m/[\N{U+100.300}{#}-\x{10FFFF}]/', "m'\\y\\x{100}'" => 'Unrecognized escape \y passed through {#} m/\y{#}\x{100}/', '/x{3,1}/' => 'Quantifier {n,m} with n > m can\'t match {#} m/x{3,1}{#}/', '/\08/' => '\'\08\' resolved to \'\o{0}8\' {#} m/\08{#}/', '/\018/' => '\'\018\' resolved to \'\o{1}8\' {#} m/\018{#}/', - '/[\08]/' => '\'\08\' resolved to \'\o{0}8\' {#} m/[\08{#}]/', - '/[\018]/' => '\'\018\' resolved to \'\o{1}8\' {#} m/[\018{#}]/', '/(?=a)*/' => '(?=a)* matches null string many times {#} m/(?=a)*{#}/', 'my $x = \'\m\'; qr/a$x/' => 'Unrecognized escape \m passed through {#} m/a\m{#}/', '/\q/' => 'Unrecognized escape \q passed through {#} m/\q{#}/', @@ -364,26 +456,11 @@ my @warning = ( '/(a|b)(?=a){3}\x{100}/' => 'Quantifier unexpected on zero-length expression in regex m/(a|b)(?=a){3}\x{100}/', '/\_/' => "", - '/[\_\0]/' => "", - '/[\07]/' => "", '/[\006]/' => "", - '/[\0005]/' => "", - '/[\8\9]\x{100}/' => ['Unrecognized escape \8 in character class passed through {#} m/[\8{#}\9]\x{100}/', - 'Unrecognized escape \9 in character class passed through {#} m/[\8\9{#}]\x{100}/', - ], '/[:alpha:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:alpha:]{#}\x{100}/', '/[:zog:]\x{100}/' => 'POSIX syntax [: :] belongs inside character classes {#} m/[:zog:]{#}\x{100}/', '/[.zog.]\x{100}/' => 'POSIX syntax [. .] belongs inside character classes {#} m/[.zog.]{#}\x{100}/', '/[a-b]/' => "", - '/[a-\d]\x{100}/' => 'False [] range "a-\d" {#} m/[a-\d{#}]\x{100}/', - '/[\d-b]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}b]\x{100}/', - '/[\s-\d]\x{100}/' => 'False [] range "\s-" {#} m/[\s-{#}\d]\x{100}/', - '/[\d-\s]\x{100}/' => 'False [] range "\d-" {#} m/[\d-{#}\s]\x{100}/', - '/[a-[:digit:]]\x{100}/' => 'False [] range "a-[:digit:]" {#} m/[a-[:digit:]{#}]\x{100}/', - '/[[:digit:]-b]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}b]\x{100}/', - '/[[:alpha:]-[:digit:]]\x{100}/' => 'False [] range "[:alpha:]-" {#} m/[[:alpha:]-{#}[:digit:]]\x{100}/', - '/[[:digit:]-[:alpha:]]\x{100}/' => 'False [] range "[:digit:]-" {#} m/[[:digit:]-{#}[:alpha:]]\x{100}/', - '/[a\zb]\x{100}/' => 'Unrecognized escape \z in character class passed through {#} m/[a\z{#}b]\x{100}/', '/(?c)\x{100}/' => 'Useless (?c) - use /gc modifier {#} m/(?c{#})\x{100}/', '/(?-c)\x{100}/' => 'Useless (?-c) - don\'t use /gc modifier {#} m/(?-c{#})\x{100}/', '/(?g)\x{100}/' => 'Useless (?g) - use /g modifier {#} m/(?g{#})\x{100}/', @@ -413,13 +490,6 @@ my @warnings_utf8 = mark_as_utf8( 'm/ã\b*ã/' => '\b* matches null string many times {#} m/ã\b*{#}ã/', '/(?=ã)*/' => '(?=ã)* matches null string many times {#} m/(?=ã)*{#}/', 'm/ã[:foo:]ã/' => 'POSIX syntax [: :] belongs inside character classes {#} m/ã[:foo:]{#}ã/', - "m'ã[\\y]ã'" => 'Unrecognized escape \y in character class passed through {#} m/ã[\y{#}]ã/', - 'm/ã[ã-\d]ã/' => 'False [] range "ã-\d" {#} m/ã[ã-\d{#}]ã/', - 'm/ã[\w-ã]ã/' => 'False [] range "\w-" {#} m/ã[\w-{#}ã]ã/', - 'm/ã[ã-\pM]ã/' => 'False [] range "ã-\pM" {#} m/ã[ã-\pM{#}]ã/', - '/ã[ã-[:digit:]]ã/' => 'False [] range "ã-[:digit:]" {#} m/ã[ã-[:digit:]{#}]ã/', - '/ã[\d-\s]ã/' => 'False [] range "\d-" {#} m/ã[\d-{#}\s]ã/', - '/ã[a\zb]ã/' => 'Unrecognized escape \z in character class passed through {#} m/ã[a\z{#}b]ã/', '/ã(?c)ã/' => 'Useless (?c) - use /gc modifier {#} m/ã(?c{#})ã/', '/utf8 ã (?ogc) ã/' => [ 'Useless (?o) - use /o modifier {#} m/utf8 ã (?o{#}gc) ã/', @@ -450,68 +520,126 @@ my @deprecated = ( '/(?xxxx:abc)/' => 'Having more than one /x regexp modifier is deprecated', ); -while (my ($regex, $expect) = splice @death, 0, 2) { - my $expect = fixup_expect($expect); - no warnings 'experimental::regex_sets'; - # skip the utf8 test on EBCDIC since they do not die - next if $::IS_EBCDIC && $regex =~ /utf8/; - - warning_is(sub { - $_ = "x"; - eval $regex; - like($@, qr/\Q$expect/, $regex); - }, undef, "... and died without any other warnings"); +for my $strict ("", "use re 'strict';") { + + # First time just use @death; but under strict we add the things that fail + # there. Doing it this way makes sure that 'strict' doesnt change the + # things that are already fatal when not under strict. + if ($strict) { + for (my $i = 0; $i < @death_only_under_strict; $i += 3) { + push @death, $death_only_under_strict[$i], # The regex + $death_only_under_strict[$i+2]; # The fatal msg + } + for (my $i = 0; $i < @death_utf8_only_under_strict; $i += 3) { + + # Same with the utf8 versions + push @death, mark_as_utf8($death_utf8_only_under_strict[$i], + $death_utf8_only_under_strict[$i+2]); + } + } + for (my $i = 0; $i < @death; $i += 2) { + my $regex = $death[$i]; + my $expect = fixup_expect($death[$i+1]); + no warnings 'experimental::regex_sets'; + no warnings 'experimental::re_strict'; + # skip the utf8 test on EBCDIC since they do not die + #next if $::IS_EBCDIC && $regex =~ /utf8/; + + warning_is(sub { + my $eval_string = "$strict $regex"; + $_ = "x"; + eval $eval_string; + like($@, qr/\Q$expect/, $eval_string); + }, undef, "... and died without any other warnings"); + } } -foreach my $ref (\@warning, \@experimental_regex_sets, \@deprecated) { - my $warning_type = ($ref == \@warning) - ? 'regexp' - : ($ref == \@deprecated) - ? 'regexp, deprecated' - : 'experimental::regex_sets'; - while (my ($regex, $expect) = splice @$ref, 0, 2) { - my @expect = fixup_expect($expect); - { - $_ = "x"; - no warnings; - eval $regex; +for my $strict ("no warnings 'experimental::re_strict'; use re 'strict';", "") { + + # First time through we use strict to make sure that that doesn't change + # any of the warnings into fatal, and outputs them correctly. The second + # time we don't use strict, and add the messages that are warnings when + # not under strict to the list of warnings. This checks that non-strict + # works. + if (! $strict) { + for (my $i = 0; $i < @death_only_under_strict; $i += 3) { + push @warning, $death_only_under_strict[$i], # The regex + $death_only_under_strict[$i+1]; # The warning } - if (is($@, "", "$regex did not die")) { - my @got = capture_warnings(sub { - $_ = "x"; - eval $regex }); - my $count = @expect; - if (! is(scalar @got, scalar @expect, "... and gave expected number ($count) of warnings")) { - if (@got < @expect) { - $count = @got; - note "Expected warnings not gotten:\n\t" . join "\n\t", @expect[$count .. $#expect]; - } - else { - note "Unexpected warnings gotten:\n\t" . join("\n\t", @got[$count .. $#got]); - } + for (my $i = 0; $i < @death_utf8_only_under_strict; $i += 3) { + push @warning, mark_as_utf8($death_utf8_only_under_strict[$i], + $death_utf8_only_under_strict[$i+1]); + } + } + + foreach my $ref (\@warning, \@experimental_regex_sets, \@deprecated) { + my $warning_type; + my $default_on; + if ($ref == \@warning) { + $warning_type = 'regexp, digit'; + $default_on = $strict; + } + elsif ($ref == \@deprecated) { + $warning_type = 'regexp, deprecated'; + $default_on = 1; + } + else { + $warning_type = 'experimental::regex_sets'; + $default_on = 1; + } + for (my $i = 0; $i < @$ref; $i += 2) { + my $regex = $ref->[$i]; + my @expect = fixup_expect($ref->[$i+1]); + { + $_ = "x"; + eval "$strict no warnings; $regex"; } - foreach my $i (0 .. $count - 1) { - if (! like($got[$i], qr/\Q$expect[$i]/, "... and gave expected warning")) { - chomp($got[$i]); - chomp($expect[$i]); - diag("GOT\n'$got[$i]'\nEXPECT\n'$expect[$i]'"); + if (is($@, "", "$strict $regex did not die")) { + my @got = capture_warnings(sub { + $_ = "x"; + eval "$strict $regex" }); + my $count = @expect; + if (! is(scalar @got, scalar @expect, + "... and gave expected number ($count) of warnings")) + { + if (@got < @expect) { + $count = @got; + note "Expected warnings not gotten:\n\t" . join "\n\t", + @expect[$count .. $#expect]; + } + else { + note "Unexpected warnings gotten:\n\t" . join("\n\t", + @got[$count .. $#got]); + } } - else { - ok (0 == capture_warnings(sub { - $_ = "x"; - eval "no warnings '$warning_type'; $regex;" } - ), - "... and turning off '$warning_type' warnings suppressed it"); - # Test that whether the warning is on by default is - # correct. Experimental and deprecated warnings are; - # others are not. This test relies on the fact that we - # are outside the scope of any âuse warningsâ. - local $^W; - my $on = 'on' x ($warning_type ne 'regexp'); - ok !!$on == - capture_warnings(sub { $_ = "x"; eval $regex }), - "... and the warning is " . ($on||'off') - . " by default"; + foreach my $i (0 .. $count - 1) { + if (! like($got[$i], qr/\Q$expect[$i]/, + "... and gave expected warning")) + { + chomp($got[$i]); + chomp($expect[$i]); + diag("GOT\n'$got[$i]'\nEXPECT\n'$expect[$i]'"); + } + else { + ok (0 == capture_warnings(sub { + $_ = "x"; + eval "$strict no warnings '$warning_type'; $regex;" } + ), + "... and turning off '$warning_type' warnings suppressed it"); + + # Test that whether the warning is on by default is + # correct. This test relies on the fact that we + # are outside the scope of any âuse warningsâ. + local $^W; + my @warns = capture_warnings(sub { $_ = "x"; + eval "$strict $regex" }); + if ($default_on) { + ok @warns > 0, "... and the warning is on by default"; + } + else { + ok @warns == 0, "... and the warning is off by default"; + } + } } } } diff --git a/warnings.h b/warnings.h index 323e5c8..a079c38 100644 --- a/warnings.h +++ b/warnings.h @@ -105,17 +105,18 @@ /* Warnings Categories added in Perl 5.021 */ #define WARN_EVERYTHING 60 -#define WARN_EXPERIMENTAL__REFALIASING 61 -#define WARN_EXPERIMENTAL__WIN32_PERLIO 62 -#define WARN_LOCALE 63 -#define WARN_MISSING 64 -#define WARN_REDUNDANT 65 -#define WARN_EXTRA 66 -#define WARN_VOID_UNUSUAL 67 - -#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 WARN_EXPERIMENTAL__RE_STRICT 61 +#define WARN_EXPERIMENTAL__REFALIASING 62 +#define WARN_EXPERIMENTAL__WIN32_PERLIO 63 +#define WARN_LOCALE 64 +#define WARN_MISSING 65 +#define WARN_REDUNDANT 66 +#define WARN_EXTRA 67 +#define WARN_VOID_UNUSUAL 68 + +#define WARNsize 18 +#define WARN_ALLstring "\125\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\0" #define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) -- Perl5 Master Repository
