From ccabeb7181f2d85512be7d142ad269222171549f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sun, 8 Jul 2018 17:25:26 +0700 Subject: [PATCH] Hack to fix printing of errors This is a temporary hack until we have a real sexp type Signed-off-by: Rudi Grinberg --- src/report_error.ml | 2 +- src/usexp/usexp.ml | 12 +++++ src/usexp/usexp.mli | 4 ++ .../test-cases/form-error/run.t | 54 +++++++++---------- 4 files changed, 43 insertions(+), 29 deletions(-) diff --git a/src/report_error.ml b/src/report_error.ml index 8e6dc01b..f19eaa7e 100644 --- a/src/report_error.ml +++ b/src/report_error.ml @@ -75,7 +75,7 @@ let report_with_backtrace exn = Format.fprintf ppf "@{Internal error, please report upstream \ including the contents of _build/log.@}\n\ Description:%a\n" - (Usexp.pp Dune) sexp + Usexp.pp_quoted sexp } | Unix.Unix_error (err, func, fname) -> { p with pp = fun ppf -> diff --git a/src/usexp/usexp.ml b/src/usexp/usexp.ml index b687686e..eb28b04a 100644 --- a/src/usexp/usexp.ml +++ b/src/usexp/usexp.ml @@ -41,6 +41,18 @@ let rec pp syntax ppf = function Format.pp_close_box ppf () | Template t -> Template.pp syntax ppf t +let pp_quoted = + let rec loop = function + | Atom (A s) as t -> + if Atom.is_valid_dune s then + t + else + Quoted_string s + | List xs -> List (List.map ~f:loop xs) + | (Quoted_string _ | Template _) as t -> t + in + fun ppf t -> pp Dune ppf (loop t) + let pp_print_quoted_string ppf s = let syntax = Dune in if String.contains s '\n' then begin diff --git a/src/usexp/usexp.mli b/src/usexp/usexp.mli index bc0ad768..31810267 100644 --- a/src/usexp/usexp.mli +++ b/src/usexp/usexp.mli @@ -76,6 +76,10 @@ val to_string : t -> syntax:syntax -> string (** Serialize a S-expression using indentation to improve readability *) val pp : syntax -> Format.formatter -> t -> unit +(** Serialization that never fails because it quotes atoms when necessary + TODO remove this once we have a proper sexp type *) +val pp_quoted : Format.formatter -> t -> unit + (** Same as [pp ~syntax:Dune], but split long strings. The formatter must have been prepared with [prepare_formatter]. *) val pp_split_strings : Format.formatter -> t -> unit diff --git a/test/blackbox-tests/test-cases/form-error/run.t b/test/blackbox-tests/test-cases/form-error/run.t index a9f8e620..cccf6546 100644 --- a/test/blackbox-tests/test-cases/form-error/run.t +++ b/test/blackbox-tests/test-cases/form-error/run.t @@ -3,32 +3,30 @@ inappropariate place: $ dune build Info: creating file dune-project with this contents: (lang dune 1.0) - /----------------------------------------------------------------------- - | Internal error: Fiber.Execution_context.forward_error: error handler raised. - | Invalid_argument("atom '%{read:x}' cannot be in dune syntax") - | Raised at file "pervasives.ml", line 33, characters 20-45 - | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "format.ml", line 1288, characters 32-48 - | Called from file "format.ml", line 1337, characters 20-38 - | Called from file "src/report_error.ml", line 108, characters 4-12 - | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 - | Re-raised at file "src/fiber/fiber.ml", line 39, characters 19-26 - | Called from file "src/fiber/fiber.ml", line 56, characters 6-20 - | - | Original exception was: Invalid_argument("atom '%{read:x}' cannot be in dune syntax") - | Raised at file "pervasives.ml", line 33, characters 20-45 - | Called from file "src/usexp/usexp.ml", line 26, characters 31-52 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "list.ml", line 100, characters 12-15 - | Called from file "src/usexp/usexp.ml", line 36, characters 4-96 - | Called from file "format.ml", line 1288, characters 32-48 - | Called from file "format.ml", line 1337, characters 20-38 - | Called from file "src/report_error.ml", line 108, characters 4-12 - | Called from file "src/fiber/fiber.ml", line 243, characters 6-18 - \----------------------------------------------------------------------- + Internal error, please report upstream including the contents of _build/log. + Description: + ("expand_vars can't expand macros" (var "\%{read:x}")) + Backtrace: + Raised at file "src/stdune/exn.ml", line 32, characters 5-10 + Called from file "src/super_context.ml", line 105, characters 12-46 + Called from file "src/string_with_vars.ml", line 276, characters 12-32 + Called from file "src/string_with_vars.ml", line 252, characters 20-40 + Called from file "src/string_with_vars.ml", line 275, characters 4-487 + Called from file "src/super_context.ml", line 118, characters 4-38 + Called from file "src/gen_rules.ml", line 204, characters 21-68 + Called from file "src/gen_rules.ml", line 261, characters 25-68 + Called from file "list.ml", line 82, characters 20-23 + Called from file "src/stdune/list.ml" (inlined), line 29, characters 29-39 + Called from file "src/gen_rules.ml", line 254, characters 12-827 + Called from file "src/stdune/hashtbl.ml", line 80, characters 12-17 + Called from file "src/gen_rules.ml", line 1023, characters 16-39 + Called from file "src/gen_rules.ml", line 1086, characters 19-30 + Called from file "src/build_system.ml", line 917, characters 6-62 + Called from file "src/build_system.ml", line 893, characters 6-59 + Re-raised at file "src/build_system.ml", line 904, characters 6-17 + Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 + Called from file "src/build_system.ml", line 871, characters 4-24 + Called from file "src/build_system.ml" (inlined), line 861, characters 32-63 + Called from file "src/build_system.ml", line 1115, characters 6-21 + Called from file "src/fiber/fiber.ml", line 160, characters 6-169 [1]