[B] Merge pull request ocaml#1754 from voodoos/test-issue-1753

Test and fix wrong error with string literal in comment

CHANGES.md

@@ -3,9 +3,10 @@ merlin NEXT_VERSION
 
   + merlin binary
     - destruct: Removal of residual patterns (#1737, fixes #1560)
-    - Do not erase fields' names when destructing punned record fields (#1734, 
+    - Do not erase fields' names when destructing punned record fields (#1734,
       fixes #1661)
     - Ignore SIGPIPE in the Merlin server process (#1746)
+    - Fix lexing of quoted strings in comments (#1754, fixes #1753)
 
 merlin 4.14
 ===========

src/ocaml/preprocess/lexer_raw.mll

@@ -656,10 +656,8 @@ and comment state = parse
       state.buffer <- buffer;
       Buffer.add_char state.buffer '\"';
       comment state lexbuf }
-  | "{" ('%' '%'? extattrident blank*)? lowercase* "|"
+  | "{" ('%' '%'? extattrident blank*)? (lowercase* as delim) "|"
       {
-        let delim = Lexing.lexeme lexbuf in
-        let delim = String.sub delim ~pos:1 ~len:(String.length delim - 2) in
         state.string_start_loc <- Location.curr lexbuf;
         Buffer.add_string state.buffer (Lexing.lexeme lexbuf);
         (catch (quoted_string delim state lexbuf) (fun e l -> match e with

tests/test-dirs/errors/issue1753.t

@@ -0,0 +1,91 @@
+should be accepted
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {%ext|babar|} *)
+  > EOF
+  null
+
+should fail
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {%ext id|babar|} *)
+  > EOF
+  {
+    "start": {
+      "line": 1,
+      "col": 0
+    },
+    "end": {
+      "line": 1,
+      "col": 2
+    },
+    "type": "typer",
+    "sub": [
+      {
+        "start": {
+          "line": 1,
+          "col": 0
+        },
+        "end": {
+          "line": 1,
+          "col": 2
+        },
+        "message": "String literal begins here"
+      }
+    ],
+    "valid": true,
+    "message": "This comment contains an unterminated string literal"
+  }
+
+should accept
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {%ext id|babar|id} *)
+  > EOF
+  null
+
+should accept
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {id|babar|id} *)
+  > EOF
+  null
+
+should accept
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {|babar|} *)
+  > EOF
+  null
+
+should fail
+  $ $MERLIN single errors -filename main.ml <<'EOF' | \
+  > jq '.value[0]'
+  > (* {id|babar|} *)
+  > EOF
+  {
+    "start": {
+      "line": 1,
+      "col": 0
+    },
+    "end": {
+      "line": 1,
+      "col": 2
+    },
+    "type": "typer",
+    "sub": [
+      {
+        "start": {
+          "line": 1,
+          "col": 0
+        },
+        "end": {
+          "line": 1,
+          "col": 2
+        },
+        "message": "String literal begins here"
+      }
+    ],
+    "valid": true,
+    "message": "This comment contains an unterminated string literal"
+  }