diff --git a/CHANGES.md b/CHANGES.md index 7378f5654fc..8fae978da2f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -32,6 +32,10 @@ next directories that include .odoc files, rather than the include flags of the libraries. (#652 fixes #651 @rgrinberg) +- Fix a regression introduced by beta19 where the generated merlin + files didn't include the right `-ppx` flags in some cases (#658 + fixess #657 @diml) + 1.0+beta19.1 (21/03/2018) ------------------------- diff --git a/src/jbuild.mli b/src/jbuild.mli index 3aab2242d6f..cc38d1ea5ce 100644 --- a/src/jbuild.mli +++ b/src/jbuild.mli @@ -47,6 +47,7 @@ module Pp : sig type t = private string val of_string : string -> t val to_string : t -> string + val compare : t -> t -> Ordering.t end module Preprocess : sig diff --git a/src/merlin.ml b/src/merlin.ml index 20ac9ff0ccd..a3d10e39eb8 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -4,10 +4,37 @@ open! No_io module SC = Super_context +module Preprocess = struct + type t = + | Pps of Jbuild.Preprocess.pps + | Other + + let make : Jbuild.Preprocess.t -> t = function + | Pps pps -> Pps pps + | _ -> Other + + let merge a b = + match a, b with + | Other, Other -> Other + | Pps _, Other -> a + | Other, Pps _ -> b + | Pps { pps = pps1; flags = flags1 }, + Pps { pps = pps2; flags = flags2 } -> + match + match List.compare flags1 flags2 ~compare:String.compare with + | Eq -> + List.compare pps1 pps2 ~compare:(fun (_, a) (_, b) -> + Jbuild.Pp.compare a b) + | ne -> ne + with + | Eq -> a + | _ -> Other +end + type t = { requires : (unit, Lib.t list) Build.t ; flags : (unit, string list) Build.t - ; preprocess : Jbuild.Preprocess.t + ; preprocess : Preprocess.t ; libname : string option ; source_dirs: Path.Set.t ; objs_dirs : Path.Set.t @@ -22,9 +49,9 @@ let make ?(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 + { requires = Build.catch requires ~on_error:(fun _ -> []) + ; flags = Build.catch flags ~on_error:(fun _ -> []) + ; preprocess = Preprocess.make preprocess ; libname ; source_dirs ; objs_dirs @@ -46,7 +73,7 @@ let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } = |> String.concat ~sep:" " in [sprintf "FLG -ppx %s" (Filename.quote command)] - | _ -> [] + | Other -> [] let dot_merlin sctx ~dir ~scope ({ requires; flags; _ } as t) = match Path.drop_build_context dir with @@ -125,11 +152,7 @@ let merge_two a b = >>^ fun (x, y) -> Lib.L.remove_dups (x @ y)) ; flags = a.flags &&& b.flags >>^ (fun (a, b) -> a @ b) - ; preprocess = - if a.preprocess = b.preprocess then - a.preprocess - else - No_preprocessing + ; preprocess = Preprocess.merge a.preprocess b.preprocess ; libname = (match a.libname with | Some _ as x -> x diff --git a/src/stdune/list.ml b/src/stdune/list.ml index 00b76b2e91d..06c7cb7df66 100644 --- a/src/stdune/list.ml +++ b/src/stdune/list.ml @@ -87,3 +87,13 @@ let sort t ~compare = let stable_sort t ~compare = stable_sort t ~cmp:(fun a b -> Ordering.to_int (compare a b)) + +let rec compare a b ~compare:f : Ordering.t = + match a, b with + | [], [] -> Eq + | [], _ :: _ -> Lt + | _ :: _, [] -> Gt + | x :: a, y :: b -> + match (f x y : Ordering.t) with + | Eq -> compare a b ~compare:f + | ne -> ne diff --git a/src/stdune/list.mli b/src/stdune/list.mli index d599c4dee73..4cfe2dfdd5c 100644 --- a/src/stdune/list.mli +++ b/src/stdune/list.mli @@ -34,3 +34,5 @@ val last : 'a t -> 'a option val sort : 'a t -> compare:('a -> 'a -> Ordering.t) -> 'a t val stable_sort : 'a t -> compare:('a -> 'a -> Ordering.t) -> 'a t + +val compare : 'a t -> 'a t -> compare:('a -> 'a -> Ordering.t) -> Ordering.t diff --git a/test/blackbox-tests/test-cases/merlin-tests/lib/jbuild b/test/blackbox-tests/test-cases/merlin-tests/lib/jbuild index 5a28827900f..02d88c23859 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/lib/jbuild +++ b/test/blackbox-tests/test-cases/merlin-tests/lib/jbuild @@ -1,4 +1,10 @@ (library ((name foo) (libraries (bytes unix findlib)) + (modules ()) + (preprocess (pps (fooppx))))) + +(library + ((name bar) + (modules ()) (preprocess (pps (fooppx))))) diff --git a/test/blackbox-tests/test-cases/merlin-tests/run.t b/test/blackbox-tests/test-cases/merlin-tests/run.t index 2531cc6fa3d..491098c670a 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/run.t +++ b/test/blackbox-tests/test-cases/merlin-tests/run.t @@ -17,13 +17,18 @@ S $LIB_PREFIX/lib/findlib S $LIB_PREFIX/lib/ocaml # Processing lib/.merlin + B ../_build/default/lib/.bar.objs B ../_build/default/lib/.foo.objs B $LIB_PREFIX/lib/bytes B $LIB_PREFIX/lib/findlib B $LIB_PREFIX/lib/ocaml - FLG -open Foo -w -40 + FLG -open Foo -w -40 -open Bar -w -40 FLG -ppx '$PPX/fooppx@/ppx.exe --as-ppx --cookie '\''library-name="foo"'\''' S . S $LIB_PREFIX/lib/bytes S $LIB_PREFIX/lib/findlib S $LIB_PREFIX/lib/ocaml + +Make sure a ppx directive is generated + + $ grep -q ppx lib/.merlin