In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d730a80128abafff1e47e2506c23a8c1a06cfef4?hp=3aa3d69ac5e208c16829ec576c5f16f90681d60c>
- Log ----------------------------------------------------------------- commit d730a80128abafff1e47e2506c23a8c1a06cfef4 Author: Yves Orton <[email protected]> Date: Sun Jun 18 23:44:07 2017 +0200 add test for [perl #131522] and fix test for (related) [perl #127581] M t/re/reg_mesg.t commit bab0f8e933b383b6bef406d79c2da340bbcded33 Author: Yves Orton <[email protected]> Date: Sun Jun 18 20:45:30 2017 +0200 Resolve Perl #131522: Spurious "Assuming NOT a POSIX class" warning M regcomp.c ----------------------------------------------------------------------- Summary of changes: regcomp.c | 30 ++++++++++++++++++------------ t/re/reg_mesg.t | 4 ++-- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/regcomp.c b/regcomp.c index 8921eed4c4..0a4ea78693 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13991,6 +13991,13 @@ S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr) REPORT_LOCATION_ARGS(p))); \ } \ } STMT_END +#define CLEAR_POSIX_WARNINGS() \ + if (posix_warnings && RExC_warn_text) \ + av_clear(RExC_warn_text) + +#define CLEAR_POSIX_WARNINGS_AND_RETURN(ret) \ + CLEAR_POSIX_WARNINGS(); \ + return ret STATIC int S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, @@ -14063,7 +14070,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, * * The syntax for a legal posix class is: * - * qr/(?xa: \[ : \^? [:lower:]{4,6} : \] )/ + * qr/(?xa: \[ : \^? [[:lower:]]{4,6} : \] )/ * * What this routine considers syntactically to be an intended posix class * is this (the comments indicate some restrictions that the pattern @@ -14088,7 +14095,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, * # for it to be considered to be * # an intended posix class. * \h* - * [:punct:]? # The closing class character, + * [[:punct:]]? # The closing class character, * # possibly omitted. If not a colon * # nor semi colon, the class name * # must be even closer to a valid @@ -14131,8 +14138,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, PERL_ARGS_ASSERT_HANDLE_POSSIBLE_POSIX; - if (posix_warnings && RExC_warn_text) - av_clear(RExC_warn_text); + CLEAR_POSIX_WARNINGS(); if (p >= e) { return NOT_MEANT_TO_BE_A_POSIX_CLASS; @@ -14224,7 +14230,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, *updated_parse_ptr = (char *) temp_ptr; } - return OOB_NAMEDCLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(OOB_NAMEDCLASS); } } @@ -14294,7 +14300,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, /* We consider something like [^:^alnum:]] to not have been intended to * be a posix class, but XXX maybe we should */ if (complement) { - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } complement = 1; @@ -14321,7 +14327,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, * this leaves this construct looking like [:] or [:^], which almost * certainly weren't intended to be posix classes */ if (has_opening_bracket) { - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } /* But this function can be called when we parse the colon for @@ -14338,7 +14344,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, /* XXX We are currently very restrictive here, so this code doesn't * consider the possibility that, say, /[alpha.]]/ was intended to * be a posix class. */ - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } /* Here we have something like 'foo:]'. There was no initial colon, @@ -14508,7 +14514,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, } /* Otherwise, it can't have meant to have been a class */ - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } /* If we ran off the end, and the final character was a punctuation @@ -14558,7 +14564,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, * class name. (We can do this on the first pass, as any second pass * will yield an even shorter name) */ if (name_len < 3) { - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } /* Find which class it is. Initially switch on the length of the name. @@ -14717,7 +14723,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, } /* Here neither pass found a close-enough class name */ - return NOT_MEANT_TO_BE_A_POSIX_CLASS; + CLEAR_POSIX_WARNINGS_AND_RETURN(NOT_MEANT_TO_BE_A_POSIX_CLASS); } probably_meant_to_be: @@ -14759,7 +14765,7 @@ S_handle_possible_posix(pTHX_ RExC_state_t *pRExC_state, /* If it is a known class, return the class. The class number * #defines are structured so each complement is +1 to the normal * one */ - return class_number + complement; + CLEAR_POSIX_WARNINGS_AND_RETURN(class_number + complement); } else if (! check_only) { diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 090eccbbb4..a0b78c441d 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -221,7 +221,6 @@ my @death = '/(?[[[::]]])/' => "Syntax error in (?[...]) in regex m/(?[[[::]]])/", '/(?[[[:w:]]])/' => "Syntax error in (?[...]) in regex m/(?[[[:w:]]])/", '/(?[[:w:]])/' => "", - '/[][[:alpha:]]' => "", # [perl #127581] '/([.].*)[.]/' => "", # [perl #127582] '/[.].*[.]/' => "", # [perl #127604] '/(?[a])/' => 'Unexpected character {#} m/(?[a{#}])/', @@ -587,7 +586,8 @@ my @warning = ( 'Assuming NOT a POSIX class since a semi-colon was found instead of a colon {#} m/[foo;{#}punct;]]\x{100}/', 'Assuming NOT a POSIX class since a semi-colon was found instead of a colon {#} m/[foo;punct;]{#}]\x{100}/', ], - + '/[][[:alpha:]]/' => "", # [perl #127581] + '/[][[:alpha:]\\@\\\\^_?]/' => "", # [perl #131522] ); # See comments before this for why '\x{100}' is generally needed # These need the character 'ã' as a marker for mark_as_utf8() -- Perl5 Master Repository
