This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
use yyerror instead of croaking immediately (RT #127993)
authorLukas Mai <l.mai@web.de>
Sat, 4 Jun 2016 11:05:36 +0000 (13:05 +0200)
committerTony Cook <tony@develop-help.com>
Mon, 6 Jun 2016 00:12:22 +0000 (10:12 +1000)
pod/perldelta.pod
pod/perldiag.pod
t/comp/parser.t
toke.c

index 69a3d53..97f8444 100644 (file)
@@ -204,7 +204,7 @@ and New Warnings
 
 =item *
 
-L<Version control conflict marker '%s'|perldiag/"Version control conflict marker '%s'">
+L<Version control conflict marker|perldiag/"Version control conflict marker">
 
 =item *
 
index fdf79c8..dae7c26 100644 (file)
@@ -7057,7 +7057,7 @@ S<<-- HERE> in m/%s/
 (F) You used a verb pattern that is not allowed an argument.  Remove the 
 argument or check that you are using the right verb.
 
-=item Version control conflict marker '%s'
+=item Version control conflict marker
 
 (F) The parser found a line starting with C<E<lt><<<<<<>,
 C<E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>>, or C<=======>. These may be left by a
index 19d49f9..efd3a8d 100644 (file)
@@ -558,11 +558,11 @@ for my $marker (qw(
 >>>>>>>
 )) {
     eval "$marker";
-    like $@, qr/^Version control conflict marker '$marker' at \(eval \d+\) line 1\./, "VCS marker '$marker' at beginning";
+    like $@, qr/^Version control conflict marker at \(eval \d+\) line 1, near "$marker"/, "VCS marker '$marker' at beginning";
     eval "\$_\n$marker";
-    like $@, qr/^Version control conflict marker '$marker' at \(eval \d+\) line 2\./, "VCS marker '$marker' after value";
+    like $@, qr/^Version control conflict marker at \(eval \d+\) line 2, near "$marker"/, "VCS marker '$marker' after value";
     eval "\n\$_ =\n$marker";
-    like $@, qr/^Version control conflict marker '$marker' at \(eval \d+\) line 3\./, "VCS marker '$marker' after operator";
+    like $@, qr/^Version control conflict marker at \(eval \d+\) line 3, near "$marker"/, "VCS marker '$marker' after operator";
 }
 
 
diff --git a/toke.c b/toke.c
index e6f6bf9..327d984 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -4422,6 +4422,26 @@ S_check_scalar_slice(pTHX_ char *s)
        pl_yylval.ival = OPpSLICEWARNING;
 }
 
+#define lex_token_boundary() S_lex_token_boundary(aTHX)
+static void
+S_lex_token_boundary(pTHX)
+{
+    PL_oldoldbufptr = PL_oldbufptr;
+    PL_oldbufptr = PL_bufptr;
+}
+
+#define vcs_conflict_marker(s) S_vcs_conflict_marker(aTHX_ s)
+static char *
+S_vcs_conflict_marker(pTHX_ char *s)
+{
+    lex_token_boundary();
+    PL_bufptr = s;
+    yyerror("Version control conflict marker");
+    while (s < PL_bufend && *s != '\n')
+       s++;
+    return s;
+}
+
 /*
   yylex
 
@@ -5992,8 +6012,10 @@ Perl_yylex(pTHX)
        {
            const char tmp = *s++;
            if (tmp == '=') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, "=====", 5))
-                   Perl_croak(aTHX_ "Version control conflict marker '%.*s'", 7, s - 2);
+               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, "=====", 5)) {
+                   s = vcs_conflict_marker(s + 5);
+                   goto retry;
+               }
                if (!PL_lex_allbrackets
                     && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
                 {
@@ -6109,8 +6131,10 @@ Perl_yylex(pTHX)
            if (s[1] != '<' && !strchr(s,'>'))
                check_uni();
            if (s[1] == '<' && s[2] != '>') {
-               if ((s == PL_linestart || s[-1] == '\n') && strnEQ(s+2, "<<<<<", 5))
-                   Perl_croak(aTHX_ "Version control conflict marker '%.*s'", 7, s);
+               if ((s == PL_linestart || s[-1] == '\n') && strnEQ(s+2, "<<<<<", 5)) {
+                   s = vcs_conflict_marker(s + 7);
+                   goto retry;
+               }
                s = scan_heredoc(s);
            }
            else
@@ -6122,8 +6146,10 @@ Perl_yylex(pTHX)
        {
            char tmp = *s++;
            if (tmp == '<') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, "<<<<<", 5))
-                   Perl_croak(aTHX_ "Version control conflict marker '%.*s'", 7, s - 2);
+               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, "<<<<<", 5)) {
+                    s = vcs_conflict_marker(s + 5);
+                   goto retry;
+               }
                if (*s == '=' && !PL_lex_allbrackets
                     && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
                 {
@@ -6164,8 +6190,10 @@ Perl_yylex(pTHX)
        {
            const char tmp = *s++;
            if (tmp == '>') {
-               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, ">>>>>", 5))
-                   Perl_croak(aTHX_ "Version control conflict marker '%.*s'", 7, s - 2);
+               if ((s == PL_linestart+2 || s[-3] == '\n') && strnEQ(s, ">>>>>", 5)) {
+                   s = vcs_conflict_marker(s + 5);
+                   goto retry;
+               }
                if (*s == '=' && !PL_lex_allbrackets
                     && PL_lex_fakeeof >= LEX_FAKEEOF_ASSIGN)
                 {
@@ -11827,14 +11855,6 @@ Perl_parse_stmtseq(pTHX_ U32 flags)
     return stmtseqop;
 }
 
-#define lex_token_boundary() S_lex_token_boundary(aTHX)
-static void
-S_lex_token_boundary(pTHX)
-{
-    PL_oldoldbufptr = PL_oldbufptr;
-    PL_oldbufptr = PL_bufptr;
-}
-
 #define parse_opt_lexvar() S_parse_opt_lexvar(aTHX)
 static OP *
 S_parse_opt_lexvar(pTHX)