From e2006b78ee5901fa2bc0240b10eb9201d910ab9b Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 17 Mar 2020 03:16:50 +0700 Subject: [PATCH] Keep parsing locations for toplevel commands instead of recomputing lines and columns --- CHANGES.md | 1 + bin/pp.ml | 13 ++++- bin/test/main.ml | 58 ++++++++----------- lib/block.ml | 42 ++++++-------- lib/block.mli | 12 +--- lib/lexer_mdx.mll | 31 +++------- lib/lexer_top.mll | 30 ++++++---- lib/mli_parser.ml | 22 +++++-- lib/mli_parser.mli | 4 -- lib/toplevel.ml | 49 ++++++---------- lib/toplevel.mli | 23 ++------ .../expect/spaces/test_case.ml.expected | 2 +- .../cram-command-syntax/test-case.t.expected | 2 +- .../cram-empty-line/test-case.t.expected | 2 +- .../failure/in-toplevel/test-case.md.expected | 2 +- .../ml-file-not-found/test-case.md.expected | 2 +- .../part-not-ended/test-case.md.expected | 2 +- .../part-not-found/test-case.md.expected | 2 +- .../part-not-opened/test-case.md.expected | 2 +- test/lib/test_block.ml | 2 +- test/lib/test_dep.ml | 4 +- test/lib/test_mli_parser.ml | 26 ++++----- 22 files changed, 148 insertions(+), 185 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 150a7b726..b9fd2dd5b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,7 @@ - Report `#require` directive errors (#276, @gpetiot) - Handle no such file exception: the input file and the values of options `--root` and `--prelude` are checked (#292, @gpetiot) +- Keep locations from parsing instead of recomputing the lines, providing better error messages (#241, @gpetiot) #### Security diff --git a/bin/pp.ml b/bin/pp.ml index c4b8c7690..f2b70f75a 100644 --- a/bin/pp.ml +++ b/bin/pp.ml @@ -20,6 +20,13 @@ let src = Logs.Src.create "cram.pp" module Log = (val Logs.src_log src : Logs.LOG) +let vpad_of_lines t = + let rec aux i = function + | h :: t when String.trim h = "" -> aux (i + 1) t + | _ -> i + in + aux 0 t + let run (`Setup ()) (`File file) (`Section section) = Mdx.parse_file Normal file >>! fun t -> let t = @@ -32,6 +39,7 @@ let run (`Setup ()) (`File file) (`Section section) = match t with | [] -> 1 | _ -> + let rvpad = ref 1 in List.iter (function | Mdx.Section _ | Text _ -> () @@ -43,7 +51,10 @@ let run (`Setup ()) (`File file) (`Section section) = match b.value with | Toplevel _ -> Fmt.pr "%a\n" pp_lines contents | OCaml _ -> - Fmt.pr "%a\n%a\n" Mdx.Block.pp_line_directive (file, b.line) + let vpad = vpad_of_lines contents in + rvpad := vpad + !rvpad; + let line = b.loc.loc_start.pos_lnum + !rvpad in + Fmt.pr "%a\n%a\n" Mdx.Block.pp_line_directive (file, line) pp_lines contents | _ -> () )) t; diff --git a/bin/test/main.ml b/bin/test/main.ml index 135294cf4..232e74642 100644 --- a/bin/test/main.ml +++ b/bin/test/main.ml @@ -18,6 +18,7 @@ open Mdx open Compat open Result open Astring +open Migrate_ast open Mdx.Util.Result.Infix let src = Logs.Src.create "cram.test" @@ -84,14 +85,12 @@ let run_test ?root blacklist temp_file t = match snd (Unix.waitpid [] pid) with WEXITED n -> n | _ -> 255 let root_dir ?root ?block () = - match block with - | Some t -> ( - match Mdx.Block.directory t with - | Some d -> ( - match root with - | Some r -> Some (r / d) - | None -> Some (Filename.dirname t.file / d) ) - | None -> root ) + match (block : Block.t option) with + | Some { dir = None; _ } -> root + | Some { dir = Some d; loc = { loc_start = { pos_fname; _ }; _ }; _ } -> ( + match root with + | Some r -> Some (r / d) + | None -> Some (Filename.dirname pos_fname / d) ) | None -> root let resolve_root file dir root = @@ -123,11 +122,10 @@ let run_cram_tests ?syntax t ?root ppf temp_file pad tests = tests; Block.pp_footer ?syntax ppf t -let eval_test ?block ?root c test = - Log.debug (fun l -> - l "eval_test %a" Fmt.(Dump.list (Fmt.fmt "%S")) (Toplevel.command test)); +let eval_test ?block ?root c cmd = + Log.debug (fun l -> l "eval_test %a" Fmt.(Dump.list (Fmt.fmt "%S")) cmd); let root = root_dir ?root ?block () in - with_dir root (fun () -> Mdx_top.eval c (Toplevel.command test)) + with_dir root (fun () -> Mdx_top.eval c cmd) let err_eval ~cmd lines = Fmt.epr "Got an error while evaluating:\n---\n%a\n---\n%a\n%!" @@ -137,13 +135,10 @@ let err_eval ~cmd lines = lines; exit 1 -let eval_raw ?block ?root c ~line lines = - let test = - Toplevel.{ vpad = 0; hpad = 0; line; command = lines; output = [] } - in - match eval_test ?block ?root c test with +let eval_raw ?block ?root c cmd = + match eval_test ?block ?root c cmd with | Ok _ -> () - | Error e -> err_eval ~cmd:lines e + | Error e -> err_eval ~cmd e let split_lines lines = let aux acc s = @@ -153,17 +148,14 @@ let split_lines lines = in List.fold_left aux [] (List.rev lines) -let eval_ocaml ~block ?syntax ?root c ppf ~line lines errors = - let test = - Toplevel.{ vpad = 0; hpad = 0; line; command = lines; output = [] } - in +let eval_ocaml ~block ?syntax ?root c ppf cmd errors = let update ~errors = function | { Block.value = OCaml v; _ } as b -> { b with value = OCaml { v with errors } } (* [eval_ocaml] only called on OCaml blocks *) | _ -> assert false in - match eval_test ?root ~block c test with + match eval_test ?root ~block c cmd with | Ok _ -> Block.pp ?syntax ppf (update ~errors:[] block) | Error lines -> let errors = @@ -184,8 +176,8 @@ let lines = function Ok x | Error x -> x let run_toplevel_tests ?syntax ?root c ppf tests t = Block.pp_header ?syntax ppf t; List.iter - (fun test -> - let lines = lines (eval_test ?root ~block:t c test) in + (fun (test : Toplevel.t) -> + let lines = lines (eval_test ?root ~block:t c test.command) in let lines = split_lines lines in let output = let output = List.map output_from_line lines in @@ -304,8 +296,7 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic) let det () = assert (syntax <> Some Cram); Mdx_top.in_env env (fun () -> - eval_ocaml ~block:t ?syntax ?root c ppf ~line:t.line t.contents - errors) + eval_ocaml ~block:t ?syntax ?root c ppf t.contents errors) in with_non_det non_deterministic non_det ~command:print_block ~output:det ~det @@ -323,18 +314,17 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic) | Toplevel { non_det; env } -> let tests = let syntax = Util.Option.value syntax ~default:Normal in - Toplevel.of_lines ~syntax ~file:t.file ~line:t.line ~column:t.column - t.contents + Toplevel.of_lines ~syntax ~loc:t.loc t.contents in with_non_det non_deterministic non_det ~command:print_block ~output:(fun () -> assert (syntax <> Some Cram); print_block (); List.iter - (fun test -> + (fun (test : Toplevel.t) -> match Mdx_top.in_env env (fun () -> - eval_test ~block:t ?root c test) + eval_test ~block:t ?root c test.command) with | Ok _ -> () | Error e -> @@ -354,7 +344,7 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic) let buf = Buffer.create (String.length file_contents + 1024) in let ppf = Format.formatter_of_buffer buf in let envs = Document.envs items in - let eval lines () = eval_raw ?root c ~line:0 lines in + let eval lines () = eval_raw ?root c lines in let eval_in_env lines env = Mdx_top.in_env env (eval lines) in List.iter (function @@ -391,8 +381,8 @@ let report_error_in_block block msg = | Cram _ -> "cram " | Toplevel _ -> "toplevel " in - Fmt.epr "Error in the %scode block in %s at line %d:@]\n%s\n" kind block.file - block.line msg + Fmt.epr "%a: Error in the %scode block@]\n%s\n" Location.print_loc block.loc + kind msg let run setup non_deterministic silent_eval record_backtrace syntax silent verbose_findlib prelude prelude_str file section root force_output output : diff --git a/lib/block.ml b/lib/block.ml index 3dfcdab92..0edbcd2e9 100644 --- a/lib/block.ml +++ b/lib/block.ml @@ -16,6 +16,7 @@ open Result open Compat +open Migrate_ast open Util.Result.Infix module Header = struct @@ -74,9 +75,7 @@ type value = | Include of include_value type t = { - line : int; - column : int; - file : string; + loc : Location.t; section : section option; dir : string option; source_trees : string list; @@ -111,12 +110,11 @@ let dump_value ppf = function | Toplevel _ -> Fmt.string ppf "Toplevel" | Include _ -> Fmt.string ppf "Include" -let dump ppf ({ file; line; column; section; labels; contents; value; _ } as b) - = +let dump ppf ({ loc; section; labels; contents; value; _ } as b) = Fmt.pf ppf - "{@[file: %s;@ line: %d;@ column: %d;@ section: %a;@ labels: %a;@ header: \ - %a;@\n\ - \ contents: %a;@ value: %a@]}" file line column + "{@[loc: %a;@ section: %a;@ labels: %a;@ header: %a;@ contents: %a;@ \ + value: %a@]}" + Location.print_loc loc Fmt.(Dump.option dump_section) section Fmt.Dump.(list Label.pp) @@ -130,7 +128,8 @@ let pp_lines syntax t = let pp = match syntax with | Some Syntax.Cram -> Fmt.fmt " %s" - | Some Syntax.Mli -> fun ppf -> Fmt.fmt "%*s%s" ppf (t.column + 2) "" + | Some Syntax.Mli -> + fun ppf -> Fmt.fmt "%*s%s" ppf (t.loc.loc_start.pos_cnum + 2) "" | _ -> Fmt.string in Fmt.(list ~sep:(unit "\n") pp) @@ -276,18 +275,16 @@ let executable_contents ~syntax b = | OCaml _ -> b.contents | Raw _ | Cram _ | Include _ -> [] | Toplevel _ -> - let phrases = - Toplevel.of_lines ~syntax ~file:b.file ~line:b.line ~column:b.column - b.contents - in + let phrases = Toplevel.of_lines ~syntax ~loc:b.loc b.contents in List.flatten (List.map - (fun t -> - match Toplevel.command t with + (fun (t : Toplevel.t) -> + match t.command with | [] -> [] | cs -> let mk s = String.make (t.hpad + 2) ' ' ^ s in - line_directive (b.file, t.line) :: List.map mk cs) + line_directive (t.pos.pos_fname, t.pos.pos_lnum) + :: List.map mk cs) phrases) in if contents = [] || ends_by_semi_semi contents then contents @@ -437,8 +434,7 @@ let infer_block ~config ~header ~contents ~errors = >>= fun () -> check_no_errors errors >>| fun () -> Raw { header } ) -let mk ~line ~file ~column ~section ~labels ~legacy_labels ~header ~contents - ~errors = +let mk ~loc ~section ~labels ~legacy_labels ~header ~contents ~errors = let block_kind = get_label (function Block_kind x -> Some x | _ -> None) labels in @@ -452,9 +448,7 @@ let mk ~line ~file ~column ~section ~labels ~legacy_labels ~header ~contents >>= fun value -> version_enabled config.version >>| fun version_enabled -> { - line; - file; - column; + loc; section; dir = config.dir; source_trees = config.source_trees; @@ -469,12 +463,12 @@ let mk ~line ~file ~column ~section ~labels ~legacy_labels ~header ~contents value; } -let mk_include ~line ~file ~column ~section ~labels = +let mk_include ~loc ~section ~labels = match get_label (function File x -> Some x | _ -> None) labels with | Some file_inc -> let header = Header.infer_from_file file_inc in - mk ~line ~file ~column ~section ~labels ~legacy_labels:false ~header - ~contents:[] ~errors:[] + mk ~loc ~section ~labels ~legacy_labels:false ~header ~contents:[] + ~errors:[] | None -> label_required ~label:"file" ~kind:"include" let is_active ?section:s t = diff --git a/lib/block.mli b/lib/block.mli index f22941f09..4f44a83cf 100644 --- a/lib/block.mli +++ b/lib/block.mli @@ -75,9 +75,7 @@ type section = int * string (** The type for sections. *) type t = { - line : int; - column : int; - file : string; + loc : Location.t; section : section option; dir : string option; source_trees : string list; @@ -95,9 +93,7 @@ type t = { (** The type for supported code blocks. *) val mk : - line:int -> - file:string -> - column:int -> + loc:Location.t -> section:section option -> labels:Label.t list -> legacy_labels:bool -> @@ -107,9 +103,7 @@ val mk : (t, [ `Msg of string ]) Result.result val mk_include : - line:int -> - file:string -> - column:int -> + loc:Location.t -> section:section option -> labels:Label.t list -> (t, [ `Msg of string ]) Result.result diff --git a/lib/lexer_mdx.mll b/lib/lexer_mdx.mll index e90c028ba..7ff24abd5 100644 --- a/lib/lexer_mdx.mll +++ b/lib/lexer_mdx.mll @@ -5,11 +5,7 @@ open Migrate_ast type token = [ `Block of Block.t | `Section of int * string | `Text of string ] -let line_ref = ref 1 - -let newline lexbuf = - Lexing.new_line lexbuf; - incr line_ref +let newline lexbuf = Lexing.new_line lexbuf let labels l = match Label.of_string l with @@ -48,15 +44,13 @@ rule text section = parse | "..." -> `Ellipsis | _ -> `Output x) e in - let file = lexbuf.Lexing.lex_start_p.Lexing.pos_fname in - let column = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum in newline lexbuf; - let line = !line_ref in List.iter (fun _ -> newline lexbuf) contents; + let loc = Location.curr lexbuf in newline lexbuf; let block = match - Block.mk ~file ~line ~column ~section ~header ~contents ~labels + Block.mk ~loc ~section ~header ~contents ~labels ~legacy_labels ~errors with | Ok block -> block @@ -71,13 +65,10 @@ rule text section = parse `Block block :: text section lexbuf } | "" ws* eol { let labels = labels label_cmt in - let file = lexbuf.Lexing.lex_start_p.Lexing.pos_fname in - let column = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum in - newline lexbuf; - let line = !line_ref in newline lexbuf; + let loc = Location.curr lexbuf in let block = - match Block.mk_include ~file ~line ~column ~section ~labels with + match Block.mk_include ~loc ~section ~labels with | Ok block -> block | Error (`Msg msg) -> failwith msg in @@ -105,14 +96,12 @@ and cram_text section = parse let contents = first_line :: contents in let labels = [] in let legacy_labels = false in - let file = lexbuf.Lexing.lex_start_p.Lexing.pos_fname in - let column = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum in - let line = !line_ref in + let loc = Location.curr lexbuf in List.iter (fun _ -> newline lexbuf) contents; let rest = cram_text section lexbuf in let block = match - Block.mk ~file ~line ~column ~section ~header ~contents ~labels + Block.mk ~loc ~section ~header ~contents ~labels ~legacy_labels ~errors:[] with | Ok block -> block @@ -129,15 +118,13 @@ and cram_text section = parse | Error (`Msg msg) -> failwith msg in let legacy_labels = false in - let file = lexbuf.Lexing.lex_start_p.Lexing.pos_fname in - let column = lexbuf.Lexing.lex_start_p.Lexing.pos_cnum in newline lexbuf; - let line = !line_ref in + let loc = Location.curr lexbuf in List.iter (fun _ -> newline lexbuf) contents; let rest = cram_text section lexbuf in let block = match - Block.mk ~file ~line ~column ~section ~header ~contents ~labels + Block.mk ~loc ~section ~header ~contents ~labels ~legacy_labels ~errors:[] with | Ok block -> block diff --git a/lib/lexer_top.mll b/lib/lexer_top.mll index d45c818d1..63b2084b0 100644 --- a/lib/lexer_top.mll +++ b/lib/lexer_top.mll @@ -1,29 +1,35 @@ +{ +let newline lexbuf = Lexing.new_line lexbuf +} + let eol = '\n' | eof let ws = ' ' | '\t' rule token = parse | eof { [] } - | "..." ws* eol { `Ellipsis :: token lexbuf } - | '\n' { `Output "" :: token lexbuf } - | "# " { let c = phrase [] (Buffer.create 8) lexbuf in - `Command c :: token lexbuf } + | "..." ws* eol { newline lexbuf; `Ellipsis :: token lexbuf } + | '\n' { newline lexbuf; `Output "" :: token lexbuf } + | "# " { let loc = Location.curr lexbuf in + let c = phrase [] (Buffer.create 8) lexbuf in + `Command (c, loc) :: token lexbuf } | ([^'#' '\n'] [^'\n']* as str) eol - { `Output str :: token lexbuf } + { newline lexbuf; `Output str :: token lexbuf } | _ as c { failwith (Printf.sprintf "unexpected character '%c'. Did you forget a space after the '#' at the start of the line?" c) } and phrase acc buf = parse | ("\n"* as nl) "\n" (" " | "\t") - { Lexing.new_line lexbuf; + { newline lexbuf; + for _ = 1 to (String.length nl) do + newline lexbuf + done; let nl = Compat.List.init (String.length nl) (fun _ -> "") in phrase (nl @ Buffer.contents buf :: acc) (Buffer.create 8) lexbuf } - | eol - { Lexing.new_line lexbuf; - List.rev (Buffer.contents buf :: acc) } - | ";;" eol { List.rev ((Buffer.contents buf ^ ";;") :: acc) } - | _ as c { Buffer.add_char buf c; phrase acc buf lexbuf } + | eol { newline lexbuf; List.rev (Buffer.contents buf :: acc) } + | ";;" eol { newline lexbuf; List.rev ((Buffer.contents buf ^ ";;") :: acc) } + | _ as c { Buffer.add_char buf c; phrase acc buf lexbuf } { let token lexbuf = - try token lexbuf + try newline lexbuf; token lexbuf with Failure e -> Misc.err lexbuf "incomplete toplevel entry: %s" e } diff --git a/lib/mli_parser.ml b/lib/mli_parser.ml index 5841c2604..3cec59772 100644 --- a/lib/mli_parser.ml +++ b/lib/mli_parser.ml @@ -128,12 +128,25 @@ let docstrings lexbuf = in loop [] |> List.rev +let convert_pos (p : Lexing.position) (pt : Odoc_model.Location_.point) = + { p with pos_lnum = pt.line; pos_cnum = pt.column } + +let convert_loc (loc : Location.t) (sp : Odoc_model.Location_.span) = + let loc_start = convert_pos loc.loc_start sp.start in + let loc_end = convert_pos loc.loc_end sp.end_ in + { loc with loc_start; loc_end } + let docstring_code_blocks str = Lexer.handle_docstrings := true; Lexer.init (); List.map (fun (docstring, (location : Location.t)) -> - extract_code_blocks ~location:location.loc_start ~docstring) + let blocks = + extract_code_blocks ~location:location.loc_start ~docstring + in + List.map + (fun (b : Code_block.t) -> (b, convert_loc location b.location)) + blocks) (docstrings (Lexing.from_string str)) |> List.concat @@ -146,7 +159,7 @@ let parse_mli file_contents = let lines = String.split_on_char '\n' file_contents |> Array.of_list in let tokens = List.map - (fun (code_block : Code_block.t) -> + (fun ((code_block : Code_block.t), loc) -> let pre_text = Document.Text (slice lines ~start:!cursor ~end_:code_block.location.start) @@ -155,9 +168,8 @@ let parse_mli file_contents = let contents = Compat.String.split_on_char '\n' code_block.contents in let block = match - Block.mk ~line:code_block.location.start.line ~file:"" ~column - ~section:None ~labels:[] ~header:(Some OCaml) ~contents - ~legacy_labels:false ~errors:[] + Block.mk ~loc ~section:None ~labels:[] ~header:(Some OCaml) + ~contents ~legacy_labels:false ~errors:[] with | Ok block -> Document.Block block | Error _ -> failwith "Error creating block" diff --git a/lib/mli_parser.mli b/lib/mli_parser.mli index ff90f8650..9f936ea02 100644 --- a/lib/mli_parser.mli +++ b/lib/mli_parser.mli @@ -4,9 +4,5 @@ module Code_block : sig type t = { location : Odoc_model.Location_.span; contents : string } end -val docstring_code_blocks : string -> Code_block.t list -(** Parse an mli file as a string and return a list of the code blocks that appear inside - its docstrings. *) - val parse_mli : string -> (Document.line list, [ `Msg of string ]) Result.result (** Slice an mli file into its [Text] and [Block] parts. *) diff --git a/lib/toplevel.ml b/lib/toplevel.ml index 907dc1a96..eff68e157 100644 --- a/lib/toplevel.ml +++ b/lib/toplevel.ml @@ -24,24 +24,19 @@ open Misc type t = { vpad : int; hpad : int; - line : int; + pos : Lexing.position; command : string list; output : Output.t list; } let dump_line ppf = function | #Output.t as o -> Output.dump ppf o - | `Command c -> Fmt.pf ppf "`Command %a" Fmt.(Dump.list dump_string) c + | `Command (c, _) -> Fmt.pf ppf "`Command %a" Fmt.(Dump.list dump_string) c let dump_lines = Fmt.(Dump.list dump_line) -let command t = t.command - -let output t = t.output - -let dump ppf ({ vpad; hpad; line; command; output } : t) = - Fmt.pf ppf "@[{vpad=%d;@ hpad=%d;@ line=%d;@ command=%a;@ output=%a}@]" vpad - hpad line +let dump ppf { vpad; hpad; command; output; _ } = + Fmt.pf ppf "@[{vpad=%d;@ hpad=%d;@ command=%a;@ output=%a}@]" vpad hpad Fmt.(Dump.list dump_string) command Fmt.(Dump.list Output.dump) @@ -74,16 +69,10 @@ let pp ppf (t : t) = pp_command ppf t; pp_lines (Output.pp ~pad:t.vpad) ppf t.output -let lexbuf ~file ~line s = +let lexbuf ~(pos : Lexing.position) s = let lexbuf = Lexing.from_string s in - let start = - { lexbuf.Lexing.lex_start_p with pos_fname = file; pos_lnum = line } - in - let curr = - { lexbuf.Lexing.lex_curr_p with pos_fname = file; pos_lnum = line } - in - lexbuf.lex_start_p <- start; - lexbuf.lex_curr_p <- curr; + lexbuf.lex_start_p <- pos; + lexbuf.lex_curr_p <- pos; lexbuf let vpad_of_lines t = @@ -93,9 +82,10 @@ let vpad_of_lines t = in aux 0 t -let of_lines ~syntax ~file ~line ~column t = +let of_lines ~syntax ~(loc : Location.t) t = + let pos = loc.loc_start in let hpad = - match syntax with Syntax.Mli -> column + 2 | _ -> hpad_of_lines t + match syntax with Syntax.Mli -> pos.pos_cnum + 2 | _ -> hpad_of_lines t in let unpad line = match syntax with @@ -109,22 +99,21 @@ let of_lines ~syntax ~file ~line ~column t = let lines = List.map unpad t in let lines = match syntax with Syntax.Mli -> "" :: lines | _ -> lines in let lines = String.concat ~sep:"\n" lines in - let lines = Lexer_top.token (lexbuf ~file ~line lines) in + let lines = Lexer_top.token (lexbuf ~pos lines) in let vpad, lines = vpad_of_lines lines in Log.debug (fun l -> l "Toplevel.of_lines (vpad=%d, hpad=%d) %a" vpad hpad dump_lines lines); - let mk vpad command line output = - { vpad; hpad; command; line; output = List.rev output } + let mk vpad (command, (loc : Location.t)) output = + { vpad; hpad; pos = loc.loc_start; command; output = List.rev output } in - let rec aux vpad command line output acc = function - | [] -> List.rev (mk vpad command line output :: acc) - | (`Ellipsis as o) :: t -> aux vpad command line (o :: output) acc t - | (`Output _ as o) :: t -> aux vpad command line (o :: output) acc t + let rec aux vpad command output acc = function + | [] -> List.rev (mk vpad command output :: acc) + | (`Ellipsis as o) :: t -> aux vpad command (o :: output) acc t + | (`Output _ as o) :: t -> aux vpad command (o :: output) acc t | `Command cmd :: t -> - let line' = line + List.length command + List.length output in let vpad', output = vpad_of_lines output in - aux vpad' cmd line' [] (mk vpad command line output :: acc) t + aux vpad' cmd [] (mk vpad command output :: acc) t in match lines with - | `Command cmd :: t -> aux vpad cmd (line + vpad) [] [] t + | `Command cmd :: t -> aux vpad cmd [] [] t | _ -> Fmt.failwith "invalid toplevel block: %a" Fmt.(Dump.list string) t diff --git a/lib/toplevel.mli b/lib/toplevel.mli index e1226083f..8a93d951f 100644 --- a/lib/toplevel.mli +++ b/lib/toplevel.mli @@ -19,7 +19,7 @@ type t = { vpad : int; hpad : int; - line : int; + pos : Lexing.position; command : string list; output : Output.t list; } @@ -41,21 +41,6 @@ val pp_command : t Fmt.t (** {2 Parser} *) -val of_lines : - syntax:Syntax.t -> - file:string -> - line:int -> - column:int -> - string list -> - t list -(** [of_lines ~file ~line ~column lines] is the list of toplevel blocks from - file [file] starting at line [line]. Return the vertical and - horizontal whitespace padding as well.*) - -(** {2 Accessors} *) - -val command : t -> string list -(** [command t] is [t]'s command. *) - -val output : t -> Output.t list -(** [output t] is [t]'s output. *) +val of_lines : syntax:Syntax.t -> loc:Location.t -> string list -> t list +(** [of_lines ~loc lines] is the list of toplevel blocks from location [loc]. + Return the vertical and horizontal whitespace padding as well. *) diff --git a/test/bin/mdx-pp/expect/spaces/test_case.ml.expected b/test/bin/mdx-pp/expect/spaces/test_case.ml.expected index d8323f3c5..4c7bc9bd0 100644 --- a/test/bin/mdx-pp/expect/spaces/test_case.ml.expected +++ b/test/bin/mdx-pp/expect/spaces/test_case.ml.expected @@ -1,4 +1,4 @@ -#5 "test-case.md" +#7 "test-case.md" let x = diff --git a/test/bin/mdx-test/failure/cram-command-syntax/test-case.t.expected b/test/bin/mdx-test/failure/cram-command-syntax/test-case.t.expected index 4cba7347e..bbb8b2424 100644 --- a/test/bin/mdx-test/failure/cram-command-syntax/test-case.t.expected +++ b/test/bin/mdx-test/failure/cram-command-syntax/test-case.t.expected @@ -1,2 +1,2 @@ -Error in the cram code block in test-case.t at line 3: +File "test-case.t", line 3: Error in the cram code block Blocks must start with a command or similar, not with an output line. To indicate a line as a command, start it with a dollar followed by a space. diff --git a/test/bin/mdx-test/failure/cram-empty-line/test-case.t.expected b/test/bin/mdx-test/failure/cram-empty-line/test-case.t.expected index 97cdd0f8b..3c3f2bc3e 100644 --- a/test/bin/mdx-test/failure/cram-empty-line/test-case.t.expected +++ b/test/bin/mdx-test/failure/cram-empty-line/test-case.t.expected @@ -1,2 +1,2 @@ -Error in the cram code block in test-case.t at line 5: +File "test-case.t", line 5: Error in the cram code block Blocks must start with a command or similar, not with an output line. Please, make sure that there's no spare empty line, particularly between the output and its input. diff --git a/test/bin/mdx-test/failure/in-toplevel/test-case.md.expected b/test/bin/mdx-test/failure/in-toplevel/test-case.md.expected index fb0978413..3b8377e3a 100644 --- a/test/bin/mdx-test/failure/in-toplevel/test-case.md.expected +++ b/test/bin/mdx-test/failure/in-toplevel/test-case.md.expected @@ -1,2 +1,2 @@ -Error in the OCaml file include code block in test-case.md at line 4: +File "test-case.md", lines 3-5: Error in the OCaml file include code block ./not_found.ml: No such file or directory diff --git a/test/bin/mdx-test/failure/ml-file-not-found/test-case.md.expected b/test/bin/mdx-test/failure/ml-file-not-found/test-case.md.expected index fb0978413..80963c5fb 100644 --- a/test/bin/mdx-test/failure/ml-file-not-found/test-case.md.expected +++ b/test/bin/mdx-test/failure/ml-file-not-found/test-case.md.expected @@ -1,2 +1,2 @@ -Error in the OCaml file include code block in test-case.md at line 4: +File "test-case.md", lines 3-4: Error in the OCaml file include code block ./not_found.ml: No such file or directory diff --git a/test/bin/mdx-test/failure/part-not-ended/test-case.md.expected b/test/bin/mdx-test/failure/part-not-ended/test-case.md.expected index 04aa05a4c..4808757d5 100644 --- a/test/bin/mdx-test/failure/part-not-ended/test-case.md.expected +++ b/test/bin/mdx-test/failure/part-not-ended/test-case.md.expected @@ -1,2 +1,2 @@ -Error in the OCaml file include code block in test-case.md at line 3: +File "test-case.md", lines 2-3: Error in the OCaml file include code block In file ./parts-begin-end.ml, line 18: Part toto has no end. diff --git a/test/bin/mdx-test/failure/part-not-found/test-case.md.expected b/test/bin/mdx-test/failure/part-not-found/test-case.md.expected index b8a8c3f78..9dfebbfc7 100644 --- a/test/bin/mdx-test/failure/part-not-found/test-case.md.expected +++ b/test/bin/mdx-test/failure/part-not-found/test-case.md.expected @@ -1,2 +1,2 @@ -Error in the OCaml file include code block in test-case.md at line 4: +File "test-case.md", lines 3-4: Error in the OCaml file include code block Cannot find part "part1" in ./part_not_found.ml diff --git a/test/bin/mdx-test/failure/part-not-opened/test-case.md.expected b/test/bin/mdx-test/failure/part-not-opened/test-case.md.expected index 519b45f58..d97696f74 100644 --- a/test/bin/mdx-test/failure/part-not-opened/test-case.md.expected +++ b/test/bin/mdx-test/failure/part-not-opened/test-case.md.expected @@ -1,2 +1,2 @@ -Error in the OCaml file include code block in test-case.md at line 3: +File "test-case.md", lines 2-3: Error in the OCaml file include code block In file ./parts-begin-end.ml, line 6: There is no part to end. diff --git a/test/lib/test_block.ml b/test/lib/test_block.ml index b5d0819c1..cf7c6859a 100644 --- a/test/lib/test_block.ml +++ b/test/lib/test_block.ml @@ -53,7 +53,7 @@ let test_mk = let test_name = Printf.sprintf "mk: %S" name in let test_fun () = let actual = - Mdx.Block.mk ~line:0 ~file:"" ~column:0 ~section:None ~labels + Mdx.Block.mk ~loc:Location.none ~section:None ~labels ~legacy_labels:false ~header ~contents ~errors:[] in Alcotest.(check (result Testable.block Testable.msg)) diff --git a/test/lib/test_dep.ml b/test/lib/test_dep.ml index 2eccc1752..1df04f480 100644 --- a/test/lib/test_dep.ml +++ b/test/lib/test_dep.ml @@ -25,8 +25,8 @@ let test_of_block = match Mdx.Label.of_string s with | Ok labels -> ( match - Mdx.Block.mk ~line:0 ~file:"" ~column:0 ~section:None ~labels - ~header:None ~contents:[] ~legacy_labels:false ~errors:[] + Mdx.Block.mk ~loc:Location.none ~section:None ~labels ~header:None + ~contents:[] ~legacy_labels:false ~errors:[] with | Ok block -> block | Error _ -> assert false ) diff --git a/test/lib/test_mli_parser.ml b/test/lib/test_mli_parser.ml index ad9800f33..2e289df46 100644 --- a/test/lib/test_mli_parser.ml +++ b/test/lib/test_mli_parser.ml @@ -44,28 +44,26 @@ let test_parse_mli = (Ok {x|[Text "\n(** This is a doc comment with some code blocks in it:\n\n "; Text "{["; - Block {file: ; line: 4; column: 4; section: None; labels: []; + Block {loc: File "_none_", lines 4-7; section: None; labels: []; header: Some ocaml; - contents: ["# List.map (fun x -> x * x) [(1 + 9); 2; 3]"; - "- : int list = [100; 4; 9]"]; + contents: ["# List.map (fun x -> x * x) [(1 + 9); 2; 3]"; + "- : int list = [100; 4; 9]"]; value: Toplevel}; Text " ]}"; Text "\n\n "; Text "{["; - Block {file: ; line: 9; column: 4; section: None; labels: []; + Block {loc: File "_none_", line 9; section: None; labels: []; header: Some ocaml; - contents: ["List.map (fun x -> x * x) [1; 2; 3]"]; - value: OCaml}; + contents: ["List.map (fun x -> x * x) [1; 2; 3]"]; value: OCaml}; Text "]}"; Text "\n\n "; Text "{["; - Block {file: ; line: 11; column: 4; section: None; labels: []; + Block {loc: File "_none_", lines 11-16; section: None; labels: []; header: Some ocaml; - contents: ["# List.map (fun x -> x * x) [(1 + 9); 2; 3]"; - "- : int list = [100; 4; 9]"; - "# List.map (fun x -> x * x) [1; 2; 3]"; - "- : int list = [1; 4; 9]"]; + contents: ["# List.map (fun x -> x * x) [(1 + 9); 2; 3]"; + "- : int list = [100; 4; 9]"; + "# List.map (fun x -> x * x) [1; 2; 3]"; + "- : int list = [1; 4; 9]"]; value: Toplevel}; Text " ]}"; Text "\n*)\nval foo : string\n\n(** "; Text "{["; - Block {file: ; line: 20; column: 4; section: None; labels: []; - header: Some ocaml; - contents: ["1 + 1 = 3"]; value: OCaml}; + Block {loc: File "_none_", line 20; section: None; labels: []; + header: Some ocaml; contents: ["1 + 1 = 3"]; value: OCaml}; Text "]}";|x}) (); ]