Fix ‘panic: memory wrap’ in reg_scan_name

reg_scan_name was not checking for end-of-string.  If the character it
read were not a word character, it would then increment the current
position (RExC_parse), so that the <-- HERE marker in the error mes-
sage would point to the bad character.

If we try to split a regexp like /(?</ into two pieces when the cur-
rent position is off the end like this:

 ( ? < \0
          ^

then the first ‘half’ of the regexp, before the <-- HERE marker is
"(?<\0" (including the trailing null), and the second ‘half’ is of
negative length.  Negative string lengths are what cause ‘panic: mem-
ory wrap’.

$ ./perl -Ilib -e '/(?</'
panic: memory wrap at -e line 1.

This commit takes advantage of the fact that, ever since 1f4f6bf1,
RExC_parse == name_start has never been true after a call to
reg_scan_name.  This is how reg_scan_name now signals EOS.

diff --git a/regcomp.c b/regcomp.c
index 7df5767..c9464ef 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -7265,7 +7265,9 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags)
 
     PERL_ARGS_ASSERT_REG_SCAN_NAME;
 
-    if (isIDFIRST_lazy_if(RExC_parse, UTF)) {
+    assert (RExC_parse <= RExC_end);
+    if (RExC_parse == RExC_end) NOOP;
+    else if (isIDFIRST_lazy_if(RExC_parse, UTF)) {
         /* skip IDFIRST by using do...while */
        if (UTF)
            do {
@@ -9223,13 +9225,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth)
                        SIZE_ONLY ?  /* reverse test from the others */
                        REG_RSN_RETURN_NAME : 
                        REG_RSN_RETURN_NULL);
-                   if (RExC_parse == name_start) {
-                       RExC_parse++;
-                       /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */
-                       vFAIL3("Sequence (%.*s...) not recognized", RExC_parse-seqstart, seqstart);
-                       /*NOTREACHED*/
-                    }
-                   if (*RExC_parse != paren)
+                   if (RExC_parse == name_start || *RExC_parse != paren)
                        vFAIL2("Sequence (?%c... not terminated",
                            paren=='>' ? '<' : paren);
                    if (SIZE_ONLY) {

diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index f81d8b6..70c0b01 100644 (file)
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -214,6 +214,14 @@ my @death =
  'm/a\97/' => 'Reference to nonexistent group {#} m/a\97{#}/',
  'm/(*DOOF)/' => 'Unknown verb pattern \'DOOF\' {#} m/(*DOOF){#}/',
  'm/(?&a/'  => 'Sequence (?&... not terminated {#} m/(?&a{#}/',
+ 'm/(?P=/' => 'Sequence ?P=... not terminated {#} m/(?P={#}/',
+ "m/(?'/"  => "Sequence (?'... not terminated {#} m/(?'{#}/",
+ "m/(?</"  => "Sequence (?<... not terminated {#} m/(?<{#}/",
+ 'm/(?&/'  => 'Sequence (?&... not terminated {#} m/(?&{#}/',
+ 'm/(?(</' => 'Sequence (?(<... not terminated {#} m/(?(<{#}/',
+ "m/(?('/" => "Sequence (?('... not terminated {#} m/(?('{#}/",
+ 'm/\g{/'  => 'Sequence \g{... not terminated {#} m/\g{{#}/',
+ 'm/\k</'  => 'Sequence \k<... not terminated {#} m/\k<{#}/',
 );
 
 my @death_utf8 = mark_as_utf8(