From 7c0a9a84ba4427921fe442bbebb75ba1bd4d3f1e Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 30 Aug 2018 10:05:08 +0200 Subject: [PATCH 1/3] Refactor Report_error module - make `printer` type abstract - make a builtin printer Signed-off-by: Etienne Millon --- src/lib.ml | 9 +-- src/report_error.ml | 159 ++++++++++++++++++++++--------------------- src/report_error.mli | 14 ++-- src/stanza.ml | 15 ++-- 4 files changed, 98 insertions(+), 99 deletions(-) diff --git a/src/lib.ml b/src/lib.ml index 7b0d64f8..e3ba3146 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -1234,11 +1234,6 @@ let () = (Some t.pd_loc, None) | _ -> (None, None) in - Some - { Report_error. - loc - ; hint - ; pp = (fun ppf -> report_lib_error ppf e) - ; backtrace = false - } + let pp ppf = report_lib_error ppf e in + Some (Report_error.make_printer ?loc ?hint pp) | _ -> None) diff --git a/src/report_error.ml b/src/report_error.ml index f9ca92e6..08d55d81 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -10,15 +10,75 @@ type printer = ; backtrace : bool } -let p = - { loc = None - ; pp = ignore - ; hint = None - ; backtrace = false +let make_printer ?(backtrace=false) ?hint ?loc pp = + { loc + ; pp + ; hint + ; backtrace } -let reporters = ref [] -let register f = reporters := f :: !reporters +let builtin_printer = function + | Dsexp.Of_sexp.Of_sexp (loc, msg, hint') -> + let loc = + { loc with + start = { loc.start with pos_fname = !map_fname loc.start.pos_fname } + } + in + let pp ppf = Format.fprintf ppf "@{Error@}: %s%s\n" msg + (match hint' with + | None -> "" + | Some { Dsexp.Of_sexp. on; candidates } -> + hint on candidates) + in + Some (make_printer ~loc pp) + | Exn.Loc_error (loc, msg) -> + let loc = + { loc with + start = { loc.start with pos_fname = !map_fname loc.start.pos_fname } + } + in + let pp ppf = Format.fprintf ppf "@{Error@}: %s\n" msg in + Some (make_printer ~loc pp) + | Dsexp.Parse_error e -> + let loc = Dsexp.Parse_error.loc e in + let msg = Dsexp.Parse_error.message e in + let map_pos (pos : Lexing.position) = + { pos with pos_fname = !map_fname pos.pos_fname } + in + let loc : Loc.t = + { start = map_pos loc.start + ; stop = map_pos loc.stop + } + in + let pp ppf = Format.fprintf ppf "@{Error@}: %s\n" msg in + Some (make_printer ~loc pp) + | Exn.Fatal_error msg -> + let pp ppf = + if msg.[String.length msg - 1] = '\n' then + Format.fprintf ppf "%s" msg + else + Format.fprintf ppf "%s\n" (String.capitalize msg) + in + Some (make_printer pp) + | Stdune.Exn.Code_error sexp -> + let pp = fun ppf -> + Format.fprintf ppf "@{Internal error, please report upstream \ + including the contents of _build/log.@}\n\ + Description:%a\n" + Sexp.pp sexp + in + Some (make_printer ~backtrace:true pp) + | Unix.Unix_error (err, func, fname) -> + let pp ppf = + Format.fprintf ppf "@{Error@}: %s: %s: %s\n" + func fname (Unix.error_message err) + in + Some (make_printer pp) + | _ -> None + +let printers = ref [builtin_printer] + +let register f = printers := f :: !printers let i_must_not_segfault = let x = lazy (at_exit (fun () -> @@ -31,79 +91,24 @@ cases are handled there will be nothing. Only I will remain.")) in fun () -> Lazy.force x +let find_printer exn = + List.find_map !printers ~f:(fun f -> f exn) + +let exn_printer exn = + let pp ppf = + let s = Printexc.to_string exn in + if String.is_prefix s ~prefix:"File \"" then + Format.fprintf ppf "%s\n" s + else + Format.fprintf ppf "@{Error@}: exception %s\n" s + in + make_printer ~backtrace:true pp + (* Firt return value is [true] if the backtrace was printed *) let report_with_backtrace exn = - match List.find_map !reporters ~f:(fun f -> f exn) with + match find_printer exn with | Some p -> p - | None -> - match exn with - | Exn.Loc_error (loc, msg) -> - let loc = - { loc with - start = { loc.start with pos_fname = !map_fname loc.start.pos_fname } - } - in - let pp ppf = Format.fprintf ppf "@{Error@}: %s\n" msg in - { p with loc = Some loc; pp } - | Dsexp.Of_sexp.Of_sexp (loc, msg, hint') -> - let loc = - { loc with - start = { loc.start with pos_fname = !map_fname loc.start.pos_fname } - } - in - let pp ppf = Format.fprintf ppf "@{Error@}: %s%s\n" msg - (match hint' with - | None -> "" - | Some { Dsexp.Of_sexp. on; candidates } -> - hint on candidates) - in - { p with loc = Some loc; pp } - | Dsexp.Parse_error e -> - let loc = Dsexp.Parse_error.loc e in - let msg = Dsexp.Parse_error.message e in - let map_pos (pos : Lexing.position) = - { pos with pos_fname = !map_fname pos.pos_fname } - in - let loc : Loc.t = - { start = map_pos loc.start - ; stop = map_pos loc.stop - } - in - { p with - loc = Some loc - ; pp = fun ppf -> Format.fprintf ppf "@{Error@}: %s\n" msg - } - | Exn.Fatal_error msg -> - { p with pp = fun ppf -> - if msg.[String.length msg - 1] = '\n' then - Format.fprintf ppf "%s" msg - else - Format.fprintf ppf "%s\n" (String.capitalize msg) - } - | Stdune.Exn.Code_error sexp -> - { p with - backtrace = true - ; pp = fun ppf -> - Format.fprintf ppf "@{Internal error, please report upstream \ - including the contents of _build/log.@}\n\ - Description:%a\n" - Sexp.pp sexp - } - | Unix.Unix_error (err, func, fname) -> - { p with pp = fun ppf -> - Format.fprintf ppf "@{Error@}: %s: %s: %s\n" - func fname (Unix.error_message err) - } - | _ -> - { p with - backtrace = true - ; pp = fun ppf -> - let s = Printexc.to_string exn in - if String.is_prefix s ~prefix:"File \"" then - Format.fprintf ppf "%s\n" s - else - Format.fprintf ppf "@{Error@}: exception %s\n" s - } + | None -> exn_printer exn let reported = ref String.Set.empty diff --git a/src/report_error.mli b/src/report_error.mli index 9838b3e9..433e6741 100644 --- a/src/report_error.mli +++ b/src/report_error.mli @@ -11,12 +11,14 @@ open! Stdune We cache what is actually printed to the screen. *) val report : exn -> unit -type printer = - { loc : Loc.t option - ; pp : Format.formatter -> unit - ; hint : string option - ; backtrace : bool - } +type printer + +val make_printer : + ?backtrace:bool -> + ?hint:string -> + ?loc:Loc.t -> + (Format.formatter -> unit) -> + printer (** Register an error reporter. *) val register : (exn -> printer option) -> unit diff --git a/src/stanza.ml b/src/stanza.ml index b650a102..47375b65 100644 --- a/src/stanza.ml +++ b/src/stanza.ml @@ -33,15 +33,12 @@ module Of_sexp = struct Report_error.register (function | Parens_no_longer_necessary loc -> - Some - { loc = Some loc - ; hint = None - ; backtrace = false - ; pp = fun ppf -> - Format.fprintf ppf - "These parentheses are no longer necessary with dune, \ - please remove them.@\n" - } + let pp ppf = + Format.fprintf ppf + "These parentheses are no longer necessary with dune, \ + please remove them.@\n" + in + Some (Report_error.make_printer ~loc pp) | _ -> None) let switch_file_kind ~jbuild ~dune = From 6fbb93d0862f4176f89107b651f57bf5849b273d Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 31 Aug 2018 14:29:34 +0200 Subject: [PATCH 2/3] Move the "try: " part to hints themselves Signed-off-by: Etienne Millon --- src/js_of_ocaml_rules.ml | 2 +- src/lib.ml | 5 ++++- src/menhir.ml | 2 +- src/odoc.ml | 2 +- src/preprocessing.ml | 2 +- src/report_error.ml | 2 +- 6 files changed, 9 insertions(+), 6 deletions(-) diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index 6e70e1fe..3d13a464 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -14,7 +14,7 @@ let sourcemap sctx = if dev_mode sctx then ["--source-map-inline"] else [] let standard sctx = pretty sctx @ sourcemap sctx -let install_jsoo_hint = "opam install js_of_ocaml-compiler" +let install_jsoo_hint = "try: opam install js_of_ocaml-compiler" let in_build_dir ~ctx = let init = Path.relative ctx.Context.build_dir ".js" in diff --git a/src/lib.ml b/src/lib.ml index e3ba3146..8d44808b 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -1229,7 +1229,10 @@ let () = match !Clflags.external_lib_deps_hint with | [] -> (* during bootstrap *) None | l -> - Some (List.map l ~f:quote_for_shell |> String.concat ~sep:" ")) + let cmdline = + List.map l ~f:quote_for_shell |> String.concat ~sep:" " + in + Some ("try: " ^ cmdline)) | Private_deps_not_allowed t -> (Some t.pd_loc, None) | _ -> (None, None) diff --git a/src/menhir.ml b/src/menhir.ml index 6e4584f1..536fd280 100644 --- a/src/menhir.ml +++ b/src/menhir.ml @@ -71,7 +71,7 @@ module Run (P : PARAMS) = struct (* Find the menhir binary. *) let menhir_binary = - SC.resolve_program sctx "menhir" ~loc:None ~hint:"opam install menhir" + SC.resolve_program sctx "menhir" ~loc:None ~hint:"try: opam install menhir" (* [menhir args] generates a Menhir command line (a build action). *) diff --git a/src/odoc.ml b/src/odoc.ml index 19e01cfe..9a7abd05 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -85,7 +85,7 @@ module Gen (S : sig val sctx : SC.t end) = struct let setup_deps m files = SC.add_alias_deps sctx (alias m) files end - let odoc = SC.resolve_program sctx "odoc" ~hint:"opam install odoc" ~loc:None + let odoc = SC.resolve_program sctx "odoc" ~hint:"try: opam install odoc" ~loc:None let odoc_ext = ".odoc" module Mld : sig diff --git a/src/preprocessing.ml b/src/preprocessing.ml index d777b6e3..635f3987 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -417,7 +417,7 @@ let cookie_library_name lib_name = let setup_reason_rules sctx (m : Module.t) = let ctx = SC.context sctx in let refmt = - SC.resolve_program sctx ~loc:None "refmt" ~hint:"opam install reason" in + SC.resolve_program sctx ~loc:None "refmt" ~hint:"try: opam install reason" in let rule src target = Build.run ~context:ctx refmt [ A "--print" diff --git a/src/report_error.ml b/src/report_error.ml index 08d55d81..045df6f6 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -162,7 +162,7 @@ let report exn = if dependency_path <> [] then Format.fprintf ppf "%a@\n" Dep_path.Entries.pp (List.rev dependency_path); - Option.iter p.hint ~f:(fun s -> Format.fprintf ppf "Hint: try: %s\n" s); + Option.iter p.hint ~f:(fun s -> Format.fprintf ppf "Hint: %s\n" s); Format.pp_print_flush ppf (); let s = Buffer.contents err_buf in Buffer.clear err_buf; From f8f9db2d9c8081e5cd89d40f92f94ce16aff68f1 Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Thu, 30 Aug 2018 10:05:49 +0200 Subject: [PATCH 3/3] When there are extra parentheses, display the exn Dune tries to be helpful when there are extra parentheses, but sometimes it is a bit too eager. This wraps the exception so that the original one is displayed. Closes #1173 Closes #1181 Signed-off-by: Etienne Millon --- CHANGES.md | 2 ++ src/report_error.ml | 6 +++++ src/report_error.mli | 9 ++++++- src/stanza.ml | 22 ++++++++------- .../test-cases/too-many-parens/e/dune | 5 ++++ .../test-cases/too-many-parens/e/dune-project | 1 + .../test-cases/too-many-parens/run.t | 27 ++++++++++++++++--- 7 files changed, 58 insertions(+), 14 deletions(-) create mode 100644 test/blackbox-tests/test-cases/too-many-parens/e/dune create mode 100644 test/blackbox-tests/test-cases/too-many-parens/e/dune-project diff --git a/CHANGES.md b/CHANGES.md index 9b9aff69..40596326 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -36,6 +36,8 @@ next - Add an emacs mode providing helpers to promote correction files (#1192, @diml) +- Improve message suggesting to remove parentheses (#1196, fix #1173, @emillon) + 1.1.1 (08/08/2018) ------------------ diff --git a/src/report_error.ml b/src/report_error.ml index 045df6f6..d05e9c1f 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -17,6 +17,12 @@ let make_printer ?(backtrace=false) ?hint ?loc pp = ; backtrace } +let set_loc p ~loc = + {p with loc = Some loc} + +let set_hint p ~hint = + {p with hint = Some hint} + let builtin_printer = function | Dsexp.Of_sexp.Of_sexp (loc, msg, hint') -> let loc = diff --git a/src/report_error.mli b/src/report_error.mli index 433e6741..34cf6fe7 100644 --- a/src/report_error.mli +++ b/src/report_error.mli @@ -20,8 +20,15 @@ val make_printer : (Format.formatter -> unit) -> printer -(** Register an error reporter. *) +val set_loc : printer -> loc:Loc.t -> printer + +val set_hint : printer -> hint:string -> printer + +(** Register an error printer. *) val register : (exn -> printer option) -> unit +(** Find an error printer *) +val find_printer : exn -> printer option + (**/**) val map_fname : (string -> string) ref diff --git a/src/stanza.ml b/src/stanza.ml index 47375b65..e4b92120 100644 --- a/src/stanza.ml +++ b/src/stanza.ml @@ -27,18 +27,22 @@ let file_kind () = module Of_sexp = struct include Dsexp.Of_sexp - exception Parens_no_longer_necessary of Loc.t + exception Parens_no_longer_necessary of Loc.t * exn let () = Report_error.register (function - | Parens_no_longer_necessary loc -> - let pp ppf = - Format.fprintf ppf - "These parentheses are no longer necessary with dune, \ - please remove them.@\n" + | Parens_no_longer_necessary (loc, exn) -> + let hint = + "dune files require less parentheses than jbuild files.\n\ + If you just converted this file from a jbuild file, try removing these parentheses." in - Some (Report_error.make_printer ~loc pp) + Option.map (Report_error.find_printer exn) + ~f:(fun printer -> + printer + |> Report_error.set_loc ~loc + |> Report_error.set_hint ~hint + ) | _ -> None) let switch_file_kind ~jbuild ~dune = @@ -61,12 +65,12 @@ module Of_sexp = struct (if is_record then peek >>= function | Some (List _) -> - raise (Parens_no_longer_necessary loc) + raise (Parens_no_longer_necessary (loc, exn)) | _ -> t else t) >>= fun _ -> - raise (Parens_no_longer_necessary loc))) + raise (Parens_no_longer_necessary (loc, exn)))) (function | Parens_no_longer_necessary _ as exn -> raise exn | _ -> raise exn)) diff --git a/test/blackbox-tests/test-cases/too-many-parens/e/dune b/test/blackbox-tests/test-cases/too-many-parens/e/dune new file mode 100644 index 00000000..8e466bcd --- /dev/null +++ b/test/blackbox-tests/test-cases/too-many-parens/e/dune @@ -0,0 +1,5 @@ +(alias + (name a) + (deps (glob *)) ; this form doesn't exist + (action (echo test)) +) diff --git a/test/blackbox-tests/test-cases/too-many-parens/e/dune-project b/test/blackbox-tests/test-cases/too-many-parens/e/dune-project new file mode 100644 index 00000000..de4fc209 --- /dev/null +++ b/test/blackbox-tests/test-cases/too-many-parens/e/dune-project @@ -0,0 +1 @@ +(lang dune 1.0) diff --git a/test/blackbox-tests/test-cases/too-many-parens/run.t b/test/blackbox-tests/test-cases/too-many-parens/run.t index 93b17ef5..1c67b53a 100644 --- a/test/blackbox-tests/test-cases/too-many-parens/run.t +++ b/test/blackbox-tests/test-cases/too-many-parens/run.t @@ -8,25 +8,44 @@ are readable. 3: (public_name hello) 4: (libraries (lib)) 5: )) - These parentheses are no longer necessary with dune, please remove them. + Error: Atom expected + Hint: dune files require less parentheses than jbuild files. + If you just converted this file from a jbuild file, try removing these parentheses. [1] $ dune build --root b File "dune", line 4, characters 12-17: (libraries (lib))) ^^^^^ - These parentheses are no longer necessary with dune, please remove them. + Error: 'select' expected + Hint: dune files require less parentheses than jbuild files. + If you just converted this file from a jbuild file, try removing these parentheses. [1] $ dune build --root c File "dune", line 3, characters 7-14: (deps (x y z))) ^^^^^^^ - These parentheses are no longer necessary with dune, please remove them. + Error: Unknown constructor x + Hint: dune files require less parentheses than jbuild files. + If you just converted this file from a jbuild file, try removing these parentheses. [1] Checking that extra long stanzas (over 10 lines) are not printed $ dune build --root d File "dune", line 3, characters 13-192: - These parentheses are no longer necessary with dune, please remove them. + Error: 'select' expected + Hint: dune files require less parentheses than jbuild files. + If you just converted this file from a jbuild file, try removing these parentheses. + [1] + +When the inner syntax is wrong, do not warn about the parens: + + $ dune build --root e + File "dune", line 3, characters 7-15: + (deps (glob *)) ; this form doesn't exist + ^^^^^^^^ + Error: Unknown constructor glob + Hint: dune files require less parentheses than jbuild files. + If you just converted this file from a jbuild file, try removing these parentheses. [1]