From da6f3bea176167fcdc9ef3b9e1fe1190831a08d7 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Fri, 4 Jan 2019 16:35:23 -0500 Subject: [PATCH 1/2] Improve printing of fatal errors Currently, some fatal errors aren't printed because things fail before the printers are all registered. This PR registers the printers as early as possible. This way, all exceptions are properly printed. Signed-off-by: Rudi Grinberg --- src/errors.ml | 5 ++--- src/stdune/exn.ml | 6 ++++++ src/stdune/loc.mli | 2 ++ src/stdune/loc0.ml | 7 +++++++ 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/errors.ml b/src/errors.ml index 198553c307c..40da4dd5f25 100644 --- a/src/errors.ml +++ b/src/errors.ml @@ -118,9 +118,8 @@ let print ppf loc = print_ellipsis padding_width; print_lines last_shown_lines padding_width) in - Format.fprintf ppf - "@{File \"%s\", line %d, characters %d-%d:@}@\n%a" - start.pos_fname start.pos_lnum start_c stop_c + Format.fprintf ppf "%a%a" + Loc.print loc pp_file_excerpt () (* This is ugly *) diff --git a/src/stdune/exn.ml b/src/stdune/exn.ml index 246075c1997..29476b060d6 100644 --- a/src/stdune/exn.ml +++ b/src/stdune/exn.ml @@ -10,6 +10,12 @@ external raise : exn -> _ = "%raise" external raise_notrace : exn -> _ = "%raise_notrace" external reraise : exn -> _ = "%reraise" +let () = + Printexc.register_printer (function + | Code_error s -> Some (Format.asprintf "%a" Sexp.pp s) + | Loc_error (loc, s) -> Some (Format.asprintf "%a%s" Loc0.print loc s) + | _ -> None) + let fatalf ?loc fmt = Format.ksprintf (fun s -> match loc with diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli index 0c31f2d006f..4f7c7a38e96 100644 --- a/src/stdune/loc.mli +++ b/src/stdune/loc.mli @@ -21,3 +21,5 @@ val of_pos : (string * int * int * int) -> t val to_file_colon_line : t -> string val pp_file_colon_line : Format.formatter -> t -> unit + +val print : Format.formatter -> t -> unit diff --git a/src/stdune/loc0.ml b/src/stdune/loc0.ml index 91e3160be90..e3e2df2b79c 100644 --- a/src/stdune/loc0.ml +++ b/src/stdune/loc0.ml @@ -2,3 +2,10 @@ type t = { start : Lexing.position ; stop : Lexing.position } + +let print ppf { start; stop } = + let start_c = start.pos_cnum - start.pos_bol in + let stop_c = stop.pos_cnum - start.pos_bol in + Format.fprintf ppf + "@{File \"%s\", line %d, characters %d-%d:@}@\n" + start.pos_fname start.pos_lnum start_c stop_c From f61fd37592d4e8ca03c2b107960a207a7a86e172 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Mon, 7 Jan 2019 13:18:37 -0500 Subject: [PATCH 2/2] Move excerpt printing to Loc module Signed-off-by: Rudi Grinberg --- src/errors.ml | 84 ++-------------------------------------------- src/stdune/io.ml | 40 ++++++++++++++++++++-- src/stdune/io.mli | 15 +++++++-- src/stdune/loc.ml | 56 +++++++++++++++++++++++++++++++ src/stdune/loc.mli | 7 ++++ 5 files changed, 116 insertions(+), 86 deletions(-) diff --git a/src/errors.ml b/src/errors.ml index 40da4dd5f25..fbd48bb2732 100644 --- a/src/errors.ml +++ b/src/errors.ml @@ -38,89 +38,9 @@ let fail_opt t fmt = | None -> die fmt | Some t -> fail t fmt -let file_line path n = - Io.with_file_in ~binary:false path - ~f:(fun ic -> - for _ = 1 to n - 1 do - ignore (input_line ic) - done; - input_line ic - ) - -let file_lines path ~start ~stop = - Io.with_file_in ~binary:true path - ~f:(fun ic -> - let rec aux acc lnum = - if lnum > stop then - List.rev acc - else if lnum < start then - (ignore (input_line ic); - aux acc (lnum + 1)) - else - let line = input_line ic in - aux ((string_of_int lnum, line) :: acc) (lnum + 1) - in - aux [] 1 - ) - -let pp_line padding_width pp (lnum, l) = - Format.fprintf pp "%*s | %s\n" padding_width lnum l - let print ppf loc = - let { Loc.start; stop } = loc in - let start_c = start.pos_cnum - start.pos_bol in - let stop_c = stop.pos_cnum - start.pos_bol in - let num_lines = stop.pos_lnum - start.pos_lnum in - let pp_file_excerpt pp () = - let whole_file = start_c = 0 && stop_c = 0 in - if not whole_file then - let path = Path.of_string start.pos_fname in - if Path.exists path then - let line_num = start.pos_lnum in - let line_num_str = string_of_int line_num in - let padding_width = String.length line_num_str in - let line = file_line path line_num in - if stop_c <= String.length line then - let len = stop_c - start_c in - Format.fprintf pp "%a%*s\n" - (pp_line padding_width) (line_num_str, line) - (stop_c + padding_width + 3) - (String.make len '^') - else - let get_padding lines = - let (lnum, _) = Option.value_exn (List.last lines) in - String.length lnum - in - let print_ellipsis padding_width = - (* We add 2 to the width of max line to account for - the extra space and the `|` character at the end - of a line number *) - let line = String.make (padding_width + 2) '.' in - Format.fprintf pp "%s\n" line - in - let print_lines lines padding_width = - List.iter ~f:(fun (lnum, l) -> - pp_line padding_width pp (lnum, l)) lines; - in - if num_lines <= max_lines_to_print_in_full then - let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in - print_lines lines (get_padding lines) - else - (* We need to send the padding width from the last four lines - so the two blocks of lines align if they have different number - of digits in their line numbers *) - let first_shown_lines = file_lines path ~start:(start.pos_lnum) - ~stop:(start.pos_lnum + context_lines) in - let last_shown_lines = file_lines path ~start:(stop.pos_lnum - context_lines) - ~stop:(stop.pos_lnum) in - let padding_width = get_padding last_shown_lines in - (print_lines first_shown_lines padding_width; - print_ellipsis padding_width; - print_lines last_shown_lines padding_width) - in - Format.fprintf ppf "%a%a" - Loc.print loc - pp_file_excerpt () + Format.fprintf ppf "%a%a" Loc.print loc + (Loc.pp_file_excerpt ~context_lines ~max_lines_to_print_in_full) loc (* This is ugly *) let printer = ref (Printf.eprintf "%s%!") diff --git a/src/stdune/io.ml b/src/stdune/io.ml index 992f1384bde..959e589a3b8 100644 --- a/src/stdune/io.ml +++ b/src/stdune/io.ml @@ -28,8 +28,16 @@ module type S = sig val open_in : ?binary:bool (* default true *) -> path -> in_channel val open_out : ?binary:bool (* default true *) -> path -> out_channel - val with_file_in : ?binary:bool (* default true *) -> path -> f:(in_channel -> 'a) -> 'a - val with_file_out : ?binary:bool (* default true *) -> path -> f:(out_channel -> 'a) -> 'a + val with_file_in + : ?binary:bool (* default true *) + -> path + -> f:(in_channel -> 'a) + -> 'a + val with_file_out + : ?binary:bool (* default true *) + -> path + -> f:(out_channel -> 'a) + -> 'a val with_lexbuf_from_file : path -> f:(Lexing.lexbuf -> 'a) -> 'a val lines_of_file : path -> string list @@ -42,6 +50,9 @@ module type S = sig val write_lines : path -> string list -> unit val copy_file : ?chmod:(int -> int) -> src:path -> dst:path -> unit -> unit + + val file_line : path -> int -> string + val file_lines : path -> start:int -> stop:int -> (string * string) list end module Make (Path : sig @@ -152,6 +163,31 @@ module Make (Path : sig ~finally:close_out ~f:(fun oc -> copy_channels ic oc)) + + + let file_line path n = + with_file_in ~binary:false path + ~f:(fun ic -> + for _ = 1 to n - 1 do + ignore (input_line ic) + done; + input_line ic + ) + + let file_lines path ~start ~stop = + with_file_in ~binary:true path + ~f:(fun ic -> + let rec aux acc lnum = + if lnum > stop then + List.rev acc + else if lnum < start then + (ignore (input_line ic); + aux acc (lnum + 1)) + else + let line = input_line ic in + aux ((string_of_int lnum, line) :: acc) (lnum + 1) + in + aux [] 1) end include Make(Path) diff --git a/src/stdune/io.mli b/src/stdune/io.mli index 89fe59814ae..60aee2a136d 100644 --- a/src/stdune/io.mli +++ b/src/stdune/io.mli @@ -15,8 +15,16 @@ module type S = sig val open_in : ?binary:bool (* default true *) -> path -> in_channel val open_out : ?binary:bool (* default true *) -> path -> out_channel - val with_file_in : ?binary:bool (* default true *) -> path -> f:(in_channel -> 'a) -> 'a - val with_file_out : ?binary:bool (* default true *) -> path -> f:(out_channel -> 'a) -> 'a + val with_file_in + : ?binary:bool (* default true *) + -> path + -> f:(in_channel -> 'a) + -> 'a + val with_file_out + : ?binary:bool (* default true *) + -> path + -> f:(out_channel -> 'a) + -> 'a val with_lexbuf_from_file : path -> f:(Lexing.lexbuf -> 'a) -> 'a val lines_of_file : path -> string list @@ -29,6 +37,9 @@ module type S = sig val write_lines : path -> string list -> unit val copy_file : ?chmod:(int -> int) -> src:path -> dst:path -> unit -> unit + + val file_line : path -> int -> string + val file_lines : path -> start:int -> stop:int -> (string * string) list end include S with type path = Path.t diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml index 85872b9eb8e..b440c080303 100644 --- a/src/stdune/loc.ml +++ b/src/stdune/loc.ml @@ -83,3 +83,59 @@ let to_file_colon_line t = let pp_file_colon_line ppf t = Format.pp_print_string ppf (to_file_colon_line t) + +let pp_line padding_width pp (lnum, l) = + Format.fprintf pp "%*s | %s\n" padding_width lnum l + +let pp_file_excerpt ~context_lines ~max_lines_to_print_in_full + pp { start; stop } = + let start_c = start.pos_cnum - start.pos_bol in + let stop_c = stop.pos_cnum - start.pos_bol in + let num_lines = stop.pos_lnum - start.pos_lnum in + let whole_file = start_c = 0 && stop_c = 0 in + if not whole_file then + let path = Path.of_string start.pos_fname in + if Path.exists path then + let line_num = start.pos_lnum in + let line_num_str = string_of_int line_num in + let padding_width = String.length line_num_str in + let line = Io.file_line path line_num in + if stop_c <= String.length line then + let len = stop_c - start_c in + Format.fprintf pp "%a%*s\n" + (pp_line padding_width) (line_num_str, line) + (stop_c + padding_width + 3) + (String.make len '^') + else + let get_padding lines = + let (lnum, _) = Option.value_exn (List.last lines) in + String.length lnum + in + let print_ellipsis padding_width = + (* We add 2 to the width of max line to account for the extra space + and the `|` character at the end of a line number *) + let line = String.make (padding_width + 2) '.' in + Format.fprintf pp "%s\n" line + in + let print_lines lines padding_width = + List.iter ~f:(fun (lnum, l) -> + pp_line padding_width pp (lnum, l)) lines; + in + if num_lines <= max_lines_to_print_in_full then + let lines = + Io.file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in + print_lines lines (get_padding lines) + else + (* We need to send the padding width from the last four lines so the + two blocks of lines align if they have different number of digits + in their line numbers *) + let first_shown_lines = + Io.file_lines path ~start:(start.pos_lnum) + ~stop:(start.pos_lnum + context_lines) in + let last_shown_lines = + Io.file_lines path ~start:(stop.pos_lnum - context_lines) + ~stop:(stop.pos_lnum) in + let padding_width = get_padding last_shown_lines in + (print_lines first_shown_lines padding_width; + print_ellipsis padding_width; + print_lines last_shown_lines padding_width) diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli index 4f7c7a38e96..7b8f2f45b2a 100644 --- a/src/stdune/loc.mli +++ b/src/stdune/loc.mli @@ -23,3 +23,10 @@ val to_file_colon_line : t -> string val pp_file_colon_line : Format.formatter -> t -> unit val print : Format.formatter -> t -> unit + +val pp_file_excerpt + : context_lines:int + -> max_lines_to_print_in_full:int + -> Format.formatter + -> t + -> unit