matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #1196 from ocaml/fix-1173 

When there are extra parentheses, display the exn
This commit is contained in:
Etienne Millon 2018-08-31 17:59:20 +02:00 committed by GitHub
parent 7cd183877e f8f9db2d9c
commit 2cd796f405
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 160 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES.md
View File

@ -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)
------------------

2
src/js_of_ocaml_rules.ml
View File

@ -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

14
src/lib.ml
View File

@ -1229,16 +1229,14 @@ 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)
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)

2
src/menhir.ml
View File

@ -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). *)

2
src/odoc.ml
View File

@ -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

2
src/preprocessing.ml
View File

@ -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"

167
src/report_error.ml
View File

@ -10,15 +10,81 @@ 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 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 =
{ loc with
start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
}
in
let pp ppf = Format.fprintf ppf "@{<error>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>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>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 "@{<error>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>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 +97,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>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>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>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>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 "@{<error>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>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>Error@}: exception %s\n" s
}
| None -> exn_printer exn
let reported = ref String.Set.empty
@ -157,7 +168,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;

23
src/report_error.mli
View File

@ -11,15 +11,24 @@ 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
(** Register an error reporter. *)
val make_printer :
?backtrace:bool ->
?hint:string ->
?loc:Loc.t ->
(Format.formatter -> unit) ->
printer
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

27
src/stanza.ml
View File

@ -27,21 +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 ->
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"
}
| 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
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 =
@ -64,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))

5
test/blackbox-tests/test-cases/too-many-parens/e/dune Normal file
View File

@ -0,0 +1,5 @@
(alias
(name a)
(deps (glob *)) ; this form doesn't exist
(action (echo test))
)

1
test/blackbox-tests/test-cases/too-many-parens/e/dune-project Normal file
View File

@ -0,0 +1 @@
(lang dune 1.0)

27
test/blackbox-tests/test-cases/too-many-parens/run.t
View File

@ -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]