In perl.git, the branch smoke-me/yves_rt122283 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/246bf2f33906932b57d530468c35d4c6c18f5ab4?hp=f2468569d937468e8ba80c050b127afb0fad8387>
- Log ----------------------------------------------------------------- commit 246bf2f33906932b57d530468c35d4c6c18f5ab4 Author: Yves Orton <[email protected]> Date: Tue Sep 23 01:36:34 2014 +0200 regcomp.c: fix fencepost error in vFAIL at end of pattern If RExC_parse was after RExC_end we passed a negative length into the UTF8f macro/format, which then triggered asserts. As part of this we add a new diagnostic to show when a (?(condition)...) construct has gone unterminated, and tests for the unterminated case, thus testing that vFAIL works properly at the end of the string at the same time. M pod/perldiag.pod M regcomp.c M t/re/reg_mesg.t commit edf6216407b750d3c32db702b65d45b51ee8a7e8 Author: Yves Orton <[email protected]> Date: Tue Sep 23 01:34:27 2014 +0200 add an assert that the length arg for UTF8f is non-negative If we dont we will just hit a different more confusing assert later. In production builds we zero elen so the args is assumed empty. M sv.c ----------------------------------------------------------------------- Summary of changes: pod/perldiag.pod | 7 +++++++ regcomp.c | 11 ++++++++--- sv.c | 5 +++++ t/re/reg_mesg.t | 3 +++ 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 80a197c..366765a 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -5331,6 +5331,13 @@ it in clustering parentheses: The S<<-- HERE> shows whereabouts in the regular expression the problem was discovered. See L<perlre>. +=item Switch (?(condition)... not terminated in regex; marked by +S<<-- HERE> in m/%s/ + +(F) You ommitted to close a (?(condition)...) block somewhere in the +pattern. Add a closing parenthesis in the appropriate position. See +L<perlre>. + =item Switch condition not recognized in regex; marked by S<<-- HERE> in m/%s/ diff --git a/regcomp.c b/regcomp.c index 3e8c42e..555cca1 100644 --- a/regcomp.c +++ b/regcomp.c @@ -495,7 +495,8 @@ static const scan_data_t zero_scan_data = * Simple_vFAIL -- like FAIL, but marks the current location in the scan */ #define Simple_vFAIL(m) STMT_START { \ - const IV offset = RExC_parse - RExC_precomp; \ + const IV offset = \ + (RExC_parse > RExC_end ? RExC_end : RExC_parse) - RExC_precomp; \ Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ m, REPORT_LOCATION_ARGS(offset)); \ } STMT_END @@ -10145,8 +10146,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) } else lastbr = NULL; - if (c != ')') - vFAIL("Switch (?(condition)... contains too many branches"); + if (c != ')') { + if (RExC_parse>RExC_end) + vFAIL("Switch (?(condition)... not terminated"); + else + vFAIL("Switch (?(condition)... contains too many branches"); + } ender = reg_node(pRExC_state, TAIL); REGTAIL(pRExC_state, br, ender); if (lastbr) { diff --git a/sv.c b/sv.c index 4dede1a..9525062 100644 --- a/sv.c +++ b/sv.c @@ -11176,6 +11176,11 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p is safe. */ is_utf8 = (bool)va_arg(*args, int); elen = va_arg(*args, UV); + if ((IV)elen < 0) { + /* check if utf8 length is larger than 0 when cast to IV */ + assert( (IV)elen >= 0 ); /* in DEBUGGING build we want to crash */ + elen= 0; /* otherwise we want to treat this as an empty string */ + } eptr = va_arg(*args, char *); q += sizeof(UTF8f)-1; goto string; diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 78be9ee..347234f 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -94,6 +94,9 @@ my @death = '/(?(1x))/' => 'Switch condition not recognized {#} m/(?(1x{#}))/', '/(?(1x(?#)))/'=> 'Switch condition not recognized {#} m/(?(1x{#}(?#)))/', + '/(?(1)/' => 'Switch (?(condition)... not terminated {#} m/(?(1){#}/', + '/(?(1)x/' => 'Switch (?(condition)... not terminated {#} m/(?(1)x{#}/', + '/(?(1)x|y/' => 'Switch (?(condition)... not terminated {#} m/(?(1)x|y{#}/', '/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches {#} m/(?(1)x|y|{#}z)/', '/(?(x)y|x)/' => 'Unknown switch condition (?(...)) {#} m/(?(x{#})y|x)/', -- Perl5 Master Repository
