5 files changed, 54 insertions, 31 deletions

diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml
index da1adbf..c165d03 100644
--- a/lib/qparser/analyzer.ml
+++ b/lib/qparser/analyzer.ml
@@ -16,27 +16,39 @@ let parse :
 
     let init = Parser.Incremental.main (fst (Lexbuf.positions l)) in
 
-    IncrementalParser.of_lexbuf lexer l init
-    |> Result.map_error (fun e ->
-           let message =
-             match e.IncrementalParser.code with
-             | Interpreter.InvalidSyntax -> "Invalid Syntax"
-             | Interpreter.UnrecoverableError -> "UnrecoverableError"
-             | Interpreter.MenhirCode c ->
-                 let message_content =
-                   try Parser_messages.message c
-                   with Not_found ->
-                     String.concat "" [ "(Error code "; string_of_int c; ")" ]
-                 in
+    let evaluation =
+      try IncrementalParser.of_lexbuf lexer l init
+      with Lexer.UnclosedQuote ->
+        let start_pos, end_pos = Lexbuf.positions l in
+        let err =
+          IncrementalParser.
+            { code = Interpreter.Custom "Unclosed text"; start_pos; end_pos }
+        in
+        Error err
+    in
 
-                 String.concat "" [ String.trim @@ message_content ]
-           in
-           let report =
-             Qsp_syntax.Report.error (e.start_pos, e.end_pos) message
-           in
+    Result.map_error
+      (fun e ->
+        let message =
+          match e.IncrementalParser.code with
+          | Interpreter.InvalidSyntax -> "Invalid Syntax"
+          | Interpreter.UnrecoverableError -> "UnrecoverableError"
+          | Interpreter.Custom msg -> msg
+          | Interpreter.MenhirCode c ->
+              let message_content =
+                try Parser_messages.message c
+                with Not_found ->
+                  String.concat "" [ "(Error code "; string_of_int c; ")" ]
+              in
 
-           (* Discard the remaining file to read. The parser is now in a blank
-              state, it does not make sense to keep feeding it with the new
-              tokens. *)
-           Lexer.discard l;
-           report)
+              String.concat "" [ String.trim @@ message_content ]
+        in
+        let report = Qsp_syntax.Report.error (e.start_pos, e.end_pos) message in
+
+        (* Discard the remaining file to read. The parser is now in a blank
+           state, it does not make sense to keep feeding it with the new
+           tokens. *)
+        let () = try Lexer.discard l with _ -> () in
+
+        report)
+      evaluation
diff --git a/lib/qparser/interpreter.ml b/lib/qparser/interpreter.ml
index b719600..219ba11 100644
--- a/lib/qparser/interpreter.ml
+++ b/lib/qparser/interpreter.ml
@@ -9,7 +9,11 @@
     case of invalid syntax.
  *)
 
-type error_code = UnrecoverableError | InvalidSyntax | MenhirCode of int
+type error_code =
+  | UnrecoverableError
+  | InvalidSyntax
+  | MenhirCode of int
+  | Custom of string
 
 module Interpreter (MI : MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE) =
 struct
diff --git a/lib/qparser/lexbuf.ml b/lib/qparser/lexbuf.ml
index 3f0b186..8a3e41c 100644
--- a/lib/qparser/lexbuf.ml
+++ b/lib/qparser/lexbuf.ml
@@ -18,7 +18,10 @@ let start : t -> unit =
   t.expression_level <- 0
 
 let positions : t -> Lexing.position * Lexing.position =
- fun t -> Sedlexing.lexing_positions t.buffer
+ fun t ->
+  let default, end_p = Sedlexing.lexing_positions t.buffer in
+  let start_p = Option.value ~default t.start_p in
+  (start_p, end_p)
 
 let content : t -> string = fun t -> Sedlexing.Utf8.lexeme t.buffer
 
@@ -27,7 +30,12 @@ let from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t =
   { buffer = t; start_p = None; expression_level = 0; reset_line }
 
 let set_start_position : t -> Lexing.position -> unit =
- fun t position -> t.start_p <- Some position
+ fun t position ->
+  match t.start_p with
+  | None -> t.start_p <- Some position
+  | _ ->
+      (* We are already inside a block code, don’t stack it *)
+      ()
 
 let tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position
     =
@@ -39,6 +47,7 @@ let tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position
     let default, curr_p = positions t in
 
     let start_p = Option.value ~default t.start_p in
+    t.start_p <- None;
 
     (token, start_p, curr_p)
   in
diff --git a/lib/qparser/lexer.ml b/lib/qparser/lexer.ml
index c643577..3e1c05b 100644
--- a/lib/qparser/lexer.ml
+++ b/lib/qparser/lexer.ml
@@ -4,7 +4,7 @@
 
 open Tokens
 
-exception UnclosedQuote of { content : string; line : int }
+exception UnclosedQuote
 exception LexError of Lexing.position * string
 exception EOF
 
@@ -29,13 +29,10 @@ let wait_balance : (Buffer.t -> Lexbuf.t -> 'a) -> Lexbuf.t -> 'a =
   let _, position = Lexbuf.positions lexbuf in
   Lexbuf.set_start_position lexbuf position;
 
-  try[@warning "-52"]
+  try
     let token = rule (Buffer.create 256) lexbuf in
     token
-  with Failure "lexing: empty token" ->
-    let position, _ = Lexbuf.positions lexbuf in
-    let line = position.Lexing.pos_lnum and content = Lexbuf.content lexbuf in
-    (raise (UnclosedQuote { line; content }) [@warning "+52"])
+  with Not_found -> raise UnclosedQuote
 
 let space = [%sedlex.regexp? ' ' | '\t']
 let eol = [%sedlex.regexp? '\r' | '\n' | "\r\n"]
diff --git a/lib/qparser/lexer.mli b/lib/qparser/lexer.mli
index 585877c..41ecb16 100644
--- a/lib/qparser/lexer.mli
+++ b/lib/qparser/lexer.mli
@@ -1,4 +1,5 @@
 exception EOF
+exception UnclosedQuote
 
 val token : Lexbuf.t -> Tokens.token
 val discard : Lexbuf.t -> unit