Merge pull request #569 from ocaml/fix-568

Fix #51 & #568

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

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
 

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

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) []
 

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

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

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

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
 

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

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}

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

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

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

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