This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
restore error message for unterminated strings
authorLukas Mai <l.mai@web.de>
Wed, 8 Nov 2017 22:05:35 +0000 (23:05 +0100)
committerLukas Mai <l.mai@web.de>
Wed, 8 Nov 2017 22:08:02 +0000 (23:08 +0100)
The previous strchr/memchr changes inadvertently broke the error message
for perl -e '"'. Instead of

    Can't find string terminator '"' anywhere before EOF

it became

    Can't find string terminator """ anywhere before EOF

t/lib/croak/toke
toke.c

index 1a7468f..aadb447 100644 (file)
@@ -92,6 +92,11 @@ Can't find string terminator "/" anywhere before EOF at - line 1.
 EXPECT
 Can't find string terminator "'" anywhere before EOF at - line 1.
 ########
+# NAME Unterminated ""
+"
+EXPECT
+Can't find string terminator '"' anywhere before EOF at - line 1.
+########
 # NAME Unterminated q// with non-ASCII delimiter, under utf8
 BEGIN { binmode STDERR, ":utf8" }
 use utf8;
diff --git a/toke.c b/toke.c
index cfd0bdc..da3ecdb 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -556,7 +556,7 @@ S_no_op(pTHX_ const char *const what, char *s)
  */
 
 STATIC void
-S_missingterm(pTHX_ char *s, const STRLEN len)
+S_missingterm(pTHX_ char *s, STRLEN len)
 {
     char tmpbuf[UTF8_MAXBYTES + 1];
     char q;
@@ -564,8 +564,10 @@ S_missingterm(pTHX_ char *s, const STRLEN len)
     SV *sv;
     if (s) {
        char * const nl = (char *) my_memrchr(s, '\n', len);
-       if (nl)
-           *nl = '\0';
+        if (nl) {
+            *nl = '\0';
+            len = nl - s;
+        }
        uni = UTF;
     }
     else if (PL_multi_close < 32) {
@@ -573,24 +575,28 @@ S_missingterm(pTHX_ char *s, const STRLEN len)
        tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
        s = tmpbuf;
+        len = 2;
     }
     else {
        if (LIKELY(PL_multi_close < 256)) {
            *tmpbuf = (char)PL_multi_close;
            tmpbuf[1] = '\0';
+            len = 1;
        }
        else {
+            char *end = (char *)uvchr_to_utf8((U8 *)tmpbuf, PL_multi_close);
+            *end = '\0';
+            len = end - tmpbuf;
            uni = TRUE;
-           *uvchr_to_utf8((U8 *)tmpbuf, PL_multi_close) = 0;
        }
        s = tmpbuf;
     }
     q = memchr(s, '"', len) ? '\'' : '"';
-    sv = sv_2mortal(newSVpv(s,0));
+    sv = sv_2mortal(newSVpvn(s, len));
     if (uni)
        SvUTF8_on(sv);
-    Perl_croak(aTHX_ "Can't find string terminator %c%" SVf
-                    "%c anywhere before EOF",q,SVfARG(sv),q);
+    Perl_croak(aTHX_ "Can't find string terminator %c%" SVf "%c"
+                     " anywhere before EOF", q, SVfARG(sv), q);
 }
 
 #include "feature.h"