Improve handling pattern compilation errors

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 5fba4fe..6d0ab62 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3641,6 +3641,7 @@ S_scan_const(pTHX_ char *start)
                s++;
                if (*s != '{') {
                    yyerror("Missing braces on \\N{}");
+                    *d++ = '\0';
                    continue;
                }
                s++;
@@ -3652,7 +3653,7 @@ S_scan_const(pTHX_ char *start)
                    } else {
                        yyerror("Missing right brace on \\N{} or unescaped left brace after \\N");
                    }
-                   continue;
+                    yyquit(); /* Have exhausted the input. */
                }
 
                /* Here it looks like a named character */
@@ -3671,6 +3672,7 @@ S_scan_const(pTHX_ char *start)
                                 "Invalid hexadecimal number in \\N{U+...}"
                             );
                             s = e + 1;
+                            *d++ = '\0';
                             continue;
                         }
                         while (++s < e) {
@@ -3869,6 +3871,7 @@ S_scan_const(pTHX_ char *start)
                                     " in transliteration operator",
                                         /*  +1 to include the "}" */
                                     (int) (e + 1 - start), start));
+                                *d++ = '\0';
                                 goto end_backslash_N;
                             }
 
@@ -3934,15 +3937,16 @@ S_scan_const(pTHX_ char *start)
            case 'c':
                s++;
                if (s < send) {
-                   *d++ = grok_bslash_c(*s++, 1);
+                   *d++ = grok_bslash_c(*s, 1);
                }
                else {
                    yyerror("Missing control char name in \\c");
+                   yyquit();   /* Are at end of input, no sense continuing */
                }
 #ifdef EBCDIC
                 non_portable_endpoint++;
 #endif
-               continue;
+                break;
 
            /* printf-style backslashes, formfeeds, newlines, etc */
            case 'b':
@@ -5021,7 +5025,16 @@ Perl_yylex(pTHX)
            s = PL_bufend;
        }
        else {
+            int save_error_count = PL_error_count;
+
            s = scan_const(PL_bufptr);
+
+            /* Set flag if this was a pattern and there were errors.  op.c will
+             * refuse to compile a pattern with this flag set.  Otherwise, we
+             * could get segfaults, etc. */
+            if (PL_lex_inpat && PL_error_count > save_error_count) {
+                ((PMOP*)PL_lex_inpat)->op_pmflags |= PMf_HAS_ERROR;
+            }
            if (*s == '\\')
                PL_lex_state = LEX_INTERPCASEMOD;
            else
@@ -11464,6 +11477,15 @@ Perl_abort_execution(pTHX_ const char * const msg, const char * const name)
     NOT_REACHED; /* NOTREACHED */
 }
 
+void
+Perl_yyquit(pTHX)
+{
+    /* Called, after at least one error has been found, to abort the parse now,
+     * instead of trying to forge ahead */
+
+    yyerror_pvn(NULL, 0, 0);
+}
+
 int
 Perl_yyerror(pTHX_ const char *const s)
 {