diff --git a/CHANGES.md b/CHANGES.md index d3aea5f56cde..1bc58987881b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,11 @@ +unreleased +---------- + +- Warn when generated `.merlin` does not reflect the preprocessing + specification. This occurs when multiple stanzas in the same directory use + different preprocessing specifications. This warning can now be disabled with + `allow_approx_merlin` (#1947, fix #1946, @rgrinberg) + 1.8.2 (10/03/2019) ------------------ diff --git a/src/action_dune_lang.ml b/src/action_dune_lang.ml index e4fe35ec72dc..c13f70ab19b0 100644 --- a/src/action_dune_lang.ml +++ b/src/action_dune_lang.ml @@ -22,6 +22,15 @@ let upgrade_to_dune = let encode_and_upgrade a = encode (upgrade_to_dune a) +let remove_locs = + let dir = String_with_vars.make_text Loc.none "" in + let f_program ~dir:_ = String_with_vars.remove_locs in + let f_path ~dir:_ = String_with_vars.remove_locs in + let f_string ~dir:_ = String_with_vars.remove_locs in + Mapper.map ~dir ~f_program ~f_path ~f_string + +let compare_no_locs t1 t2 = compare (remove_locs t1) (remove_locs t2) + open Dune_lang.Decoder let decode = if_list diff --git a/src/action_dune_lang.mli b/src/action_dune_lang.mli index 8882e0a8b905..94cfea67ed80 100644 --- a/src/action_dune_lang.mli +++ b/src/action_dune_lang.mli @@ -1,3 +1,5 @@ +open Stdune + (* This module is to be used in Dune_file. It should not introduce any dependencies unless they're already dependencies of Dune_file *) include Action_intf.Ast @@ -14,3 +16,5 @@ include Action_intf.Helpers type program = String_with_vars.t and type string = String_with_vars.t and type path = String_with_vars.t + +val compare_no_locs : t -> t -> Ordering.t diff --git a/src/dune_project.ml b/src/dune_project.ml index 27f0f523f4cf..f696c1e004af 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -166,6 +166,7 @@ type t = ; parsing_context : Univ_map.t ; implicit_transitive_deps : bool ; dune_version : Syntax.Version.t + ; allow_approx_merlin : bool } let packages t = t.packages @@ -175,10 +176,12 @@ let root t = t.root let stanza_parser t = t.stanza_parser let file t = t.project_file.file let implicit_transitive_deps t = t.implicit_transitive_deps +let allow_approx_merlin t = t.allow_approx_merlin let pp fmt { name ; root ; version ; project_file ; parsing_context = _ ; extension_args = _; stanza_parser = _ ; packages - ; implicit_transitive_deps ; dune_version } = + ; implicit_transitive_deps ; dune_version + ; allow_approx_merlin } = Fmt.record fmt [ "name", Fmt.const Name.pp name ; "root", Fmt.const Path.Local.pp root @@ -191,6 +194,8 @@ let pp fmt { name ; root ; version ; project_file ; parsing_context = _ ; "implicit_transitive_deps", Fmt.const Format.pp_print_bool implicit_transitive_deps ; "dune_version", Fmt.const Syntax.Version.pp dune_version + ; "allow_approx_merlin" + , Fmt.const Format.pp_print_bool allow_approx_merlin ] let find_extension_args t key = @@ -424,7 +429,8 @@ let key = Univ_map.Key.create ~name:"dune-project" (fun { name; root; version; project_file ; stanza_parser = _; packages = _ ; extension_args = _ - ; parsing_context ; implicit_transitive_deps ; dune_version } -> + ; parsing_context ; implicit_transitive_deps ; dune_version + ; allow_approx_merlin } -> Sexp.Encoder.record [ "name", Name.to_sexp name ; "root", Path.Local.to_sexp root @@ -433,6 +439,8 @@ let key = ; "parsing_context", Univ_map.to_sexp parsing_context ; "implicit_transitive_deps", Sexp.Encoder.bool implicit_transitive_deps ; "dune_version", Syntax.Version.to_sexp dune_version + ; "allow_approx_merlin" + , Sexp.Encoder.bool allow_approx_merlin ]) let set t = Dune_lang.Decoder.set key t @@ -473,6 +481,7 @@ let anonymous = lazy ( ; extension_args ; parsing_context ; dune_version = lang.version + ; allow_approx_merlin = true }) let default_name ~dir ~packages = @@ -518,6 +527,9 @@ let parse ~dir ~lang ~packages ~file = and+ implicit_transitive_deps = field_o_b "implicit_transitive_deps" ~check:(Syntax.since Stanza.syntax (1, 7)) + and+ allow_approx_merlin = + field_o_b "allow_approximate_merlin" + ~check:(Syntax.since Stanza.syntax (1, 9)) and+ () = Versioned_file.no_more_lang in let project_file : Project_file.t = @@ -532,6 +544,8 @@ let parse ~dir ~lang ~packages ~file = let implicit_transitive_deps = Option.value implicit_transitive_deps ~default:true in + let allow_approx_merlin = + Option.value ~default:false allow_approx_merlin in { name ; root = get_local_path dir ; version @@ -542,6 +556,7 @@ let parse ~dir ~lang ~packages ~file = ; parsing_context ; implicit_transitive_deps ; dune_version = lang.version + ; allow_approx_merlin }) let load_dune_project ~dir packages = @@ -571,6 +586,7 @@ let make_jbuilder_project ~dir packages = ; parsing_context ; implicit_transitive_deps = true ; dune_version = lang.version + ; allow_approx_merlin = true } let read_name file = diff --git a/src/dune_project.mli b/src/dune_project.mli index 829ae43fbc80..5ef62f1f47ac 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -45,6 +45,7 @@ val version : t -> string option val name : t -> Name.t val root : t -> Path.Local.t val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t +val allow_approx_merlin : t -> bool (** Return the path of the project file. *) val file : t -> Path.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 6c63d710d1ee..2e6a329533b1 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -146,13 +146,17 @@ module Gen(P : Install_rules.Params) = struct ~f:(fun acc a -> For_stanza.cons acc (for_stanza a)) |> For_stanza.rev in - Option.iter (Merlin.merge_all merlins) ~f:(fun m -> - let more_src_dirs = - List.map (Dir_contents.dirs dir_contents) ~f:(fun dc -> - Path.drop_optional_build_context (Dir_contents.dir dc)) - in - Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander ~dir_kind - (Merlin.add_source_dir m src_dir)); + let allow_approx_merlin = + let dune_project = Scope.project scope in + Dune_project.allow_approx_merlin dune_project in + Option.iter (Merlin.merge_all ~allow_approx_merlin merlins) + ~f:(fun m -> + let more_src_dirs = + List.map (Dir_contents.dirs dir_contents) ~f:(fun dc -> + Path.drop_optional_build_context (Dir_contents.dir dc)) + in + Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander ~dir_kind + (Merlin.add_source_dir m src_dir)); List.iter stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with | Menhir.T m when Expander.eval_blang expander m.enabled_if -> diff --git a/src/merlin.ml b/src/merlin.ml index 5e2bbc62d1fe..860b0daa9e10 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -5,29 +5,46 @@ open! No_io module SC = Super_context +let warn_dropped_pp loc ~allow_approx_merlin ~reason = + if not allow_approx_merlin then + Errors.warn loc + ".merlin generated is inaccurate. %s.\n\ + Split the stanzas into different directories or silence this warning \ + by adding (allow_approximate_merlin) to your dune-project." + reason + module Preprocess = struct - let merge (a : Dune_file.Preprocess.t) (b : Dune_file.Preprocess.t) = + + let merge ~allow_approx_merlin + (a : Dune_file.Preprocess.t) (b : Dune_file.Preprocess.t) = match a, b with + (* the 2 cases below aren't entirely correct as it means that we have merlin + preprocess files that don't need to be preprocessed *) | No_preprocessing, pp | pp, No_preprocessing -> pp - | (Action _ as action), _ - | _, (Action _ as action) -> action | (Future_syntax _ as future_syntax), _ | _, (Future_syntax _ as future_syntax) -> future_syntax - | Pps { loc = _; pps = pps1; flags = flags1; staged = s1 }, + | Action (loc, a1), Action (_, a2) -> + if Action_dune_lang.compare_no_locs a1 a2 <> Ordering.Eq then + warn_dropped_pp loc ~allow_approx_merlin + ~reason:"this action preprocessor is not equivalent to other \ + preproocessor specifications."; + Action (loc, a1) + | Pps _, Action (loc, _) + | Action (loc, _), Pps _ -> + warn_dropped_pp loc ~allow_approx_merlin + ~reason:"cannot mix action and pps preprocessors"; + No_preprocessing + | Pps { loc ; pps = pps1; flags = flags1; staged = s1 }, Pps { loc = _; pps = pps2; flags = flags2; staged = s2 } -> - match - match Bool.compare s1 s2 with - | Gt| Lt as ne -> ne - | Eq -> - match List.compare flags1 flags2 ~compare:String.compare with - | Gt | Lt as ne -> ne - | Eq -> - List.compare pps1 pps2 ~compare:(fun (_, a) (_, b) -> - Lib_name.compare a b) - with - | Eq -> a - | _ -> No_preprocessing + if Bool.(<>) s1 s2 + || List.compare flags1 flags2 ~compare:String.compare <> Eq + || List.compare pps1 pps2 ~compare:(fun (_, x) (_, y) -> + Lib_name.compare x y) <> Eq + then + warn_dropped_pp loc ~allow_approx_merlin + ~reason:"pps specification isn't identical in all stanzas"; + No_preprocessing end let quote_for_merlin s = @@ -193,10 +210,10 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander ~dir_kind >>> Build.write_file_dyn merlin_file) -let merge_two a b = +let merge_two ~allow_approx_merlin a b = { requires = Lib.Set.union a.requires b.requires ; flags = a.flags &&& b.flags >>^ (fun (a, b) -> a @ b) - ; preprocess = Preprocess.merge a.preprocess b.preprocess + ; preprocess = Preprocess.merge ~allow_approx_merlin a.preprocess b.preprocess ; libname = (match a.libname with | Some _ as x -> x @@ -205,9 +222,10 @@ let merge_two a b = ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs } -let merge_all = function +let merge_all ~allow_approx_merlin = function | [] -> None - | init::ts -> Some (List.fold_left ~init ~f:merge_two ts) + | init :: ts -> + Some (List.fold_left ~init ~f:(merge_two ~allow_approx_merlin) ts) let add_rules sctx ~dir ~more_src_dirs ~expander ~dir_kind merlin = if (SC.context sctx).merlin then diff --git a/src/merlin.mli b/src/merlin.mli index 8c40929a669b..71091565f79d 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -17,7 +17,7 @@ val make val add_source_dir : t -> Path.t -> t -val merge_all : t list -> t option +val merge_all : allow_approx_merlin:bool -> t list -> t option (** Add rules for generating the .merlin in a directory *) val add_rules diff --git a/src/stanza.ml b/src/stanza.ml index f2aff86811a3..21523a1b604a 100644 --- a/src/stanza.ml +++ b/src/stanza.ml @@ -9,7 +9,7 @@ end let syntax = Syntax.create ~name:"dune" ~desc:"the dune language" [ (0, 0) (* Jbuild syntax *) - ; (1, 8) + ; (1, 9) ] module File_kind = struct diff --git a/src/stdune/loc.ml b/src/stdune/loc.ml index 61e90deef0e2..58dffa1b6ac5 100644 --- a/src/stdune/loc.ml +++ b/src/stdune/loc.ml @@ -40,6 +40,14 @@ let sexp_of_position_no_file (p : Lexing.position) = ; "pos_cnum", int p.pos_cnum ] +let dyn_of_position_no_file (p : Lexing.position) = + let open Dyn in + Record + [ "pos_lnum", Int p.pos_lnum + ; "pos_bol", Int p.pos_bol + ; "pos_cnum", Int p.pos_cnum + ] + let to_sexp t = let open Sexp.Encoder in record (* TODO handle when pos_fname differs *) @@ -48,6 +56,14 @@ let to_sexp t = ; "stop", sexp_of_position_no_file t.stop ] +let to_dyn t = + let open Dyn in + Record + [ "pos_fname", String t.start.pos_fname + ; "start", dyn_of_position_no_file t.start + ; "stop", dyn_of_position_no_file t.stop + ] + let equal_position { Lexing.pos_fname = f_a; pos_lnum = l_a ; pos_bol = b_a; pos_cnum = c_a } diff --git a/src/stdune/loc.mli b/src/stdune/loc.mli index e8b4699ac014..32dcd45a9d5b 100644 --- a/src/stdune/loc.mli +++ b/src/stdune/loc.mli @@ -14,6 +14,8 @@ val of_lexbuf : Lexing.lexbuf -> t val to_sexp : t -> Sexp.t +val to_dyn : t -> Dyn.t + val sexp_of_position_no_file : Lexing.position -> Sexp.t val equal : t -> t -> bool diff --git a/test/blackbox-tests/test-cases/dune-package/run.t b/test/blackbox-tests/test-cases/dune-package/run.t index a0368ff5a518..3a4207d208b6 100644 --- a/test/blackbox-tests/test-cases/dune-package/run.t +++ b/test/blackbox-tests/test-cases/dune-package/run.t @@ -1,6 +1,6 @@ $ dune build $ cat _build/install/default/lib/a/dune-package - (lang dune 1.8) + (lang dune 1.9) (name a) (library (name a) diff --git a/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune-project b/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune-project index 6687faf298a1..60ccc0ab9839 100644 --- a/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune-project +++ b/test/blackbox-tests/test-cases/dune-ppx-driver-system/driver-tests/dune-project @@ -1 +1,3 @@ -(lang dune 1.1) \ No newline at end of file +(lang dune 1.9) + +(allow_approximate_merlin) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/dune-project-edition/run.t b/test/blackbox-tests/test-cases/dune-project-edition/run.t index a951f3433918..7dec689439d7 100644 --- a/test/blackbox-tests/test-cases/dune-project-edition/run.t +++ b/test/blackbox-tests/test-cases/dune-project-edition/run.t @@ -4,10 +4,10 @@ $ echo '(alias (name runtest) (action (progn)))' > src/dune $ dune build Info: creating file dune-project with this contents: - | (lang dune 1.8) + | (lang dune 1.9) $ cat dune-project - (lang dune 1.8) + (lang dune 1.9) Test that using menhir automatically update the dune-project file @@ -15,5 +15,5 @@ Test that using menhir automatically update the dune-project file $ dune build Info: appending this line to dune-project: (using menhir 2.0) $ cat dune-project - (lang dune 1.8) + (lang dune 1.9) (using menhir 2.0) diff --git a/test/blackbox-tests/test-cases/github1529/run.t b/test/blackbox-tests/test-cases/github1529/run.t index d396ada44b73..80391f717a19 100644 --- a/test/blackbox-tests/test-cases/github1529/run.t +++ b/test/blackbox-tests/test-cases/github1529/run.t @@ -3,6 +3,6 @@ file is present. $ dune build Info: creating file dune-project with this contents: - | (lang dune 1.8) + | (lang dune 1.9) Info: appending this line to dune-project: (using menhir 2.0) diff --git a/test/blackbox-tests/test-cases/github1549/run.t b/test/blackbox-tests/test-cases/github1549/run.t index 07c326f75367..5eda7c79de1b 100644 --- a/test/blackbox-tests/test-cases/github1549/run.t +++ b/test/blackbox-tests/test-cases/github1549/run.t @@ -4,7 +4,7 @@ Reproduction case for #1549: too many parentheses in installed .dune files Entering directory 'backend' $ cat backend/_build/install/default/lib/dune_inline_tests/dune-package - (lang dune 1.8) + (lang dune 1.9) (name dune_inline_tests) (library (name dune_inline_tests) diff --git a/test/blackbox-tests/test-cases/github1946/run.t b/test/blackbox-tests/test-cases/github1946/run.t index 6a18e6deefcf..c3b9af178894 100644 --- a/test/blackbox-tests/test-cases/github1946/run.t +++ b/test/blackbox-tests/test-cases/github1946/run.t @@ -1,2 +1,7 @@ $ dune build --display short --profile release | grep "FLG -ppx" + File "dune", line 4, characters 13-23: + 4 | (preprocess (pps ppx1))) + ^^^^^^^^^^ + Warning: .merlin generated is inaccurate. pps specification isn't identical in all stanzas. + Split the stanzas into different directories or silence this warning by adding (allow_approximate_merlin) to your dune-project. [1] diff --git a/test/blackbox-tests/test-cases/inline_tests/run.t b/test/blackbox-tests/test-cases/inline_tests/run.t index cf56350d2118..974192cba1d9 100644 --- a/test/blackbox-tests/test-cases/inline_tests/run.t +++ b/test/blackbox-tests/test-cases/inline_tests/run.t @@ -25,7 +25,7 @@ backend_mbc1 $ dune runtest dune-file - (lang dune 1.8) + (lang dune 1.9) (name foo) (library (name foo) diff --git a/test/blackbox-tests/test-cases/merlin-tests/run.t b/test/blackbox-tests/test-cases/merlin-tests/run.t index ac16b6ea943c..67c1b62bee56 100644 --- a/test/blackbox-tests/test-cases/merlin-tests/run.t +++ b/test/blackbox-tests/test-cases/merlin-tests/run.t @@ -30,9 +30,9 @@ S $LIB_PREFIX/lib/ocaml S . S subdir - FLG -ppx '$PPX/828e4b66a2fd80eb3721c549ea6f718d/ppx.exe --as-ppx --cookie '\''library-name="foo"'\''' FLG -open Foo -w -40 -open Bar -w -40 Make sure a ppx directive is generated $ grep -q ppx lib/.merlin + [1] diff --git a/test/blackbox-tests/test-cases/variants/run.t b/test/blackbox-tests/test-cases/variants/run.t index b947285690d4..e5d7e1dac8d3 100644 --- a/test/blackbox-tests/test-cases/variants/run.t +++ b/test/blackbox-tests/test-cases/variants/run.t @@ -305,7 +305,7 @@ Implement external virtual libraries with private modules Include variants and implementation information in dune-package $ dune build --root dune-package-info Entering directory 'dune-package-info' - (lang dune 1.8) + (lang dune 1.9) (name foo) (library (name foo.impl)