diff --git a/CHANGES.md b/CHANGES.md index 73a41bc1..b022f296 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,8 @@ +next +---- + +- Ignore errors during the generation of the .merlin (#569, fixes #568 and #51) + 1.0+beta18 (25/02/2018) ----------------------- diff --git a/src/build.ml b/src/build.ml index 7006fedd..4902aba9 100644 --- a/src/build.ml +++ b/src/build.ml @@ -37,6 +37,7 @@ module Repr = struct | Record_lib_deps : lib_deps -> ('a, 'a) t | Fail : fail -> (_, _) t | Memo : 'a memo -> (unit, 'a) t + | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t and 'a memo = { name : string @@ -135,6 +136,8 @@ let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re))) let vpath vp = Vpath vp let dyn_paths t = Dyn_paths t +let catch t ~on_error = Catch (t, on_error) + let contents p = Contents p let lines_of p = Lines_of p diff --git a/src/build.mli b/src/build.mli index 4e1bc60e..9a297f19 100644 --- a/src/build.mli +++ b/src/build.mli @@ -43,6 +43,10 @@ val vpath : 'a Vspec.t -> (unit, 'a) t val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t +(** [catch t ~on_error] evaluates to [on_error exn] if exception [exn] is + raised during the evaluation of [t]. *) +val catch : ('a, 'b) t -> on_error:(exn -> 'b) -> ('a, 'b) t + (** [contents path] returns an arrow that when run will return the contents of the file at [path]. *) val contents : Path.t -> ('a, string) t @@ -157,6 +161,7 @@ module Repr : sig | Record_lib_deps : lib_deps -> ('a, 'a) t | Fail : fail -> (_, _) t | Memo : 'a memo -> (unit, 'a) t + | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t and 'a memo = { name : string diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 6a715368..42c4a902 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -112,6 +112,7 @@ let static_deps t ~all_targets ~file_tree = | Record_lib_deps _ -> acc | Fail _ -> acc | Memo m -> loop m.t acc + | Catch (t, _) -> loop t acc in loop (Build.repr t) { rule_deps = Pset.empty; action_deps = Pset.empty } @@ -138,6 +139,7 @@ let lib_deps = | If_file_exists (_, state) -> loop (get_if_file_exists_exn state) acc | Memo m -> loop m.t acc + | Catch (t, _) -> loop t acc in fun t -> loop (Build.repr t) String_map.empty @@ -172,6 +174,7 @@ let targets = under a [if_file_exists]" end | Memo m -> loop m.t acc + | Catch (t, _) -> loop t acc in fun t -> loop (Build.repr t) [] diff --git a/src/build_system.ml b/src/build_system.ml index 05c6e86b..f10d0660 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -454,6 +454,12 @@ module Build_exec = struct | Fail { fail } -> fail () | If_file_exists (_, state) -> exec dyn_deps (get_if_file_exists_exn state) x + | Catch (t, on_error) -> begin + try + exec dyn_deps t x + with exn -> + on_error exn + end | Memo m -> match m.state with | Evaluated (x, deps) -> diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 6354b110..17bf1383 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -721,14 +721,12 @@ module Gen(P : Install_rules.Params) = struct ; compile_info }; - { Merlin. - requires = real_requires - ; flags - ; preprocess = Buildable.single_preprocess lib.buildable - ; libname = Some lib.name - ; source_dirs = Path.Set.empty - ; objs_dirs = Path.Set.singleton obj_dir - } + Merlin.make () + ~requires:real_requires + ~flags + ~preprocess:(Buildable.single_preprocess lib.buildable) + ~libname:lib.name + ~objs_dirs:(Path.Set.singleton obj_dir) (* +-----------------------------------------------------------------+ | Executables stuff | @@ -819,14 +817,11 @@ module Gen(P : Install_rules.Params) = struct ~link_flags ~js_of_ocaml:exes.buildable.js_of_ocaml; - { Merlin. - requires = real_requires - ; flags = Ocaml_flags.common flags - ; preprocess = Buildable.single_preprocess exes.buildable - ; libname = None - ; source_dirs = Path.Set.empty - ; objs_dirs = Path.Set.singleton obj_dir - } + Merlin.make () + ~requires:real_requires + ~flags:(Ocaml_flags.common flags) + ~preprocess:(Buildable.single_preprocess exes.buildable) + ~objs_dirs:(Path.Set.singleton obj_dir) (* +-----------------------------------------------------------------+ | Aliases | @@ -892,19 +887,11 @@ module Gen(P : Install_rules.Params) = struct Path.parent (Path.relative src_dir src_glob ~error_loc:loc) in Some - { Merlin.requires = Build.return [] - ; flags = Build.return [] - ; preprocess = Jbuild.Preprocess.No_preprocessing - ; libname = None - ; source_dirs = Path.Set.singleton src_dir - ; objs_dirs = Path.Set.empty - } + (Merlin.make () + ~source_dirs:(Path.Set.singleton src_dir)) | _ -> None) |> Merlin.merge_all - |> Option.map ~f:(fun (m : Merlin.t) -> - { m with source_dirs = - Path.Set.add m.source_dirs (Path.relative src_dir ".") - }) + |> Option.map ~f:(fun m -> Merlin.add_source_dir m src_dir) |> Option.iter ~f:(Merlin.add_rules sctx ~dir:ctx_dir ~scope); Utop.setup sctx ~dir:ctx_dir ~libs:( List.filter_map stanzas ~f:(function diff --git a/src/merlin.ml b/src/merlin.ml index 62a302ab..20ac9ff0 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -13,6 +13,26 @@ type t = ; objs_dirs : Path.Set.t } +let make + ?(requires=Build.return []) + ?(flags=Build.return []) + ?(preprocess=Jbuild.Preprocess.No_preprocessing) + ?libname + ?(source_dirs=Path.Set.empty) + ?(objs_dirs=Path.Set.empty) + () = + (* Merlin shouldn't cause the build to fail, so we just ignore errors *) + { requires = Build.catch requires ~on_error:(fun _ -> []) + ; flags = Build.catch flags ~on_error:(fun _ -> []) + ; preprocess + ; libname + ; source_dirs + ; objs_dirs + } + +let add_source_dir t dir = + { t with source_dirs = Path.Set.add t.source_dirs dir } + let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } = match preprocess with | Pps { pps; flags } -> diff --git a/src/merlin.mli b/src/merlin.mli index 3460816a..9b552e26 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -1,13 +1,18 @@ (** Merlin rules *) -type t = - { requires : (unit, Lib.t list) Build.t - ; flags : (unit, string list) Build.t - ; preprocess : Jbuild.Preprocess.t - ; libname : string option - ; source_dirs: Path.Set.t - ; objs_dirs : Path.Set.t - } +type t + +val make + : ?requires:(unit, Lib.t list) Build.t + -> ?flags:(unit, string list) Build.t + -> ?preprocess:Jbuild.Preprocess.t + -> ?libname:string + -> ?source_dirs: Path.Set.t + -> ?objs_dirs:Path.Set.t + -> unit + -> t + +val add_source_dir : t -> Path.t -> t val merge_all : t list -> t option diff --git a/test/blackbox-tests/jbuild b/test/blackbox-tests/jbuild index bc13699b..5fda7ae6 100644 --- a/test/blackbox-tests/jbuild +++ b/test/blackbox-tests/jbuild @@ -388,3 +388,13 @@ (progn (run ${exe:cram.exe} run.t) (diff? run.t run.t.corrected))))))) + +(alias + ((name runtest) + (deps ((files_recursively_in test-cases/github568))) + (action + (chdir test-cases/github568 + (setenv JBUILDER ${bin:jbuilder} + (progn + (run ${exe:cram.exe} run.t) + (diff? run.t run.t.corrected))))))) diff --git a/test/blackbox-tests/test-cases/github25/root/run.t b/test/blackbox-tests/test-cases/github25/root/run.t index ce8c4526..157e3265 100644 --- a/test/blackbox-tests/test-cases/github25/root/run.t +++ b/test/blackbox-tests/test-cases/github25/root/run.t @@ -14,11 +14,11 @@ We need ocamlfind to run this test ocamlopt hello.cmxs $ $JBUILDER build -j1 @install --display short --root . --only pas-de-bol 2>&1 | sed 's/[^ "]*findlib-packages/.../' + ocamldep a.ml.d File ".../plop/META", line 1, characters 0-0: Error: Library "une-lib-qui-nexiste-pas" not found. -> required by library "plop.ca-marche-pas" in .../plop Hint: try: jbuilder external-lib-deps --missing --root . --only-packages pas-de-bol @install - ocamldep a.ml.d ocamldep b.ml.d ocamlc .pas_de_bol.objs/pas_de_bol.{cmi,cmo,cmt} ocamlopt .pas_de_bol.objs/pas_de_bol.{cmx,o} diff --git a/test/blackbox-tests/test-cases/github568/jbuild b/test/blackbox-tests/test-cases/github568/jbuild new file mode 100644 index 00000000..508fc1dd --- /dev/null +++ b/test/blackbox-tests/test-cases/github568/jbuild @@ -0,0 +1,35 @@ +(jbuild_version 1) + + +(library + ((name lib1) + (public_name lib1) + (modules (Lib1)))) + +(alias + ((name runtest) + (package lib1) + (deps (test1.exe)) + (action (run ${<})))) + +(executable + ((name test1) + (modules (Test1)) + (libraries (lib1)))) + + +(library + ((name lib2) + (public_name lib2) + (modules (Lib2)))) + +(alias + ((name runtest) + (package lib2) + (deps (test2.exe)) + (action (run ${<})))) + +(executable + ((name test2) + (modules (Test2)) + (libraries (lib2)))) diff --git a/test/blackbox-tests/test-cases/github568/lib1.ml b/test/blackbox-tests/test-cases/github568/lib1.ml new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/github568/lib1.opam b/test/blackbox-tests/test-cases/github568/lib1.opam new file mode 100644 index 00000000..505d9257 --- /dev/null +++ b/test/blackbox-tests/test-cases/github568/lib1.opam @@ -0,0 +1,4 @@ +opam-version: "1.2" +name: "lib1" +build: [["jbuilder" "build" "-p" name "-j" jobs]] +build-test: [["jbuilder" "runtest" "-p" name "-j" jobs]] diff --git a/test/blackbox-tests/test-cases/github568/lib2.ml b/test/blackbox-tests/test-cases/github568/lib2.ml new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/github568/lib2.opam b/test/blackbox-tests/test-cases/github568/lib2.opam new file mode 100644 index 00000000..b29dfc9c --- /dev/null +++ b/test/blackbox-tests/test-cases/github568/lib2.opam @@ -0,0 +1,4 @@ +opam-version: "1.2" +name: "lib2" +build: [["jbuilder" "build" "-p" name "-j" jobs]] +build-test: [["jbuilder" "runtest" "-p" name "-j" jobs]] diff --git a/test/blackbox-tests/test-cases/github568/run.t b/test/blackbox-tests/test-cases/github568/run.t new file mode 100644 index 00000000..e339f7c2 --- /dev/null +++ b/test/blackbox-tests/test-cases/github568/run.t @@ -0,0 +1,10 @@ + $ $JBUILDER runtest --display short -j1 -p lib1 --debug-dependency-path + ocamldep test1.ml.d + ocamldep lib1.ml.d + ocamlc .lib1.objs/lib1.{cmi,cmo,cmt} + ocamlc .test1.eobjs/test1.{cmi,cmo,cmt} + ocamlopt .lib1.objs/lib1.{cmx,o} + ocamlopt .test1.eobjs/test1.{cmx,o} + ocamlopt lib1.{a,cmxa} + ocamlopt test1.exe + test1 alias runtest diff --git a/test/blackbox-tests/test-cases/github568/test1.ml b/test/blackbox-tests/test-cases/github568/test1.ml new file mode 100644 index 00000000..e69de29b diff --git a/test/blackbox-tests/test-cases/github568/test2.ml b/test/blackbox-tests/test-cases/github568/test2.ml new file mode 100644 index 00000000..e69de29b