From 1d21660d3aff2c43a12ea1430eff8d7be1ab53fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 15 Jun 2020 14:52:51 +0200 Subject: [PATCH 01/36] Disable .merlin files promotion and rename them MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index e13681770f9..b147f4c991e 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -159,7 +159,7 @@ let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ; extensions } -let merlin_file_name = ".merlin" +let merlin_file_name = ".merlin-conf" let add_source_dir t dir = { t with source_dirs = Path.Source.Set.add t.source_dirs dir } @@ -288,9 +288,7 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander Dot_file.to_string ~remaindir ~pp ~flags ~src_dirs ~obj_dirs ~extensions) in - SC.add_rule sctx ~dir - ~mode:(Promote { lifetime = Until_clean; into = None; only = None }) - action) + SC.add_rule sctx ~dir action) let merge_two ~allow_approx_merlin a b = { requires = Lib.Set.union a.requires b.requires From 6f002242c565f92b6064d779085a8761b80b60a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 15 Jun 2020 14:29:35 +0200 Subject: [PATCH 02/36] Rework merlin file generation and serving MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Make merlin server return absolute paths - Remove useless drop_optional_build_context - Recursive search for .merlin in build context - Add error message for when project isn't built yet - Write merlin conf as a CSEXP - Remove need for some of the specific quoting Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 176 ++++++++++++++++---------------- src/dune_rules/merlin_server.ml | 115 ++++++++------------- 2 files changed, 133 insertions(+), 158 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index b147f4c991e..5b72278fe8b 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -63,44 +63,39 @@ module Pp = struct pp end -let quote_for_merlin s = - let s = - if Sys.win32 then - (* We need this hack because merlin unescapes backslashes (except when - protected by single quotes). It is only a problem on windows because - Filename.quote is using double quotes. *) - String.escape_only '\\' s - else - s - in - if String.need_quoting s then - Filename.quote s - else - s - module Dot_file = struct - let b = Buffer.create 256 - - let printf f = Printf.bprintf b f - - let print = Buffer.add_string b - - let to_string ~obj_dirs ~src_dirs ~flags ~pp ~remaindir ~extensions = - let serialize_path = Path.reach ~from:(Path.source remaindir) in - Buffer.clear b; - print "EXCLUDE_QUERY_DIR\n"; - Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); - Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); - Option.iter pp ~f:(printf "%s\n"); - ( match flags with - | [] -> () - | flags -> - print "FLG"; - List.iter flags ~f:(fun f -> printf " %s" (quote_for_merlin f)); - print "\n" ); - Extensions.Set.iter extensions ~f:(fun (impl, intf) -> - printf "SUFFIX %s %s\n" (quote_for_merlin impl) (quote_for_merlin intf)); - Buffer.contents b + let to_string ~obj_dirs ~src_dirs ~flags ~pp ~extensions = + let serialize_path = Path.to_absolute_filename in + let to_atom s = Sexp.Atom s in + let make_directive tag value = Sexp.List [ Atom tag; value ] in + let make_directive_of_path tag path = + make_directive tag (Sexp.Atom (serialize_path path)) + in + let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in + let obj_dirs = + Path.Set.to_list obj_dirs |> List.map ~f:(make_directive_of_path "B") + in + let src_dirs = + Path.Set.to_list src_dirs |> List.map ~f:(make_directive_of_path "S") + in + let flags = + let flags = + match flags with + | [] -> [] + | flags -> + [ make_directive "FLG" (Sexp.List (List.map ~f:to_atom flags)) ] + in + match pp with + | Some (pp_flag, pp_args) -> + make_directive "FLG" (Sexp.List [ Atom pp_flag; Atom pp_args ]) :: flags + | None -> flags + in + let suffixes = + Extensions.Set.to_list extensions |> List.map ~f:(fun (impl, intf) -> + make_directive "SUFFIX" (Sexp.Atom ((Printf.sprintf "%s %s" impl intf)))) + in + Csexp.to_string + (Sexp.List (List.concat [ exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ])) end type t = @@ -164,8 +159,14 @@ let merlin_file_name = ".merlin-conf" let add_source_dir t dir = { t with source_dirs = Path.Source.Set.add t.source_dirs dir } +let quote_if_needed s = + if String.need_quoting s then + Filename.quote s + else + s + let pp_flag_of_action ~expander ~loc ~action : - string option Build.With_targets.t = + (string * string) option Build.With_targets.t = match (action : Action_dune_lang.t) with | Run (exe, args) -> ( let args = @@ -193,10 +194,12 @@ let pp_flag_of_action ~expander ~loc ~action : match exe with | Error _ -> None | Ok exe -> - Path.to_absolute_filename exe :: args - |> List.map ~f:quote_for_merlin - |> String.concat ~sep:" " |> Filename.quote |> sprintf "FLG -pp %s" - |> Option.some + let args = + Path.to_absolute_filename exe :: args + |> List.map ~f:quote_if_needed + |> String.concat ~sep:" " + in + Some ("-pp", args) in Build.With_targets.map action ~f:(function | Run (exe, args) -> pp_of_action exe args @@ -206,7 +209,7 @@ let pp_flag_of_action ~expander ~loc ~action : | _ -> Build.With_targets.return None let pp_flags sctx ~expander { preprocess; libname; _ } : - string option Build.With_targets.t = + (string * string) option Build.With_targets.t = let scope = Expander.scope expander in match Preprocess.remove_future_syntax preprocess ~for_:Merlin @@ -219,10 +222,12 @@ let pp_flags sctx ~expander { preprocess; libname; _ } : with | Error _exn -> Build.With_targets.return None | Ok (exe, flags) -> - Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags - |> List.map ~f:quote_for_merlin - |> String.concat ~sep:" " |> Filename.quote |> sprintf "FLG -ppx %s" - |> Option.some |> Build.With_targets.return ) + let args = + Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags + |> List.map ~f:quote_if_needed + |> String.concat ~sep:" " + in + Build.With_targets.return (Some ("-ppx", args)) ) | Action (loc, (action : Action_dune_lang.t)) -> pp_flag_of_action ~expander ~loc ~action | No_preprocessing -> Build.With_targets.return None @@ -246,49 +251,44 @@ let lib_src_dirs ~sctx lib = Path.Set.map ~f:Path.drop_optional_build_context (Modules.source_dirs modules) -let dot_merlin sctx ~dir ~more_src_dirs ~expander - ({ requires; flags; extensions; _ } as t) = - Path.Build.drop_build_context dir - |> Option.iter ~f:(fun remaindir -> - let open Build.With_targets.O in - let merlin_file = Path.Build.relative dir merlin_file_name in +let dot_merlin sctx ~dir ~more_src_dirs ~expander ({ requires; flags; extensions; _ } as t) + = + let open Build.With_targets.O in + let merlin_file = Path.Build.relative dir merlin_file_name in - (* We make the compilation of .ml/.mli files depend on the existence of - .merlin so that they are always generated, however the command - themselves don't read the merlin file, so we don't want to declare a - dependency on the contents of the .merlin file. + (* We make the compilation of .ml/.mli files depend on the existence of + .merlin so that they are always generated, however the command themselves + don't read the merlin file, so we don't want to declare a dependency on the + contents of the .merlin file. - Currently dune doesn't support declaring a dependency only on the - existence of a file, so we have to use this trick. *) - SC.add_rule sctx ~dir - ( Build.with_no_targets (Build.path (Path.build merlin_file)) - >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); - Path.Set.singleton (Path.build merlin_file) - |> Rules.Produce.Alias.add_deps (Alias.check ~dir); - let pp_flags = pp_flags sctx ~expander t in - let action = - Build.With_targets.write_file_dyn merlin_file - (let+ flags = Build.with_no_targets flags - and+ pp = pp_flags in - let src_dirs, obj_dirs = - Lib.Set.fold requires - ~init:(Path.set_of_source_paths t.source_dirs, t.objs_dirs) - ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> - let more_src_dirs = lib_src_dirs ~sctx lib in - ( Path.Set.union src_dirs more_src_dirs - , let public_cmi_dir = - Obj_dir.public_cmi_dir (Lib.obj_dir lib) - in - Path.Set.add obj_dirs public_cmi_dir )) - in - let src_dirs = - Path.Set.union src_dirs - (Path.Set.of_list_map ~f:Path.source more_src_dirs) - in - Dot_file.to_string ~remaindir ~pp ~flags ~src_dirs ~obj_dirs - ~extensions) - in - SC.add_rule sctx ~dir action) + Currently dune doesn't support declaring a dependency only on the existence + of a file, so we have to use this trick. *) + SC.add_rule sctx ~dir + ( Build.with_no_targets (Build.path (Path.build merlin_file)) + >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); + Path.Set.singleton (Path.build merlin_file) + |> Rules.Produce.Alias.add_deps (Alias.check ~dir); + let pp_flags = pp_flags sctx ~expander t in + let action = + Build.With_targets.write_file_dyn merlin_file + (let+ flags = Build.with_no_targets flags + and+ pp = pp_flags in + let src_dirs, obj_dirs = + Lib.Set.fold requires + ~init:(Path.set_of_source_paths t.source_dirs, t.objs_dirs) + ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> + let more_src_dirs = lib_src_dirs ~sctx lib in + ( Path.Set.union src_dirs more_src_dirs + , let public_cmi_dir = Obj_dir.public_cmi_dir (Lib.obj_dir lib) in + Path.Set.add obj_dirs public_cmi_dir )) + in + let src_dirs = + Path.Set.union src_dirs + (Path.Set.of_list_map ~f:Path.source more_src_dirs) + in + Dot_file.to_string ~pp ~flags ~src_dirs ~obj_dirs ~extensions) + in + SC.add_rule sctx ~dir action let merge_two ~allow_approx_merlin a b = { requires = Lib.Set.union a.requires b.requires diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index ac477f55ba5..424a6f841c0 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -2,49 +2,19 @@ open! Dune_engine open! Stdune open Import -module Dot_merlin = struct - type directive = - | EXCLUDE_QUERY_DIR - | TAG of string * string +module Merlin_conf = struct + type t = Sexp.t - type t = directive list + let make_error msg = Sexp.(List [ List [ Atom "ERROR"; Atom msg ] ]) - let error_tag = "ERROR" + let parse ~origin:_ content : t = + match Csexp.parse_string content with + | Ok (Sexp.List sexps) -> Sexp.List sexps + | _ -> Sexp.List [] - (* [parse_line l] parses dune-generated .merlin files which only contain a - subset of merlin configuration options *) - let parse_line line = - let line = String.trim line in - match line with - | "EXCLUDE_QUERY_DIR" -> Some EXCLUDE_QUERY_DIR - | line when String.length line = 0 || line.[0] = '#' -> None - | line -> ( - let open Re in - let re = - seq [ group (rep1 upper); rep1 space; group (rep1 notnl) ] - |> case |> compile - in - try - match Group.all (exec re line) with - | [| _; tag; value |] -> Some (TAG (tag, value)) - | _ -> raise Not_found - with Not_found -> - let msg = Printf.sprintf "Malformed directive \"%s\"" line in - Some (TAG (error_tag, msg)) ) - - let parse_lines lines : t = List.filter_map ~f:parse_line lines - - let directive_to_sexp = - let open Sexp in - function - | EXCLUDE_QUERY_DIR -> List [ Atom "EXCLUDE_QUERY_DIR" ] - | TAG (tag, value) -> List [ Atom tag; Atom value ] - - let make_error msg = [ TAG (error_tag, msg) ] - - let to_sexp t = Sexp.List (List.map ~f:directive_to_sexp t) - - let to_channel ~out_channel t = Csexp.to_channel out_channel (to_sexp t) + let to_stdout (t : t) = + Csexp.to_channel stdout t; + flush stdout end module Commands = struct @@ -53,7 +23,6 @@ module Commands = struct | Halt | Unknown of string - (* The configuration server will halt on EOF or bad c-sexp *) let read_input in_channel = match Csexp.input in_channel with | Ok sexp -> ( @@ -69,7 +38,7 @@ end (* [to_local p] makes absolute path [p] relative to the projects root and optionally removes the build context *) -let _to_local abs_file_path = +let to_local abs_file_path = let error msg = Error msg in let path_opt = String.drop_prefix @@ -78,48 +47,54 @@ let _to_local abs_file_path = in match path_opt with | Some path -> ( - try - Ok - Path.( - Filename.concat "." path |> of_string |> drop_optional_build_context - |> local_part) + try Ok Path.(Filename.concat "." path |> of_string |> local_part) with _ -> Printf.sprintf "Could not resolve path %s" path |> error ) | None -> Printf.sprintf "Path is not in dune workspace %s" abs_file_path |> error -let load_merlin_file dir = +let get_context_root () = let workspace = Workspace.workspace () in let context = Option.value ~default:Context_name.default workspace.merlin_context in let ctx = Context_name.to_string context in - let dir_path = Path.Build.(append_local (relative root ctx) dir) in - let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in - if Path.exists (Path.build file_path) then - let build = Build.lines_of (Path.build file_path) in - let lines, _ = Build.exec build in - Dot_merlin.parse_lines lines - else - [] + Path.Build.(relative root ctx) -let out s = - Dot_merlin.to_channel ~out_channel:stdout s; - flush stdout +let load_merlin_file dir = + let ctx_root = get_context_root () in + + let no_config_error () = + Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" + in + + let rec try_path path = + let dir_path = Path.Build.(append_local ctx_root path) in + let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in + if Path.(exists (build file_path)) then + let build = Build.contents (Path.build file_path) in + let content, _ = Build.exec build in + Merlin_conf.parse ~origin:path content + else if + (* We loop until reaching the context's root or finding a .merlin-conf + file *) + Path.Build.is_descendant ~of_:ctx_root dir_path + then + match Path.Local.parent path with + | Some p -> try_path p + | None -> no_config_error () + else + no_config_error () + in + try_path dir let print_merlin_conf file = - let _dir, _file = Filename.(dirname file, basename file) in + let abs_root, _file = Filename.(dirname file, basename file) in let answer = - (* TODO Remove this permanent error when dune stops generating `.merlin` - files *) - match - Error - "No configuration file found. Try calling `dune build` to generate \ - `.merlin` files." - with + match to_local abs_root with | Ok p -> load_merlin_file p - | Error s -> Dot_merlin.make_error s + | Error s -> Merlin_conf.make_error s in - out answer + Merlin_conf.to_stdout answer let start () = let rec main () = @@ -128,7 +103,7 @@ let start () = print_merlin_conf path; main () | Unknown msg -> - out (Dot_merlin.make_error msg); + Merlin_conf.to_stdout (Merlin_conf.make_error msg); main () | Halt -> exit 0 in From 7f6b76532053105e24c811546a35230c9fbf8992 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 15 Jun 2020 16:10:13 +0200 Subject: [PATCH 03/36] Add conflict with old-merlin MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- dune-project | 1 + dune.opam | 1 + 2 files changed, 2 insertions(+) diff --git a/dune-project b/dune-project index 700a9b59cbe..b68a01e4ca1 100644 --- a/dune-project +++ b/dune-project @@ -23,6 +23,7 @@ (name dune) ; The "depends" and "build" field are written in dune.opam.template (conflicts + (merlin (< 3.3.7)) (dune-configurator (< 2.3.0)) (odoc (< 1.3.0)) (dune-release (< 1.3.0)) diff --git a/dune.opam b/dune.opam index 6c576c51d01..cbc5791ae41 100644 --- a/dune.opam +++ b/dune.opam @@ -27,6 +27,7 @@ homepage: "https://github.com/ocaml/dune" doc: "https://dune.readthedocs.io/" bug-reports: "https://github.com/ocaml/dune/issues" conflicts: [ + "merlin" {< "3.4.0"} "dune-configurator" {< "2.3.0"} "odoc" {< "1.3.0"} "dune-release" {< "1.3.0"} From 499a05e632a5015427872e53b791d53a52dfaadb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 29 Sep 2020 16:55:48 +0200 Subject: [PATCH 04/36] Separate merlin config for each module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/gen_rules.ml | 16 +---- src/dune_rules/merlin.ml | 118 ++++++++++++++++++-------------- src/dune_rules/merlin.mli | 2 +- src/dune_rules/merlin_server.ml | 51 +++++++------- 4 files changed, 95 insertions(+), 92 deletions(-) diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 86a93e507b2..21d28524503 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -225,21 +225,7 @@ let gen_rules sctx dir_contents cctxs expander For_stanza.of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander ~files_to_install in - let allow_approx_merlin = - let dune_project = Scope.project scope in - let status = - let open Option.O in - let+ src_dir = File_tree.find_dir src_dir in - File_tree.Dir.status src_dir - in - let dir_is_vendored = - match status with - | Some Vendored -> true - | _ -> false - in - dir_is_vendored || Dune_project.allow_approx_merlin dune_project - in - Option.iter (Merlin.merge_all ~allow_approx_merlin merlins) ~f:(fun m -> + Option.iter (Merlin.merge_all merlins) ~f:(fun m -> let more_src_dirs = lib_src_dirs ~dir_contents |> List.rev_append source_dirs in diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 5b72278fe8b..1c4315a8a09 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -98,7 +98,7 @@ module Dot_file = struct (Sexp.List (List.concat [ exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ])) end -type t = +type config = { requires : Lib.Set.t ; flags : string list Build.t ; preprocess : Preprocess.Without_instrumentation.t Preprocess.t @@ -108,6 +108,24 @@ type t = ; extensions : Extensions.Set.t } +type t = config Module_name.Map.t + +let merge_two ~allow_approx_merlin a b = + { requires = Lib.Set.union a.requires b.requires + ; flags = + (let+ a = a.flags + and+ b = b.flags in + a @ b) + ; preprocess = Pp.merge ~allow_approx_merlin a.preprocess b.preprocess + ; libname = + ( match a.libname with + | Some _ as x -> x + | None -> b.libname ) + ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs + ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs + ; extensions = Extensions.Set.union a.extensions b.extensions + } + let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects () = @@ -135,29 +153,39 @@ let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) let intf = Dialect.extension d Ml_kind.Intf in if (* Only include dialects with no preprocessing and skip default file - extensions *) + extensions *) Dialect.preprocess d Ml_kind.Impl <> None || Dialect.preprocess d Ml_kind.Intf <> None || impl = Dialect.extension Dialect.ocaml Ml_kind.Impl - && intf = Dialect.extension Dialect.ocaml Ml_kind.Intf + && intf = Dialect.extension Dialect.ocaml Ml_kind.Intf then s else Extensions.Set.add s (impl, intf)) in - { requires - ; flags = Build.catch flags ~on_error:(fun _ -> []) - ; preprocess - ; libname - ; source_dirs - ; objs_dirs - ; extensions - } + let config = + { requires + ; flags = Build.catch flags ~on_error:(fun _ -> []) + ; preprocess + ; libname + ; source_dirs + ; objs_dirs + ; extensions + } + in + let modules = + List.map ~f:(fun m -> (Module.name m, config)) (Modules.impl_only modules) + in + + (* We use [of_list_reduce] to merge configs *) + Module_name.Map.of_list_reduce modules + ~f:(merge_two ~allow_approx_merlin:false) let merlin_file_name = ".merlin-conf" let add_source_dir t dir = - { t with source_dirs = Path.Source.Set.add t.source_dirs dir } + Module_name.Map.map t ~f:(fun config -> + { config with source_dirs = Path.Source.Set.add config.source_dirs dir }) let quote_if_needed s = if String.need_quoting s then @@ -251,8 +279,7 @@ let lib_src_dirs ~sctx lib = Path.Set.map ~f:Path.drop_optional_build_context (Modules.source_dirs modules) -let dot_merlin sctx ~dir ~more_src_dirs ~expander ({ requires; flags; extensions; _ } as t) - = +let dot_merlin sctx ~dir ~more_src_dirs ~expander t = let open Build.With_targets.O in let merlin_file = Path.Build.relative dir merlin_file_name in @@ -268,48 +295,39 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander ({ requires; flags; extensions >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); Path.Set.singleton (Path.build merlin_file) |> Rules.Produce.Alias.add_deps (Alias.check ~dir); - let pp_flags = pp_flags sctx ~expander t in let action = Build.With_targets.write_file_dyn merlin_file - (let+ flags = Build.with_no_targets flags - and+ pp = pp_flags in - let src_dirs, obj_dirs = - Lib.Set.fold requires - ~init:(Path.set_of_source_paths t.source_dirs, t.objs_dirs) - ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> - let more_src_dirs = lib_src_dirs ~sctx lib in - ( Path.Set.union src_dirs more_src_dirs - , let public_cmi_dir = Obj_dir.public_cmi_dir (Lib.obj_dir lib) in - Path.Set.add obj_dirs public_cmi_dir )) - in - let src_dirs = - Path.Set.union src_dirs - (Path.Set.of_list_map ~f:Path.source more_src_dirs) - in - Dot_file.to_string ~pp ~flags ~src_dirs ~obj_dirs ~extensions) + (Module_name.Map.foldi t ~init:(Build.With_targets.return "") + ~f:(fun module_name ({ requires; flags; extensions; _ } as config) acc -> + let pp_flags = pp_flags sctx ~expander config in + let+ flags = Build.with_no_targets flags + and+ pp = pp_flags + and+ acc = acc in + let src_dirs, obj_dirs = + Lib.Set.fold requires + ~init: + (Path.set_of_source_paths config.source_dirs, config.objs_dirs) + ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> + let more_src_dirs = lib_src_dirs ~sctx lib in + ( Path.Set.union src_dirs more_src_dirs + , let public_cmi_dir = + Obj_dir.public_cmi_dir (Lib.obj_dir lib) + in + Path.Set.add obj_dirs public_cmi_dir )) + in + let src_dirs = + Path.Set.union src_dirs + (Path.Set.of_list_map ~f:Path.source more_src_dirs) + in + Printf.sprintf "%s%s\n%s\n" acc + (Module_name.to_string module_name |> String.lowercase) + (Dot_file.to_string ~pp ~flags ~src_dirs ~obj_dirs ~extensions))) in SC.add_rule sctx ~dir action -let merge_two ~allow_approx_merlin a b = - { requires = Lib.Set.union a.requires b.requires - ; flags = - (let+ a = a.flags - and+ b = b.flags in - a @ b) - ; preprocess = Pp.merge ~allow_approx_merlin a.preprocess b.preprocess - ; libname = - ( match a.libname with - | Some _ as x -> x - | None -> b.libname ) - ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs - ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs - ; extensions = Extensions.Set.union a.extensions b.extensions - } - -let merge_all ~allow_approx_merlin = function +let merge_all = function | [] -> None - | init :: ts -> - Some (List.fold_left ~init ~f:(merge_two ~allow_approx_merlin) ts) + | init :: ts -> Some (List.fold_left ~init ~f:Module_name.Map.superpose ts) let add_rules sctx ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 1036afb556f..cd82457a98f 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -22,7 +22,7 @@ val merlin_file_name : string val add_source_dir : t -> Path.Source.t -> t -val merge_all : allow_approx_merlin:bool -> t list -> t option +val merge_all : t list -> t option (** Add rules for generating the .merlin in a directory *) val add_rules : diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index 424a6f841c0..ada715ae6d8 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -7,10 +7,19 @@ module Merlin_conf = struct let make_error msg = Sexp.(List [ List [ Atom "ERROR"; Atom msg ] ]) - let parse ~origin:_ content : t = - match Csexp.parse_string content with - | Ok (Sexp.List sexps) -> Sexp.List sexps - | _ -> Sexp.List [] + let parse content filename : t = + let parts = String.split content ~on:'\n' in + let rec aux = function + | [] + | [ _ ] -> + make_error "Unexpected merlin-conf content" + | file :: config :: _tl when String.equal file filename -> ( + match Csexp.parse_string config with + | Ok (Sexp.List sexps) -> Sexp.List sexps + | _ -> Sexp.List [] ) + | _file :: _config :: tl -> aux tl + in + aux parts let to_stdout (t : t) = Csexp.to_channel stdout t; @@ -60,38 +69,28 @@ let get_context_root () = let ctx = Context_name.to_string context in Path.Build.(relative root ctx) -let load_merlin_file dir = +let load_merlin_file path file = let ctx_root = get_context_root () in + let filename = Filename.remove_extension file |> String.lowercase in let no_config_error () = Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" in - let rec try_path path = - let dir_path = Path.Build.(append_local ctx_root path) in - let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in - if Path.(exists (build file_path)) then - let build = Build.contents (Path.build file_path) in - let content, _ = Build.exec build in - Merlin_conf.parse ~origin:path content - else if - (* We loop until reaching the context's root or finding a .merlin-conf - file *) - Path.Build.is_descendant ~of_:ctx_root dir_path - then - match Path.Local.parent path with - | Some p -> try_path p - | None -> no_config_error () - else - no_config_error () - in - try_path dir + let dir_path = Path.Build.(append_local ctx_root path) in + let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in + if Path.(exists (build file_path)) then + let build = Build.contents (Path.build file_path) in + let content, _ = Build.exec build in + Merlin_conf.parse content filename + else + no_config_error () let print_merlin_conf file = - let abs_root, _file = Filename.(dirname file, basename file) in + let abs_root, file = Filename.(dirname file, basename file) in let answer = match to_local abs_root with - | Ok p -> load_merlin_file p + | Ok p -> load_merlin_file p file | Error s -> Merlin_conf.make_error s in Merlin_conf.to_stdout answer From 8c654ebc5092f002e66a308c080fabc6e9ff2b7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 23 Sep 2020 18:08:25 +0200 Subject: [PATCH 05/36] Use persistent to store merlin config MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_engine/persistent.ml | 2 + src/dune_engine/persistent.mli | 2 + src/dune_rules/merlin.ml | 497 ++++++++++++++++++-------------- src/dune_rules/merlin.mli | 20 +- src/dune_rules/merlin_server.ml | 24 +- 5 files changed, 298 insertions(+), 247 deletions(-) diff --git a/src/dune_engine/persistent.ml b/src/dune_engine/persistent.ml index 5e435d88849..d81be0d73f7 100644 --- a/src/dune_engine/persistent.ml +++ b/src/dune_engine/persistent.ml @@ -11,6 +11,8 @@ end module Make (D : Desc) = struct let magic = sprintf "DUNE-%sv%d:" D.name D.version + let to_string (v : D.t) = Printf.sprintf "%s%s" magic (Marshal.to_string v []) + let dump file (v : D.t) = Io.with_file_out file ~f:(fun oc -> output_string oc magic; diff --git a/src/dune_engine/persistent.mli b/src/dune_engine/persistent.mli index 8bab2d567a4..b6c72aab1b0 100644 --- a/src/dune_engine/persistent.mli +++ b/src/dune_engine/persistent.mli @@ -28,6 +28,8 @@ end [D.name] stored in the persistent file to locate the appropriate pretty printer. *) module Make (D : Desc) : sig + val to_string : D.t -> string + val dump : Path.t -> D.t -> unit val load : Path.t -> D.t option diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 1c4315a8a09..b66fe2e265b 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -13,6 +13,8 @@ module Extensions = Comparable.Make (struct let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn end) +let merlin_file_name = ".merlin-conf" + let warn_dropped_pp loc ~allow_approx_merlin ~reason = if not allow_approx_merlin then User_warning.emit ~loc @@ -63,8 +65,32 @@ module Pp = struct pp end -module Dot_file = struct - let to_string ~obj_dirs ~src_dirs ~flags ~pp ~extensions = +module Processed = struct + (* The actual content of the merlin file as built by the [Unprocessed.process] + function from the unprocessed info gathered through [gen_rules]. *) + type config = + { obj_dirs : Path.Set.t + ; src_dirs : Path.Set.t + ; flags : string list + ; pp : (string * string) option + ; extensions : Extensions.Set.t + } + + type t = config String.Map.t + + module D = struct + type nonrec t = t + + let name = "merlin-conf" + + let version = 1 + end + + module Persist = Persistent.Make (D) + + let load = Persist.load + + let to_sexp { obj_dirs; src_dirs; flags; pp; extensions } = let serialize_path = Path.to_absolute_filename in let to_atom s = Sexp.Atom s in let make_directive tag value = Sexp.List [ Atom tag; value ] in @@ -91,239 +117,263 @@ module Dot_file = struct | None -> flags in let suffixes = - Extensions.Set.to_list extensions |> List.map ~f:(fun (impl, intf) -> - make_directive "SUFFIX" (Sexp.Atom ((Printf.sprintf "%s %s" impl intf)))) + Extensions.Set.to_list extensions + |> List.map ~f:(fun (impl, intf) -> + make_directive "SUFFIX" + (Sexp.Atom (Printf.sprintf "%s %s" impl intf))) + in + Sexp.List + (List.concat [ exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ]) + + let rec get config ~filename = + let file = Filename.remove_extension filename in + match Option.map (String.Map.find config filename) ~f:to_sexp with + | Some result -> Some result + | None when String.equal file filename -> None + | None -> get config ~filename:file + + let dot_merlin sctx ~dir (t : t Build.With_targets.t) = + let open Build.With_targets.O in + let merlin_file = Path.Build.relative dir merlin_file_name in + + (* We make the compilation of .ml/.mli files depend on the existence of + .merlin so that they are always generated, however the command themselves + don't read the merlin file, so we don't want to declare a dependency on + the contents of the .merlin file. + + Currently dune doesn't support declaring a dependency only on the + existence of a file, so we have to use this trick. *) + SC.add_rule sctx ~dir + ( Build.with_no_targets (Build.path (Path.build merlin_file)) + >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); + Path.Set.singleton (Path.build merlin_file) + |> Rules.Produce.Alias.add_deps (Alias.check ~dir); + let action = + Build.With_targets.write_file_dyn merlin_file + (Build.With_targets.map ~f:Persist.to_string t) in - Csexp.to_string - (Sexp.List (List.concat [ exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ])) + SC.add_rule sctx ~dir action end -type config = - { requires : Lib.Set.t - ; flags : string list Build.t - ; preprocess : Preprocess.Without_instrumentation.t Preprocess.t - ; libname : Lib_name.Local.t option - ; source_dirs : Path.Source.Set.t - ; objs_dirs : Path.Set.t - ; extensions : Extensions.Set.t - } - -type t = config Module_name.Map.t - -let merge_two ~allow_approx_merlin a b = - { requires = Lib.Set.union a.requires b.requires - ; flags = - (let+ a = a.flags - and+ b = b.flags in - a @ b) - ; preprocess = Pp.merge ~allow_approx_merlin a.preprocess b.preprocess - ; libname = - ( match a.libname with - | Some _ as x -> x - | None -> b.libname ) - ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs - ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs - ; extensions = Extensions.Set.union a.extensions b.extensions - } - -let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) - ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects - () = - (* Merlin shouldn't cause the build to fail, so we just ignore errors *) - let requires = - match requires with - | Ok l -> Lib.Set.of_list l - | Error _ -> Lib.Set.empty - in - let objs_dirs = - Obj_dir.byte_dir obj_dir |> Path.build |> Path.Set.singleton - in - let flags = - match Modules.alias_module modules with - | None -> Ocaml_flags.common flags - | Some m -> - Ocaml_flags.prepend_common - [ "-open"; Module_name.to_string (Module.name m) ] - flags - |> Ocaml_flags.common - in - let extensions = - Dialect.DB.fold dialects ~init:Extensions.Set.empty ~f:(fun d s -> - let impl = Dialect.extension d Ml_kind.Impl in - let intf = Dialect.extension d Ml_kind.Intf in - if - (* Only include dialects with no preprocessing and skip default file - extensions *) - Dialect.preprocess d Ml_kind.Impl <> None - || Dialect.preprocess d Ml_kind.Intf <> None - || impl = Dialect.extension Dialect.ocaml Ml_kind.Impl - && intf = Dialect.extension Dialect.ocaml Ml_kind.Intf - then - s - else - Extensions.Set.add s (impl, intf)) - in - let config = - { requires - ; flags = Build.catch flags ~on_error:(fun _ -> []) - ; preprocess - ; libname - ; source_dirs - ; objs_dirs - ; extensions +module Unprocessed = struct + (* We store separate information for each "module". These informations do not + reflect the actual content of the Merlin configuration yet but are needed + for it's elaboration via the function [process : Unprocessed.t ... -> + Processed.t] *) + type config = + { requires : Lib.Set.t + ; flags : string list Build.t + ; preprocess : Preprocess.Without_instrumentation.t Preprocess.t + ; libname : Lib_name.Local.t option + ; source_dirs : Path.Source.Set.t + ; objs_dirs : Path.Set.t + ; extensions : Extensions.Set.t } - in - let modules = - List.map ~f:(fun m -> (Module.name m, config)) (Modules.impl_only modules) - in - (* We use [of_list_reduce] to merge configs *) - Module_name.Map.of_list_reduce modules - ~f:(merge_two ~allow_approx_merlin:false) + type t = config Module_name.Map.t -let merlin_file_name = ".merlin-conf" + let add_source_dir t dir = + Module_name.Map.map t ~f:(fun cu_config -> + { cu_config with + source_dirs = Path.Source.Set.add cu_config.source_dirs dir + }) + + let merge_config a b = + { requires = Lib.Set.union a.requires b.requires + ; flags = + (let+ a = a.flags + and+ b = b.flags in + a @ b) + ; preprocess = Pp.merge ~allow_approx_merlin:false a.preprocess b.preprocess + ; libname = + ( match a.libname with + | Some _ as x -> x + | None -> b.libname ) + ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs + ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs + ; extensions = Extensions.Set.union a.extensions b.extensions + } -let add_source_dir t dir = - Module_name.Map.map t ~f:(fun config -> - { config with source_dirs = Path.Source.Set.add config.source_dirs dir }) - -let quote_if_needed s = - if String.need_quoting s then - Filename.quote s - else - s - -let pp_flag_of_action ~expander ~loc ~action : - (string * string) option Build.With_targets.t = - match (action : Action_dune_lang.t) with - | Run (exe, args) -> ( - let args = - let open Option.O in - let* args, input_file = List.destruct_last args in - if String_with_vars.is_var input_file ~name:"input-file" then - Some args - else - None + let make ?(requires = Ok []) ~flags + ?(preprocess = Preprocess.No_preprocessing) ?libname + ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects () = + (* Merlin shouldn't cause the build to fail, so we just ignore errors *) + let requires = + match requires with + | Ok l -> Lib.Set.of_list l + | Error _ -> Lib.Set.empty in - match args with - | None -> Build.With_targets.return None - | Some args -> - let action = - let targets_dir = Expander.dir expander in - let targets : Targets.Or_forbidden.t = - Forbidden "preprocessing actions" - in - let action = Preprocessing.chdir (Run (exe, args)) in - Action_unexpanded.expand ~loc ~expander ~dep_kind:Optional ~targets - ~targets_dir action - (Build.return Bindings.empty) + let objs_dirs = + Obj_dir.byte_dir obj_dir |> Path.build |> Path.Set.singleton + in + let flags = + match Modules.alias_module modules with + | None -> Ocaml_flags.common flags + | Some m -> + Ocaml_flags.prepend_common + [ "-open"; Module_name.to_string (Module.name m) ] + flags + |> Ocaml_flags.common + in + let extensions = + Dialect.DB.fold dialects ~init:Extensions.Set.empty ~f:(fun d s -> + let impl = Dialect.extension d Ml_kind.Impl in + let intf = Dialect.extension d Ml_kind.Intf in + if + (* Only include dialects with no preprocessing and skip default file + extensions *) + Dialect.preprocess d Ml_kind.Impl <> None + || Dialect.preprocess d Ml_kind.Intf <> None + || impl = Dialect.extension Dialect.ocaml Ml_kind.Impl + && intf = Dialect.extension Dialect.ocaml Ml_kind.Intf + then + s + else + Extensions.Set.add s (impl, intf)) + in + let cu_config = + { requires + ; flags = Build.catch flags ~on_error:(fun _ -> []) + ; preprocess + ; libname + ; source_dirs + ; objs_dirs + ; extensions + } + in + + let modules = + List.map + ~f:(fun m -> (Module.name m, cu_config)) + (Modules.impl_only modules) + in + + (* We use [of_list_reduce] to merge configs *) + Module_name.Map.of_list_reduce modules ~f:merge_config + + let quote_if_needed s = + if String.need_quoting s then + Filename.quote s + else + s + + let pp_flag_of_action ~expander ~loc ~action : + (string * string) option Build.With_targets.t = + match (action : Action_dune_lang.t) with + | Run (exe, args) -> ( + let args = + let open Option.O in + let* args, input_file = List.destruct_last args in + if String_with_vars.is_var input_file ~name:"input-file" then + Some args + else + None in - let pp_of_action exe args = - match exe with - | Error _ -> None - | Ok exe -> - let args = - Path.to_absolute_filename exe :: args - |> List.map ~f:quote_if_needed - |> String.concat ~sep:" " + match args with + | None -> Build.With_targets.return None + | Some args -> + let action = + let targets_dir = Expander.dir expander in + let targets : Targets.Or_forbidden.t = + Forbidden "preprocessing actions" in - Some ("-pp", args) - in - Build.With_targets.map action ~f:(function - | Run (exe, args) -> pp_of_action exe args - | Chdir (_, Run (exe, args)) -> pp_of_action exe args - | Chdir (_, Chdir (_, Run (exe, args))) -> pp_of_action exe args - | _ -> None) ) - | _ -> Build.With_targets.return None - -let pp_flags sctx ~expander { preprocess; libname; _ } : - (string * string) option Build.With_targets.t = - let scope = Expander.scope expander in - match - Preprocess.remove_future_syntax preprocess ~for_:Merlin - (Super_context.context sctx).version - with - | Pps { loc; pps; flags; staged = _ } -> ( + let action = Preprocessing.chdir (Run (exe, args)) in + Action_unexpanded.expand ~loc ~expander ~dep_kind:Optional ~targets + ~targets_dir action + (Build.return Bindings.empty) + in + let pp_of_action exe args = + match exe with + | Error _ -> None + | Ok exe -> + let args = + Path.to_absolute_filename exe :: args + |> List.map ~f:quote_if_needed + |> String.concat ~sep:" " + in + Some ("-pp", args) + in + Build.With_targets.map action ~f:(function + | Run (exe, args) -> pp_of_action exe args + | Chdir (_, Run (exe, args)) -> pp_of_action exe args + | Chdir (_, Chdir (_, Run (exe, args))) -> pp_of_action exe args + | _ -> None) ) + | _ -> Build.With_targets.return None + + let pp_flags sctx ~expander { preprocess; libname; _ } : + (string * string) option Build.With_targets.t = + let scope = Expander.scope expander in match - Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname ~flags - ~scope pps + Preprocess.remove_future_syntax preprocess ~for_:Merlin + (Super_context.context sctx).version with - | Error _exn -> Build.With_targets.return None - | Ok (exe, flags) -> - let args = - Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags - |> List.map ~f:quote_if_needed - |> String.concat ~sep:" " + | Pps { loc; pps; flags; staged = _ } -> ( + match + Preprocessing.get_ppx_driver sctx ~loc ~expander ~lib_name:libname + ~flags ~scope pps + with + | Error _exn -> Build.With_targets.return None + | Ok (exe, flags) -> + let args = + Path.to_absolute_filename (Path.build exe) :: "--as-ppx" :: flags + |> List.map ~f:quote_if_needed + |> String.concat ~sep:" " + in + Build.With_targets.return (Some ("-ppx", args)) ) + | Action (loc, (action : Action_dune_lang.t)) -> + pp_flag_of_action ~expander ~loc ~action + | No_preprocessing -> Build.With_targets.return None + + (* This is used to determine the list of source directories to give to Merlin. + This is similar to [Gen_rules.lib_src_dirs], but it's used for dependencies + instead of the library itself. It would be nice to unify these some day. *) + let lib_src_dirs ~sctx lib = + match Lib.Local.of_lib lib with + | None -> + let info = Lib.info lib in + Path.Set.singleton (Lib_info.best_src_dir info) + | Some info -> + let info = Lib.Local.info info in + let dir = Lib_info.src_dir info in + let name = Lib_info.name info in + let modules = + Dir_contents.get sctx ~dir |> Dir_contents.ocaml + |> Ml_sources.modules_of_library ~name in - Build.With_targets.return (Some ("-ppx", args)) ) - | Action (loc, (action : Action_dune_lang.t)) -> - pp_flag_of_action ~expander ~loc ~action - | No_preprocessing -> Build.With_targets.return None - -(* This is used to determine the list of source directories to give to Merlin. - This is similar to [Gen_rules.lib_src_dirs], but it's used for dependencies - instead of the library itself. It would be nice to unify these some day. *) -let lib_src_dirs ~sctx lib = - match Lib.Local.of_lib lib with - | None -> - let info = Lib.info lib in - Path.Set.singleton (Lib_info.best_src_dir info) - | Some info -> - let info = Lib.Local.info info in - let dir = Lib_info.src_dir info in - let name = Lib_info.name info in - let modules = - Dir_contents.get sctx ~dir |> Dir_contents.ocaml - |> Ml_sources.modules_of_library ~name - in - Path.Set.map ~f:Path.drop_optional_build_context - (Modules.source_dirs modules) - -let dot_merlin sctx ~dir ~more_src_dirs ~expander t = - let open Build.With_targets.O in - let merlin_file = Path.Build.relative dir merlin_file_name in - - (* We make the compilation of .ml/.mli files depend on the existence of - .merlin so that they are always generated, however the command themselves - don't read the merlin file, so we don't want to declare a dependency on the - contents of the .merlin file. - - Currently dune doesn't support declaring a dependency only on the existence - of a file, so we have to use this trick. *) - SC.add_rule sctx ~dir - ( Build.with_no_targets (Build.path (Path.build merlin_file)) - >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); - Path.Set.singleton (Path.build merlin_file) - |> Rules.Produce.Alias.add_deps (Alias.check ~dir); - let action = - Build.With_targets.write_file_dyn merlin_file - (Module_name.Map.foldi t ~init:(Build.With_targets.return "") - ~f:(fun module_name ({ requires; flags; extensions; _ } as config) acc -> - let pp_flags = pp_flags sctx ~expander config in - let+ flags = Build.with_no_targets flags - and+ pp = pp_flags - and+ acc = acc in - let src_dirs, obj_dirs = - Lib.Set.fold requires - ~init: - (Path.set_of_source_paths config.source_dirs, config.objs_dirs) - ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> - let more_src_dirs = lib_src_dirs ~sctx lib in - ( Path.Set.union src_dirs more_src_dirs - , let public_cmi_dir = - Obj_dir.public_cmi_dir (Lib.obj_dir lib) - in - Path.Set.add obj_dirs public_cmi_dir )) - in - let src_dirs = - Path.Set.union src_dirs - (Path.Set.of_list_map ~f:Path.source more_src_dirs) - in - Printf.sprintf "%s%s\n%s\n" acc - (Module_name.to_string module_name |> String.lowercase) - (Dot_file.to_string ~pp ~flags ~src_dirs ~obj_dirs ~extensions))) - in - SC.add_rule sctx ~dir action + Path.Set.map ~f:Path.drop_optional_build_context + (Modules.source_dirs modules) + + let process sctx ~more_src_dirs ~expander t = + Module_name.Map.foldi t + ~init:(Build.with_no_targets (Build.return String.Map.empty)) + ~f: + (fun module_name ({ requires; flags; extensions; _ } as cu_config) acc -> + let open Build.With_targets.O in + let pp_flags = pp_flags sctx ~expander cu_config in + let+ flags = Build.with_no_targets flags + and+ pp = pp_flags + and+ acc = acc in + let src_dirs, obj_dirs = + Lib.Set.fold requires + ~init: + ( Path.set_of_source_paths cu_config.source_dirs + , cu_config.objs_dirs ) + ~f:(fun (lib : Lib.t) (src_dirs, obj_dirs) -> + let more_src_dirs = lib_src_dirs ~sctx lib in + ( Path.Set.union src_dirs more_src_dirs + , let public_cmi_dir = Obj_dir.public_cmi_dir (Lib.obj_dir lib) in + Path.Set.add obj_dirs public_cmi_dir )) + in + let src_dirs = + Path.Set.union src_dirs + (Path.Set.of_list_map ~f:Path.source more_src_dirs) + in + String.Map.add_exn acc + (Module_name.to_string module_name |> String.lowercase) + Processed.{ src_dirs; obj_dirs; flags; pp; extensions }) +end + +include Unprocessed let merge_all = function | [] -> None @@ -331,4 +381,5 @@ let merge_all = function let add_rules sctx ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then - dot_merlin sctx ~dir ~more_src_dirs ~expander merlin + Unprocessed.process sctx ~more_src_dirs ~expander merlin + |> Processed.dot_merlin sctx ~dir diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index cd82457a98f..e2b5d090f80 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -4,8 +4,22 @@ open! Dune_engine open! Stdune open Import +val merlin_file_name : string + type t +val add_source_dir : t -> Path.Source.t -> t + +val merge_all : t list -> t option + +module Processed : sig + type t + + val load : Path.t -> t option + + val get : t -> filename:string -> Sexp.t option +end + val make : ?requires:Lib.t list Or_exn.t -> flags:Ocaml_flags.t @@ -18,12 +32,6 @@ val make : -> unit -> t -val merlin_file_name : string - -val add_source_dir : t -> Path.Source.t -> t - -val merge_all : t list -> t option - (** Add rules for generating the .merlin in a directory *) val add_rules : Super_context.t diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index ada715ae6d8..1558f9ba3e8 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -7,20 +7,6 @@ module Merlin_conf = struct let make_error msg = Sexp.(List [ List [ Atom "ERROR"; Atom msg ] ]) - let parse content filename : t = - let parts = String.split content ~on:'\n' in - let rec aux = function - | [] - | [ _ ] -> - make_error "Unexpected merlin-conf content" - | file :: config :: _tl when String.equal file filename -> ( - match Csexp.parse_string config with - | Ok (Sexp.List sexps) -> Sexp.List sexps - | _ -> Sexp.List [] ) - | _file :: _config :: tl -> aux tl - in - aux parts - let to_stdout (t : t) = Csexp.to_channel stdout t; flush stdout @@ -71,7 +57,7 @@ let get_context_root () = let load_merlin_file path file = let ctx_root = get_context_root () in - let filename = Filename.remove_extension file |> String.lowercase in + let filename = String.lowercase_ascii file in let no_config_error () = Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" @@ -80,9 +66,11 @@ let load_merlin_file path file = let dir_path = Path.Build.(append_local ctx_root path) in let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in if Path.(exists (build file_path)) then - let build = Build.contents (Path.build file_path) in - let content, _ = Build.exec build in - Merlin_conf.parse content filename + match Merlin.Processed.load (Path.build file_path) with + | Some config -> + Option.value ~default:(no_config_error ()) + (Merlin.Processed.get config ~filename) + | None -> no_config_error () else no_config_error () From 61a3da0b81219af5ba108e5aebf1a3c345b6f987 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 24 Sep 2020 17:24:18 +0200 Subject: [PATCH 06/36] Add dump option to ocaml-merlin for debug and tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- bin/ocaml_merlin.ml | 18 ++++++++++++++++-- src/dune_rules/merlin.ml | 12 +++++++++++- src/dune_rules/merlin.mli | 3 ++- src/dune_rules/merlin_server.ml | 24 ++++++++++++++---------- src/dune_rules/merlin_server.mli | 2 ++ 5 files changed, 45 insertions(+), 14 deletions(-) diff --git a/bin/ocaml_merlin.ml b/bin/ocaml_merlin.ml index 24eb65a82eb..852e1d8a6fe 100644 --- a/bin/ocaml_merlin.ml +++ b/bin/ocaml_merlin.ml @@ -16,12 +16,26 @@ let man = let info = Term.info "ocaml-merlin" ~doc ~man let term = - let+ common = Common.term in + let+ common = Common.term + and+ dump_config = + Arg.( + value + & opt (some string) None + & info [ "dump-config" ] + ~doc: + "Prints the entire content of the merlin configuration for the \ + given folder in a user friendly form. This is for testing and \ + debugging purposes only and should not be considered as a stable \ + ouptut.") + in Common.set_common common ~targets:[]; Scheduler.go ~common (fun () -> Dune_engine.File_tree.init ~recognize_jbuilder_projects:true ~ancestor_vcs:None; Dune_rules.Workspace.init (); - Dune_rules.Merlin_server.start () |> Fiber.return) + ( match dump_config with + | Some s -> Dune_rules.Merlin_server.dump s + | None -> Dune_rules.Merlin_server.start () ) + |> Fiber.return) let command = (term, info) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index b66fe2e265b..fe2256353b3 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -88,7 +88,7 @@ module Processed = struct module Persist = Persistent.Make (D) - let load = Persist.load + let load_file = Persist.load let to_sexp { obj_dirs; src_dirs; flags; pp; extensions } = let serialize_path = Path.to_absolute_filename in @@ -132,6 +132,16 @@ module Processed = struct | None when String.equal file filename -> None | None -> get config ~filename:file + let print_file path = + match load_file path with + | None -> Printf.eprintf "No merlin config found" + | Some t -> + String.Map.iteri + ~f:(fun name config -> + let sexp = to_sexp config in + Format.printf "@[%s@,%a@]@." name Sexp.pp sexp) + t + let dot_merlin sctx ~dir (t : t Build.With_targets.t) = let open Build.With_targets.O in let merlin_file = Path.Build.relative dir merlin_file_name in diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index e2b5d090f80..8d657fb850f 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -15,7 +15,8 @@ val merge_all : t list -> t option module Processed : sig type t - val load : Path.t -> t option + val load_file : Path.t -> t option + val print_file : Path.t -> unit val get : t -> filename:string -> Sexp.t option end diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index 1558f9ba3e8..a4ef7ffdc84 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -47,26 +47,25 @@ let to_local abs_file_path = | None -> Printf.sprintf "Path is not in dune workspace %s" abs_file_path |> error -let get_context_root () = +let get_merlin_file_path local_path = let workspace = Workspace.workspace () in let context = Option.value ~default:Context_name.default workspace.merlin_context in let ctx = Context_name.to_string context in - Path.Build.(relative root ctx) - -let load_merlin_file path file = - let ctx_root = get_context_root () in - let filename = String.lowercase_ascii file in + let ctx_root = Path.Build.(relative root ctx) in + let dir_path = Path.Build.(append_local ctx_root local_path) in + Path.Build.relative dir_path Merlin.merlin_file_name |> Path.build +let load_merlin_file local_path file = let no_config_error () = Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" in - let dir_path = Path.Build.(append_local ctx_root path) in - let file_path = Path.Build.relative dir_path Merlin.merlin_file_name in - if Path.(exists (build file_path)) then - match Merlin.Processed.load (Path.build file_path) with + let filename = String.lowercase_ascii file in + let file_path = get_merlin_file_path local_path in + if Path.exists file_path then + match Merlin.Processed.load_file file_path with | Some config -> Option.value ~default:(no_config_error ()) (Merlin.Processed.get config ~filename) @@ -83,6 +82,11 @@ let print_merlin_conf file = in Merlin_conf.to_stdout answer +let dump s = + match to_local s with + | Ok path -> Merlin.Processed.print_file (get_merlin_file_path path) + | Error mess -> Printf.eprintf "%s\n%!" mess + let start () = let rec main () = match Commands.read_input stdin with diff --git a/src/dune_rules/merlin_server.mli b/src/dune_rules/merlin_server.mli index 901e5c18c29..408706b5b26 100644 --- a/src/dune_rules/merlin_server.mli +++ b/src/dune_rules/merlin_server.mli @@ -1,6 +1,8 @@ (** Merlin config server *) open! Dune_engine +val dump : string -> unit + (** Once started the server will wait for commands on stdin, read the requested merlin dot file and return its content on stdout. The server will halt when reiceving EOF of a bad csexp. *) From 999e61bb011a37ab30159676e471f65b52c71a5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 29 Sep 2020 16:34:45 +0200 Subject: [PATCH 07/36] Refactor MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 55 +++++++++++++++++++-------------------- src/dune_rules/merlin.mli | 1 + 2 files changed, 28 insertions(+), 28 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index fe2256353b3..996a59c9f20 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -141,28 +141,6 @@ module Processed = struct let sexp = to_sexp config in Format.printf "@[%s@,%a@]@." name Sexp.pp sexp) t - - let dot_merlin sctx ~dir (t : t Build.With_targets.t) = - let open Build.With_targets.O in - let merlin_file = Path.Build.relative dir merlin_file_name in - - (* We make the compilation of .ml/.mli files depend on the existence of - .merlin so that they are always generated, however the command themselves - don't read the merlin file, so we don't want to declare a dependency on - the contents of the .merlin file. - - Currently dune doesn't support declaring a dependency only on the - existence of a file, so we have to use this trick. *) - SC.add_rule sctx ~dir - ( Build.with_no_targets (Build.path (Path.build merlin_file)) - >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); - Path.Set.singleton (Path.build merlin_file) - |> Rules.Produce.Alias.add_deps (Alias.check ~dir); - let action = - Build.With_targets.write_file_dyn merlin_file - (Build.With_targets.map ~f:Persist.to_string t) - in - SC.add_rule sctx ~dir action end module Unprocessed = struct @@ -354,10 +332,8 @@ module Unprocessed = struct (Modules.source_dirs modules) let process sctx ~more_src_dirs ~expander t = - Module_name.Map.foldi t - ~init:(Build.with_no_targets (Build.return String.Map.empty)) - ~f: - (fun module_name ({ requires; flags; extensions; _ } as cu_config) acc -> + Module_name.Map.foldi t ~init:(Build.With_targets.return String.Map.empty) + ~f:(fun module_name ({ requires; flags; extensions; _ } as cu_config) acc -> let open Build.With_targets.O in let pp_flags = pp_flags sctx ~expander cu_config in let+ flags = Build.with_no_targets flags @@ -385,11 +361,34 @@ end include Unprocessed +let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = + let open Build.With_targets.O in + let merlin_file = Path.Build.relative dir merlin_file_name in + + (* We make the compilation of .ml/.mli files depend on the existence of + .merlin so that they are always generated, however the command themselves + don't read the merlin file, so we don't want to declare a dependency on the + contents of the .merlin file. + + Currently dune doesn't support declaring a dependency only on the existence + of a file, so we have to use this trick. *) + SC.add_rule sctx ~dir + ( Build.with_no_targets (Build.path (Path.build merlin_file)) + >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); + Path.Set.singleton (Path.build merlin_file) + |> Rules.Produce.Alias.add_deps (Alias.check ~dir); + + let merlin = Unprocessed.process sctx ~more_src_dirs ~expander t in + let action = + Build.With_targets.write_file_dyn merlin_file + (Build.With_targets.map ~f:Processed.Persist.to_string merlin) + in + SC.add_rule sctx ~dir action + let merge_all = function | [] -> None | init :: ts -> Some (List.fold_left ~init ~f:Module_name.Map.superpose ts) let add_rules sctx ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then - Unprocessed.process sctx ~more_src_dirs ~expander merlin - |> Processed.dot_merlin sctx ~dir + dot_merlin sctx ~more_src_dirs ~expander ~dir merlin diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 8d657fb850f..11c81fc4df9 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -16,6 +16,7 @@ module Processed : sig type t val load_file : Path.t -> t option + val print_file : Path.t -> unit val get : t -> filename:string -> Sexp.t option From 0221668bcff3812f077ec7b7b9caf549fe625207 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 2 Oct 2020 11:56:02 +0200 Subject: [PATCH 08/36] Generate 1 merlin file per Stanza, remove useless merging MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/buildable_rules.ml | 4 +- src/dune_rules/buildable_rules.mli | 7 ++- src/dune_rules/exe_rules.ml | 6 +- src/dune_rules/gen_rules.ml | 17 +++--- src/dune_rules/lib_rules.ml | 3 +- src/dune_rules/merlin.ml | 98 +++++++----------------------- src/dune_rules/merlin.mli | 12 +++- 7 files changed, 57 insertions(+), 90 deletions(-) diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index a9f0f45b60c..4238d9e3a02 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -15,13 +15,13 @@ let gen_select_rules t ~dir compile_info = Build.fail { fail = (fun () -> raise e) } |> Build.with_targets ~targets:[ dst ] )) -let with_lib_deps (t : Context.t) compile_info ~dir ~f = +let with_lib_deps ~merlin_ident (t : Context.t) compile_info ~dir ~f = let prefix = Build.label (Lib_deps_info.Label (Lib.Compile.lib_deps_info compile_info)) in let prefix = if t.merlin then - Path.Build.relative dir ".merlin-exists" + Path.Build.relative dir (Merlin.make_merlin_exists ~ident:merlin_ident) |> Path.build |> Build.path >>> prefix else prefix diff --git a/src/dune_rules/buildable_rules.mli b/src/dune_rules/buildable_rules.mli index e90d2374499..9b5122f6538 100644 --- a/src/dune_rules/buildable_rules.mli +++ b/src/dune_rules/buildable_rules.mli @@ -16,4 +16,9 @@ val gen_select_rules : (** Generate the rules for the [(select ...)] forms in library dependencies *) val with_lib_deps : - Context.t -> Lib.Compile.t -> dir:Path.Build.t -> f:(unit -> 'a) -> 'a + merlin_ident:string + -> Context.t + -> Lib.Compile.t + -> dir:Path.Build.t + -> f:(unit -> 'a) + -> 'a diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 2eee209f335..99a79772281 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -207,6 +207,10 @@ let rules ~sctx ~dir ~dir_contents ~scope ~expander in Buildable_rules.gen_select_rules sctx compile_info ~dir; Bootstrap_info.gen_rules sctx exes ~dir compile_info; - Buildable_rules.with_lib_deps + let merlin_ident = + Printf.sprintf "exe-%s" + (String.concat ~sep:"-" (List.map ~f:snd exes.names)) + in + Buildable_rules.with_lib_deps ~merlin_ident (Super_context.context sctx) compile_info ~dir ~f diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 21d28524503..29154325857 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -24,7 +24,7 @@ module For_stanza : sig -> dir_contents:Dir_contents.t -> expander:Expander.t -> files_to_install:(Install_conf.t -> unit) - -> ( Merlin.t list + -> ( (string * Merlin.t) list , (Loc.t * Compilation_context.t) list , Path.Build.t list , Path.Source.t list ) @@ -76,7 +76,8 @@ end = struct let cctx, merlin = Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander in - { merlin = Some merlin + let merlin_ident = Merlin.make_lib_ident lib in + { merlin = Some (merlin_ident, merlin) ; cctx = Some (lib.buildable.loc, cctx) ; js = None ; source_dirs = None @@ -89,7 +90,8 @@ end = struct let cctx, merlin = Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents in - { merlin = Some merlin + let merlin_ident = Merlin.make_exe_ident exes in + { merlin = Some (merlin_ident, merlin) ; cctx = Some (exes.buildable.loc, cctx) ; js = Some @@ -106,7 +108,8 @@ end = struct let cctx, merlin = Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents in - { merlin = Some merlin + let merlin_ident = Merlin.make_exe_ident tests.exes in + { merlin = Some (merlin_ident, merlin) ; cctx = Some (tests.exes.buildable.loc, cctx) ; js = None ; source_dirs = None @@ -225,12 +228,12 @@ let gen_rules sctx dir_contents cctxs expander For_stanza.of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander ~files_to_install in - Option.iter (Merlin.merge_all merlins) ~f:(fun m -> + List.iter merlins ~f:(fun (ident, merlin) -> let more_src_dirs = lib_src_dirs ~dir_contents |> List.rev_append source_dirs in - Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander - (Merlin.add_source_dir m src_dir)); + Merlin.add_rules sctx ~ident ~dir:ctx_dir ~more_src_dirs ~expander + (Merlin.add_source_dir merlin 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/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 7e0e6201306..dc5eff81379 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -442,6 +442,7 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : library_rules lib ~cctx ~source_modules ~dir_contents ~compile_info in Buildable_rules.gen_select_rules sctx compile_info ~dir; - Buildable_rules.with_lib_deps + let merlin_ident = Merlin.make_lib_ident lib in + Buildable_rules.with_lib_deps ~merlin_ident (Super_context.context sctx) compile_info ~dir ~f diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 996a59c9f20..38e6915ff02 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -1,7 +1,6 @@ open! Dune_engine open! Stdune open Import -open Build.O open! No_io module SC = Super_context @@ -13,57 +12,19 @@ module Extensions = Comparable.Make (struct let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn end) -let merlin_file_name = ".merlin-conf" - -let warn_dropped_pp loc ~allow_approx_merlin ~reason = - if not allow_approx_merlin then - User_warning.emit ~loc - [ Pp.textf ".merlin generated is inaccurate. %s." reason - ; Pp.text - "Split the stanzas into different directories or silence this \ - warning by adding (allow_approximate_merlin) to your dune-project." - ] - -module Pp = struct - let merge ~allow_approx_merlin (a : _ Preprocess.t) (b : _ Preprocess.t) = - match (a, b) with - | No_preprocessing, No_preprocessing -> Preprocess.No_preprocessing - | No_preprocessing, pp - | pp, No_preprocessing -> - let loc = - Preprocess.loc pp |> Option.value_exn - (* only No_preprocessing has no loc*) - in - warn_dropped_pp loc ~allow_approx_merlin - ~reason:"Cannot mix preprocessed and non preprocessed specifications"; - Preprocess.No_preprocessing - | (Future_syntax _ as future_syntax), _ - | _, (Future_syntax _ as future_syntax) -> - future_syntax - | 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 preprocessor \ - 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 pp1 as pp), Pps pp2 -> - if - Ordering.neq - (Preprocess.Pps.compare_no_locs - Preprocess.Without_instrumentation.compare_no_locs pp1 pp2) - then ( - warn_dropped_pp pp1.loc ~allow_approx_merlin - ~reason:"pps specification isn't identical in all stanzas"; - No_preprocessing - ) else - pp -end +let merlin_file_name = ".merlin-conf/" + +let merlin_exist_name = ".merlin-exist" + +let make_lib_ident lib = + Printf.sprintf "-lib-%s" + (Dune_file.Library.best_name lib |> Lib_name.to_string) + +let make_exe_ident exes = + Printf.sprintf "-exe-%s" + (String.concat ~sep:"-" (List.map ~f:snd exes.Dune_file.Executables.names)) + +let make_merlin_exists ~ident = merlin_exist_name ^ ident module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] @@ -166,21 +127,7 @@ module Unprocessed = struct source_dirs = Path.Source.Set.add cu_config.source_dirs dir }) - let merge_config a b = - { requires = Lib.Set.union a.requires b.requires - ; flags = - (let+ a = a.flags - and+ b = b.flags in - a @ b) - ; preprocess = Pp.merge ~allow_approx_merlin:false a.preprocess b.preprocess - ; libname = - ( match a.libname with - | Some _ as x -> x - | None -> b.libname ) - ; source_dirs = Path.Source.Set.union a.source_dirs b.source_dirs - ; objs_dirs = Path.Set.union a.objs_dirs b.objs_dirs - ; extensions = Extensions.Set.union a.extensions b.extensions - } + let merge_config _a b = b let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ?libname @@ -333,7 +280,8 @@ module Unprocessed = struct let process sctx ~more_src_dirs ~expander t = Module_name.Map.foldi t ~init:(Build.With_targets.return String.Map.empty) - ~f:(fun module_name ({ requires; flags; extensions; _ } as cu_config) acc -> + ~f:(fun module_name ({ requires; flags; extensions; _ } as cu_config) acc + -> let open Build.With_targets.O in let pp_flags = pp_flags sctx ~expander cu_config in let+ flags = Build.with_no_targets flags @@ -361,8 +309,10 @@ end include Unprocessed -let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = +let dot_merlin sctx ~ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in + let merlin_file_name = merlin_file_name ^ ident in + let merlin_exist_name = make_merlin_exists ~ident in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of @@ -374,7 +324,7 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = of a file, so we have to use this trick. *) SC.add_rule sctx ~dir ( Build.with_no_targets (Build.path (Path.build merlin_file)) - >>> Build.create_file (Path.Build.relative dir ".merlin-exists") ); + >>> Build.create_file (Path.Build.relative dir merlin_exist_name) ); Path.Set.singleton (Path.build merlin_file) |> Rules.Produce.Alias.add_deps (Alias.check ~dir); @@ -385,10 +335,6 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = in SC.add_rule sctx ~dir action -let merge_all = function - | [] -> None - | init :: ts -> Some (List.fold_left ~init ~f:Module_name.Map.superpose ts) - -let add_rules sctx ~dir ~more_src_dirs ~expander merlin = +let add_rules sctx ~ident ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then - dot_merlin sctx ~more_src_dirs ~expander ~dir merlin + dot_merlin sctx ~ident ~more_src_dirs ~expander ~dir merlin diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 11c81fc4df9..b63da12e900 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -4,14 +4,21 @@ open! Dune_engine open! Stdune open Import +(* Merlin file names and tools to manipulate them *) val merlin_file_name : string +val merlin_exist_name : string + +val make_lib_ident : Dune_file.Library.t -> string + +val make_exe_ident : Dune_file.Executables.t -> string + +val make_merlin_exists : ident:string -> string + type t val add_source_dir : t -> Path.Source.t -> t -val merge_all : t list -> t option - module Processed : sig type t @@ -37,6 +44,7 @@ val make : (** Add rules for generating the .merlin in a directory *) val add_rules : Super_context.t + -> ident:string -> dir:Path.Build.t -> more_src_dirs:Path.Source.t list -> expander:Expander.t From 49ea07006b36dbc012b6f638b2c80f8cca675a31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 5 Oct 2020 15:06:50 +0200 Subject: [PATCH 09/36] Add `Result.value` to stdune MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/stdune/result.ml | 5 +++++ src/stdune/result.mli | 3 +++ 2 files changed, 8 insertions(+) diff --git a/src/stdune/result.ml b/src/stdune/result.ml index 96184350882..edc1daf18db 100644 --- a/src/stdune/result.ml +++ b/src/stdune/result.ml @@ -6,6 +6,11 @@ let ok x = Ok x let return = ok +let value r ~default = + match r with + | Ok v -> v + | Error _ -> default + let is_ok = function | Ok _ -> true | Error _ -> false diff --git a/src/stdune/result.mli b/src/stdune/result.mli index 2ec222a6608..f6c1ee6a40c 100644 --- a/src/stdune/result.mli +++ b/src/stdune/result.mli @@ -8,6 +8,9 @@ val return : 'a -> ('a, _) t val ok : 'a -> ('a, _) t +(** [value r ~default] is [v] if [r] is [Ok v] and [default] otherwise. *) +val value : ('a, 'e) result -> default:'a -> 'a + val is_ok : _ t -> bool val is_error : _ t -> bool From 6ff54090e3ae5fb9f6a6fdea626e0a9a89ce3442 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 2 Oct 2020 14:30:38 +0200 Subject: [PATCH 10/36] Merlin server read all files in closest .merlin-conf/ MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin_server.ml | 47 ++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index a4ef7ffdc84..41c760ae550 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -55,23 +55,45 @@ let get_merlin_file_path local_path = let ctx = Context_name.to_string context in let ctx_root = Path.Build.(relative root ctx) in let dir_path = Path.Build.(append_local ctx_root local_path) in - Path.Build.relative dir_path Merlin.merlin_file_name |> Path.build + let merlin_path = Path.Build.relative dir_path Merlin.merlin_file_name in + let files = + Result.value ~default:[] (Path.readdir_unsorted (Path.build merlin_path)) + |> List.fast_sort ~cmp:Stdlib.compare + in + List.map files ~f:(fun f -> Path.Build.relative merlin_path f |> Path.build) let load_merlin_file local_path file = let no_config_error () = Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" in - let filename = String.lowercase_ascii file in - let file_path = get_merlin_file_path local_path in - if Path.exists file_path then - match Merlin.Processed.load_file file_path with - | Some config -> - Option.value ~default:(no_config_error ()) - (Merlin.Processed.get config ~filename) - | None -> no_config_error () - else - no_config_error () + (* We search for an appropriate merlin configuration in the current directory + and its parents *) + let rec find_closest path = + let filename = String.lowercase_ascii file in + let file_paths = get_merlin_file_path path in + + let result = + List.find_map file_paths ~f:(fun file_path -> + if Path.exists file_path then + match Merlin.Processed.load_file file_path with + | Some config -> Merlin.Processed.get config ~filename + | None -> None + else + None) + in + match result with + | Some p -> Some p + | None -> + Option.bind + ( if Path.Local.is_root path then + None + else + Path.Local.parent path ) + ~f:find_closest + in + + Option.value (find_closest local_path) ~default:(no_config_error ()) let print_merlin_conf file = let abs_root, file = Filename.(dirname file, basename file) in @@ -84,7 +106,8 @@ let print_merlin_conf file = let dump s = match to_local s with - | Ok path -> Merlin.Processed.print_file (get_merlin_file_path path) + | Ok path -> + List.iter (get_merlin_file_path path) ~f:Merlin.Processed.print_file | Error mess -> Printf.eprintf "%s\n%!" mess let start () = From 48a92565b1da9fe5719112b3e9d0e97a2f5eef6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 15 Jun 2020 16:08:05 +0200 Subject: [PATCH 11/36] Update documentation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- doc/usage.rst | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/doc/usage.rst b/doc/usage.rst index 3a6c13c9a2c..5f91fb92d04 100644 --- a/doc/usage.rst +++ b/doc/usage.rst @@ -148,13 +148,10 @@ the command line. When no targets are specified, ``dune`` builds the Resolution ---------- -All targets that dune knows how to build live in the ``_build`` -directory. Although, some are sometimes copied to the source tree for -the need of external tools. These includes: - -- ``.merlin`` files -- ``.install`` files (when either ``-p`` or - ``--promote-install-files`` is passed on the command line) +All targets that dune knows how to build live in the ``_build`` directory. +Although, some are sometimes copied to the source tree for the need of external +tools. These includes ``.install`` files when either ``-p`` or +``--promote-install-files`` is passed on the command line. As a result, if you want to ask ``dune`` to produce a particular ``.exe`` file you would have to type: From c6c9ee3f65d248edb06790f4073a829ef6ad6474 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 21 Oct 2020 12:06:00 +0200 Subject: [PATCH 12/36] Comment and refactor merlin.ml MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 14 +++++++------- src/dune_rules/merlin.mli | 16 +++++++++++++--- 2 files changed, 20 insertions(+), 10 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 38e6915ff02..7dbff603739 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -17,14 +17,14 @@ let merlin_file_name = ".merlin-conf/" let merlin_exist_name = ".merlin-exist" let make_lib_ident lib = - Printf.sprintf "-lib-%s" - (Dune_file.Library.best_name lib |> Lib_name.to_string) + Printf.sprintf "lib-%s" (Dune_file.Library.best_name lib |> Lib_name.to_string) let make_exe_ident exes = - Printf.sprintf "-exe-%s" + Printf.sprintf "exe-%s" (String.concat ~sep:"-" (List.map ~f:snd exes.Dune_file.Executables.names)) -let make_merlin_exists ~ident = merlin_exist_name ^ ident +let make_merlin_exists ~ident = + String.concat ~sep:"-" [ merlin_exist_name; ident ] module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] @@ -127,6 +127,8 @@ module Unprocessed = struct source_dirs = Path.Source.Set.add cu_config.source_dirs dir }) + (* Since one merlin configuration per stanza is generated, merging should + always be trivial *) let merge_config _a b = b let make ?(requires = Ok []) ~flags @@ -176,14 +178,11 @@ module Unprocessed = struct ; extensions } in - let modules = List.map ~f:(fun m -> (Module.name m, cu_config)) (Modules.impl_only modules) in - - (* We use [of_list_reduce] to merge configs *) Module_name.Map.of_list_reduce modules ~f:merge_config let quote_if_needed s = @@ -325,6 +324,7 @@ let dot_merlin sctx ~ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = SC.add_rule sctx ~dir ( Build.with_no_targets (Build.path (Path.build merlin_file)) >>> Build.create_file (Path.Build.relative dir merlin_exist_name) ); + Path.Set.singleton (Path.build merlin_file) |> Rules.Produce.Alias.add_deps (Alias.check ~dir); diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index b63da12e900..ea34b72cdfa 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -1,12 +1,19 @@ -(** Merlin rules *) +(** This module ensures that one merlin configuration file is generated for each + stanza. Each of these configuration files is accompanied by a merlin exist + file. Each of these files contain a map from every module involved in the + stanza to a standard merlin configuration. The [Processed.t] type represents + the Merlin configuration as it will be marshalled to and from the + configuration files, while [Merlin.t] represents raw information coming from + the build system. *) open! Dune_engine open! Stdune open Import -(* Merlin file names and tools to manipulate them *) +(** Merlin config file base name *) val merlin_file_name : string +(** Merlin exist file base name *) val merlin_exist_name : string val make_lib_ident : Dune_file.Library.t -> string @@ -15,11 +22,13 @@ val make_exe_ident : Dune_file.Executables.t -> string val make_merlin_exists : ident:string -> string +(** Type of "unprocessed" merlin information *) type t val add_source_dir : t -> Path.Source.t -> t module Processed : sig + (** Type of "processed" merlin information *) type t val load_file : Path.t -> t option @@ -41,7 +50,8 @@ val make : -> unit -> t -(** Add rules for generating the .merlin in a directory *) +(** Add rules for generating the merlin configuration of a specific stanza + identified by [ident] in a directory *) val add_rules : Super_context.t -> ident:string From dcff50198e71e30a5b357af90c3f0b0a296c9893 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 21 Oct 2020 12:10:29 +0200 Subject: [PATCH 13/36] Add some comments to merlin_server MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin_server.ml | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index 41c760ae550..c05b3260015 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -31,7 +31,7 @@ module Commands = struct | Error _ -> Halt end -(* [to_local p] makes absolute path [p] relative to the projects root and +(* [to_local p] makes absolute path [p] relative to the project's root and optionally removes the build context *) let to_local abs_file_path = let error msg = Error msg in @@ -47,7 +47,7 @@ let to_local abs_file_path = | None -> Printf.sprintf "Path is not in dune workspace %s" abs_file_path |> error -let get_merlin_file_path local_path = +let get_merlin_files_paths local_path = let workspace = Workspace.workspace () in let context = Option.value ~default:Context_name.default workspace.merlin_context @@ -66,13 +66,11 @@ let load_merlin_file local_path file = let no_config_error () = Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" in - (* We search for an appropriate merlin configuration in the current directory and its parents *) let rec find_closest path = let filename = String.lowercase_ascii file in - let file_paths = get_merlin_file_path path in - + let file_paths = get_merlin_files_paths path in let result = List.find_map file_paths ~f:(fun file_path -> if Path.exists file_path then @@ -92,7 +90,6 @@ let load_merlin_file local_path file = Path.Local.parent path ) ~f:find_closest in - Option.value (find_closest local_path) ~default:(no_config_error ()) let print_merlin_conf file = @@ -107,7 +104,7 @@ let print_merlin_conf file = let dump s = match to_local s with | Ok path -> - List.iter (get_merlin_file_path path) ~f:Merlin.Processed.print_file + List.iter (get_merlin_files_paths path) ~f:Merlin.Processed.print_file | Error mess -> Printf.eprintf "%s\n%!" mess let start () = From ded29ed348dc3947f757585d3169c6d12a648764 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 15 Jun 2020 16:32:28 +0200 Subject: [PATCH 14/36] Update test suite MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- dune-project | 2 +- .../test-cases/check-alias.t/run.t | 6 +- .../test-cases/copy_files.t/run.t | 2 +- .../test-cases/disable-promotion.t/dune | 3 - .../disable-promotion.t/dune-project | 4 - .../test-cases/disable-promotion.t/run.t | 12 -- .../test-cases/github1946.t/dune | 2 +- .../test-cases/github1946.t/run.t | 27 +++- .../test-cases/github20.t/run.t | 6 +- .../test-cases/github2206.t/run.t | 9 +- .../test-cases/github759.t/run.t | 41 +++-- .../merlin/allow_approximate_merlin.t/run.t | 9 +- .../merlin/merlin-from-subdir.t/411/test.ml | 1 + .../merlin/merlin-from-subdir.t/dune | 10 ++ .../merlin/merlin-from-subdir.t/dune-project | 1 + .../merlin/merlin-from-subdir.t/foo.ml | 1 + .../merlin/merlin-from-subdir.t/run.t | 55 +++++++ .../test-cases/merlin/merlin-tests.t/dune | 14 -- .../test-cases/merlin/merlin-tests.t/run.t | 153 ++++++++++++------ .../merlin-tests.t/sanitize-dot-merlin/dune | 3 - .../sanitize_dot_merlin.ml | 28 ---- .../test-cases/merlin/server.t/dune | 9 +- .../test-cases/merlin/server.t/lib2.ml | 1 + .../test-cases/merlin/server.t/lib3.ml | 1 + .../test-cases/merlin/server.t/mylib3.mli | 1 + .../test-cases/merlin/server.t/run.t | 14 +- .../merlin/src-dirs-of-deps.t/run.t | 33 ++-- 27 files changed, 285 insertions(+), 163 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/dune delete mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/dune-project delete mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/run.t create mode 100644 test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/411/test.ml create mode 100644 test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune create mode 100644 test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune-project create mode 100644 test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/foo.ml create mode 100644 test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t delete mode 100644 test/blackbox-tests/test-cases/merlin/merlin-tests.t/dune delete mode 100644 test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/dune delete mode 100644 test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/sanitize_dot_merlin.ml create mode 100644 test/blackbox-tests/test-cases/merlin/server.t/lib2.ml create mode 100644 test/blackbox-tests/test-cases/merlin/server.t/lib3.ml create mode 100644 test/blackbox-tests/test-cases/merlin/server.t/mylib3.mli diff --git a/dune-project b/dune-project index b68a01e4ca1..4a36982b577 100644 --- a/dune-project +++ b/dune-project @@ -23,7 +23,7 @@ (name dune) ; The "depends" and "build" field are written in dune.opam.template (conflicts - (merlin (< 3.3.7)) + (merlin (< 3.4.0)) (dune-configurator (< 2.3.0)) (odoc (< 1.3.0)) (dune-release (< 1.3.0)) diff --git a/test/blackbox-tests/test-cases/check-alias.t/run.t b/test/blackbox-tests/test-cases/check-alias.t/run.t index e2b2549fb5d..d20cc5f2928 100644 --- a/test/blackbox-tests/test-cases/check-alias.t/run.t +++ b/test/blackbox-tests/test-cases/check-alias.t/run.t @@ -9,13 +9,13 @@ as well as the foo.{cmi,cmo,cmt} files. > ( > cd $1 > dune build @check - > find _build \( -name '*.cm*' -o -name .merlin \) | awk -F/ '{ print $NF }' | LANG=C sort + > find _build \( -name '*.cm*' -o -name '.merlin-conf' \) | awk -F/ '{ print $NF }' | LANG=C sort > ) Test the property for executables: $ build_check_and_list_interesting_files_in exe - .merlin + .merlin-conf foo.cmi foo.cmo foo.cmt @@ -23,7 +23,7 @@ Test the property for executables: Test the property for libraries: $ build_check_and_list_interesting_files_in lib - .merlin + .merlin-conf foo.cmi foo.cmo foo.cmt diff --git a/test/blackbox-tests/test-cases/copy_files.t/run.t b/test/blackbox-tests/test-cases/copy_files.t/run.t index a5dbc615461..4a62a73eff9 100644 --- a/test/blackbox-tests/test-cases/copy_files.t/run.t +++ b/test/blackbox-tests/test-cases/copy_files.t/run.t @@ -1,6 +1,6 @@ Test that (copy_files ...) works - $ dune build --root test1 test.exe .merlin + $ dune build --root test1 test.exe .merlin-conf/lib-foo .merlin-conf/exe-test Entering directory 'test1' $ dune build --root test1 @bar-source Entering directory 'test1' diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/dune b/test/blackbox-tests/test-cases/disable-promotion.t/dune deleted file mode 100644 index 0c7c1d5bd3d..00000000000 --- a/test/blackbox-tests/test-cases/disable-promotion.t/dune +++ /dev/null @@ -1,3 +0,0 @@ -(library - (name foo) - (public_name foo)) diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/dune-project b/test/blackbox-tests/test-cases/disable-promotion.t/dune-project deleted file mode 100644 index 7f1979c9176..00000000000 --- a/test/blackbox-tests/test-cases/disable-promotion.t/dune-project +++ /dev/null @@ -1,4 +0,0 @@ -(lang dune 1.11) - -(package - (name foo)) diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/run.t b/test/blackbox-tests/test-cases/disable-promotion.t/run.t deleted file mode 100644 index f43105b16da..00000000000 --- a/test/blackbox-tests/test-cases/disable-promotion.t/run.t +++ /dev/null @@ -1,12 +0,0 @@ -This tests shows how all promotion to the source dir may be disabled. This -includes both .install and .merlin files - - $ dune build --disable-promotion @all -.merlin is absent - $ test -f .merlin && echo ".merlin exists" - [1] - -now we build without the option and see that it is present: - $ dune build @all - $ test -f .merlin && echo ".merlin exists" - .merlin exists diff --git a/test/blackbox-tests/test-cases/github1946.t/dune b/test/blackbox-tests/test-cases/github1946.t/dune index 77b87f88ab8..5b481ffe77e 100644 --- a/test/blackbox-tests/test-cases/github1946.t/dune +++ b/test/blackbox-tests/test-cases/github1946.t/dune @@ -10,4 +10,4 @@ (alias (name default) - (action (echo %{read:.merlin}))) + (action (echo %{read:.merlin-conf}))) diff --git a/test/blackbox-tests/test-cases/github1946.t/run.t b/test/blackbox-tests/test-cases/github1946.t/run.t index 256fe546a3d..cabfe1ca2d1 100644 --- a/test/blackbox-tests/test-cases/github1946.t/run.t +++ b/test/blackbox-tests/test-cases/github1946.t/run.t @@ -1,6 +1,25 @@ -This test demonstrates that -ppx is missing when two stanzas are in the same -dune file, but require different ppx specifications +This test demonstrates that -ppx is no more missing when two stanzas are +in the same dune file, but require different ppx specifications $ dune build @all --profile release - $ cat .merlin | grep "^FLG" - FLG -open Usesppx1 -w -40 -open Usesppx2 -w -40 + $ dune ocaml-merlin --dump-config=$(pwd) + usesppx1 + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.usesppx1.objs/byte) + (S + $TESTCASE_ROOT) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/c152d6ca3c7e1d83471ffdf48bf729ae/ppx.exe --as-ppx --cookie 'library-name="usesppx1"'")) + (FLG (-open Usesppx1 -w -40))) + usesppx2 + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.usesppx2.objs/byte) + (S + $TESTCASE_ROOT) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/d7394c27c5e0f7ad7ab1110d6b092c05/ppx.exe --as-ppx --cookie 'library-name="usesppx2"'")) + (FLG (-open Usesppx2 -w -40))) diff --git a/test/blackbox-tests/test-cases/github20.t/run.t b/test/blackbox-tests/test-cases/github20.t/run.t index 52964154f00..f5f1056d7b6 100644 --- a/test/blackbox-tests/test-cases/github20.t/run.t +++ b/test/blackbox-tests/test-cases/github20.t/run.t @@ -1,3 +1,3 @@ - $ dune build .merlin - $ ls .merlin - .merlin + $ dune build .merlin-conf/lib-foo + $ ls _build/default/.merlin-conf/lib-foo + _build/default/.merlin-conf/lib-foo diff --git a/test/blackbox-tests/test-cases/github2206.t/run.t b/test/blackbox-tests/test-cases/github2206.t/run.t index 2db2b0f8aff..3c3801b726e 100644 --- a/test/blackbox-tests/test-cases/github2206.t/run.t +++ b/test/blackbox-tests/test-cases/github2206.t/run.t @@ -1,4 +1,7 @@ copy_files would break the generation of the preprocessing flags - $ dune build copy_files/.merlin - $ cat copy_files/.merlin | grep "FLG -pp" - FLG -pp '$TESTCASE_ROOT/_build/default/pp.exe' + $ dune build copy_files/.merlin-conf/exe-foo + $ dune ocaml-merlin --dump-config=$(pwd)/copy_files | + > grep -B 1 -A 0 "pp" + (FLG + (-pp + $TESTCASE_ROOT/_build/default/pp.exe)) diff --git a/test/blackbox-tests/test-cases/github759.t/run.t b/test/blackbox-tests/test-cases/github759.t/run.t index 4255f58f042..9f21d36336d 100644 --- a/test/blackbox-tests/test-cases/github759.t/run.t +++ b/test/blackbox-tests/test-cases/github759.t/run.t @@ -1,20 +1,31 @@ $ dune build foo.cma --profile release - $ cat .merlin - EXCLUDE_QUERY_DIR - B _build/default/.foo.objs/byte - S . - FLG -open Foo -w -40 + $ dune ocaml-merlin --dump-config=$(pwd) + foo + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.foo.objs/byte) + (S + $TESTCASE_ROOT) + (FLG (-open Foo -w -40))) + $ rm -f .merlin $ dune build foo.cma --profile release - $ cat .merlin - EXCLUDE_QUERY_DIR - B _build/default/.foo.objs/byte - S . - FLG -open Foo -w -40 + $ dune ocaml-merlin --dump-config=$(pwd) + foo + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.foo.objs/byte) + (S + $TESTCASE_ROOT) + (FLG (-open Foo -w -40))) + $ echo toto > .merlin $ dune build foo.cma --profile release - $ cat .merlin - EXCLUDE_QUERY_DIR - B _build/default/.foo.objs/byte - S . - FLG -open Foo -w -40 + $ dune ocaml-merlin --dump-config=$(pwd) + foo + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.foo.objs/byte) + (S + $TESTCASE_ROOT) + (FLG (-open Foo -w -40))) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t index 4f980c33481..f74628a1ead 100644 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t @@ -1,3 +1,5 @@ +TODO this test is now obsolete + If different options apply to two stanzas in the same directory, the .merlin file is the union of the two and a warning is emitted. @@ -7,13 +9,6 @@ For lang >= 1.9, a warning is printed: $ echo '(lang dune 1.9)' > dune-project $ dune build @check - File "dune", line 4, characters 13-26: - 4 | (preprocess future_syntax)) - ^^^^^^^^^^^^^ - Warning: .merlin generated is inaccurate. Cannot mix preprocessed and non - preprocessed specifications. - Split the stanzas into different directories or silence this warning by - adding (allow_approximate_merlin) to your dune-project. Indeed, adding this will suppress the warning: diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/411/test.ml b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/411/test.ml new file mode 100644 index 00000000000..6bb11e18aea --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/411/test.ml @@ -0,0 +1 @@ +print_endline Foo.v diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune new file mode 100644 index 00000000000..b719072938a --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune @@ -0,0 +1,10 @@ +(library + (name foo) + (modules foo)) + +(executable + (name test) + (modules test) + (libraries foo)) + +(copy_files 411/test.ml) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune-project b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune-project new file mode 100644 index 00000000000..c2e46604eed --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/dune-project @@ -0,0 +1 @@ +(lang dune 2.8) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/foo.ml b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/foo.ml new file mode 100644 index 00000000000..64b58c1177c --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/foo.ml @@ -0,0 +1 @@ +let v = "bar" diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t new file mode 100644 index 00000000000..ad6432538d2 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t @@ -0,0 +1,55 @@ +We build the project + $ dune exec ./test.exe + bar + +Verify that merlin configuration was generated... + $ dune ocaml-merlin --dump-config=$(pwd) + test + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.foo.objs/byte) + (B + $TESTCASE_ROOT/_build/default/.test.eobjs/byte) + (S + $TESTCASE_ROOT) + (S + $TESTCASE_ROOT/411) + (FLG + (-w + @1..3@5..28@30..39@43@46..47@49..57@61..62-40 + -strict-sequence + -strict-formats + -short-paths + -keep-locs))) + foo + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/.foo.objs/byte) + (S + $TESTCASE_ROOT) + (S + $TESTCASE_ROOT/411) + (FLG + (-w + @1..3@5..28@30..39@43@46..47@49..57@61..62-40 + -strict-sequence + -strict-formats + -short-paths + -keep-locs))) + +...but not in the sub-folder whose content was copied + $ dune ocaml-merlin --dump-config=$(pwd)/411 + +Now we check that both querying from the root and the subfolder works + $ FILE=$(pwd)/foo.ml + $ FILE411=$(pwd)/411/test.ml + + $ dune ocaml-merlin < (4:File${#FILE}:$FILE) + > EOF + ((?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) + + $ dune ocaml-merlin < (4:File${#FILE411}:$FILE411) + > EOF + ((?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/dune b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/dune deleted file mode 100644 index 500500ea967..00000000000 --- a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/dune +++ /dev/null @@ -1,14 +0,0 @@ -(alias - (name print-merlins) - (deps lib/.merlin exe/.merlin) - (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{deps}))) - -(alias - (name print-merlins-pp) - (deps pp-with-expand/.merlin) - (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{deps}))) - -(alias - (name print-merlins-future-syntax) - (deps future-syntax/.merlin) - (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{deps}))) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t index 4352c474a8a..8fd93b15cde 100644 --- a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t @@ -1,51 +1,110 @@ - $ dune build @print-merlins --profile release - sanitize_dot_merlin alias print-merlins - # Processing exe/.merlin - B $LIB_PREFIX/lib/bytes - B $LIB_PREFIX/lib/findlib - B $LIB_PREFIX/lib/ocaml - B ../_build/default/exe/.x.eobjs/byte - B ../_build/default/lib/.foo.objs/public_cmi - EXCLUDE_QUERY_DIR - FLG -pp '$TESTCASE_ROOT/_build/default/pp/pp.exe' - FLG -w -40 - S $LIB_PREFIX/lib/bytes - S $LIB_PREFIX/lib/findlib - S $LIB_PREFIX/lib/ocaml - S . - S ../lib - # Processing lib/.merlin - B $LIB_PREFIX/lib/bytes - B $LIB_PREFIX/lib/findlib - B $LIB_PREFIX/lib/ocaml - B ../_build/default/lib/.bar.objs/byte - B ../_build/default/lib/.foo.objs/byte - EXCLUDE_QUERY_DIR - FLG -open Foo -w -40 -open Bar -w -40 - FLG -ppx '$PPX/4128e43a9cfb141a37f547484cc9bf46/ppx.exe --as-ppx --cookie '\''library-name="foo"'\''' - S $LIB_PREFIX/lib/bytes - S $LIB_PREFIX/lib/findlib - S $LIB_PREFIX/lib/ocaml - S . - S subdir +CRAM sanitization + $ dune build ./exe/.merlin-conf/exe-x --profile release + $ dune ocaml-merlin --dump-config=$(pwd)/exe | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' + x + ((EXCLUDE_QUERY_DIR) + (B OPAM_PREFIX/lib/bytes) + (B OPAM_PREFIX/lib/findlib) + (B OPAM_PREFIX/lib/ocaml) + (B + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/byte) + (B + $TESTCASE_ROOT/_build/default/lib/.foo.objs/public_cmi) + (S OPAM_PREFIX/lib/bytes) + (S OPAM_PREFIX/lib/findlib) + (S OPAM_PREFIX/lib/ocaml) + (S + $TESTCASE_ROOT/exe) + (S + $TESTCASE_ROOT/lib) + (FLG + (-pp + $TESTCASE_ROOT/_build/default/pp/pp.exe)) + (FLG (-w -40))) + + $ dune build ./lib/.merlin-conf/lib-foo ./lib/.merlin-conf/lib-bar --profile release + $ dune ocaml-merlin --dump-config=$(pwd)/lib | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' + bar + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) + (S + $TESTCASE_ROOT/lib) + (S + $TESTCASE_ROOT/lib/subdir) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/4128e43a9cfb141a37f547484cc9bf46/ppx.exe --as-ppx --cookie 'library-name="bar"'")) + (FLG (-open Bar -w -40))) + file + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) + (S + $TESTCASE_ROOT/lib) + (S + $TESTCASE_ROOT/lib/subdir) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/4128e43a9cfb141a37f547484cc9bf46/ppx.exe --as-ppx --cookie 'library-name="bar"'")) + (FLG (-open Bar -w -40))) + foo + ((EXCLUDE_QUERY_DIR) + (B OPAM_PREFIX/lib/bytes) + (B OPAM_PREFIX/lib/findlib) + (B OPAM_PREFIX/lib/ocaml) + (B + $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) + (S OPAM_PREFIX/lib/bytes) + (S OPAM_PREFIX/lib/findlib) + (S OPAM_PREFIX/lib/ocaml) + (S + $TESTCASE_ROOT/lib) + (S + $TESTCASE_ROOT/lib/subdir) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/4128e43a9cfb141a37f547484cc9bf46/ppx.exe --as-ppx --cookie 'library-name="foo"'")) + (FLG (-open Foo -w -40))) + privmod + ((EXCLUDE_QUERY_DIR) + (B OPAM_PREFIX/lib/bytes) + (B OPAM_PREFIX/lib/findlib) + (B OPAM_PREFIX/lib/ocaml) + (B + $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) + (S OPAM_PREFIX/lib/bytes) + (S OPAM_PREFIX/lib/findlib) + (S OPAM_PREFIX/lib/ocaml) + (S + $TESTCASE_ROOT/lib) + (S + $TESTCASE_ROOT/lib/subdir) + (FLG + (-ppx + "$TESTCASE_ROOT/_build/default/.ppx/4128e43a9cfb141a37f547484cc9bf46/ppx.exe --as-ppx --cookie 'library-name="foo"'")) + (FLG (-open Foo -w -40))) + Make sure a ppx directive is generated - $ grep -q ppx lib/.merlin + $ dune ocaml-merlin --dump-config=$(pwd)/lib | grep -q ppx + Make sure pp flag is correct and variables are expanded - $ dune build @print-merlins-pp - sanitize_dot_merlin alias print-merlins-pp - # Processing pp-with-expand/.merlin - B ../_build/default/pp-with-expand/.foobar.eobjs/byte - EXCLUDE_QUERY_DIR - FLG -pp '$TESTCASE_ROOT/_build/default/pp/pp.exe -nothing' - FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs - S . + + $ dune build ./pp-with-expand/.merlin-conf/exe-foobar --profile release + $ dune ocaml-merlin --dump-config=$(pwd)/pp-with-expand | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' + foobar + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/byte) + (S + $TESTCASE_ROOT/pp-with-expand) + (FLG + (-pp + "$TESTCASE_ROOT/_build/default/pp/pp.exe -nothing")) + (FLG (-w -40))) + We want future-syntax to either be applied, or not, depending on OCaml version. Adding the `echo` with expected output to the set of lines is a way of achieving that. - $ (echo "FLG -pp '\$BIN/ocaml-syntax-shims'"; dune build @print-merlins-future-syntax 2>&1) | sort | uniq - # Processing future-syntax/.merlin - B ../_build/default/future-syntax/.pp_future_syntax.eobjs/byte - EXCLUDE_QUERY_DIR - FLG -pp '$BIN/ocaml-syntax-shims' - FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs - S . - sanitize_dot_merlin alias print-merlins-future-syntax diff --git a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/dune b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/dune deleted file mode 100644 index cd40bc3b957..00000000000 --- a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/dune +++ /dev/null @@ -1,3 +0,0 @@ -(executable - (name sanitize_dot_merlin) - (libraries str)) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/sanitize_dot_merlin.ml b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/sanitize_dot_merlin.ml deleted file mode 100644 index d3b1b28f6b8..00000000000 --- a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/sanitize-dot-merlin/sanitize_dot_merlin.ml +++ /dev/null @@ -1,28 +0,0 @@ -open Printf - -let process_line = - let path_re = Str.regexp {|^\([SB]\) /.+/lib/\(.+\)$|} in - let ppx_re = Str.regexp {|^FLG -ppx '/.+/\.ppx/\(.+\)$|} in - let special_pp_re = - Str.regexp {|^FLG -pp '/.+/_build/install/default/bin/\(.+\)$|} - in - fun line -> - line - |> Str.replace_first path_re {|\1 $LIB_PREFIX/lib/\2|} - |> Str.global_replace ppx_re {|FLG -ppx '$PPX/\1|} - |> Str.global_replace special_pp_re {|FLG -pp '$BIN/\1|} - -let () = - let files = Sys.argv |> Array.to_list |> List.tl |> List.sort compare in - List.iter - (fun f -> - printf "# Processing %s\n" f; - let ch = open_in f in - let rec all_lines lines = - match input_line ch with - | exception End_of_file -> lines - | line -> all_lines (process_line line :: lines) - in - all_lines [] |> List.sort compare |> List.iter print_endline; - close_in ch) - files diff --git a/test/blackbox-tests/test-cases/merlin/server.t/dune b/test/blackbox-tests/test-cases/merlin/server.t/dune index 08883f0ee35..2867625c073 100644 --- a/test/blackbox-tests/test-cases/merlin/server.t/dune +++ b/test/blackbox-tests/test-cases/merlin/server.t/dune @@ -2,7 +2,12 @@ (name mylib) (modules lib)) +(library + (name mylib3) + (modules lib3) + (libraries mylib)) + (executable (name main) - (modules main) - (libraries mylib)) + (modules main lib2) + (libraries mylib mylib3)) diff --git a/test/blackbox-tests/test-cases/merlin/server.t/lib2.ml b/test/blackbox-tests/test-cases/merlin/server.t/lib2.ml new file mode 100644 index 00000000000..bcf417b1934 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/server.t/lib2.ml @@ -0,0 +1 @@ +let foo ="bar2" diff --git a/test/blackbox-tests/test-cases/merlin/server.t/lib3.ml b/test/blackbox-tests/test-cases/merlin/server.t/lib3.ml new file mode 100644 index 00000000000..bcf417b1934 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/server.t/lib3.ml @@ -0,0 +1 @@ +let foo ="bar2" diff --git a/test/blackbox-tests/test-cases/merlin/server.t/mylib3.mli b/test/blackbox-tests/test-cases/merlin/server.t/mylib3.mli new file mode 100644 index 00000000000..e0d0abbf7f5 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/server.t/mylib3.mli @@ -0,0 +1 @@ +module Lib3 = Lib3 diff --git a/test/blackbox-tests/test-cases/merlin/server.t/run.t b/test/blackbox-tests/test-cases/merlin/server.t/run.t index 74b372f471b..39ab9c11275 100644 --- a/test/blackbox-tests/test-cases/merlin/server.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/server.t/run.t @@ -2,12 +2,20 @@ $ dune ocaml-merlin < (4:File${#FILE}:$FILE) > EOF - ((5:ERROR82:No configuration file found. Try calling `dune build` to generate `.merlin` files.)) + ((5:ERROR48:Project isn't built. (Try calling `dune build`.))) $ dune build @check 2>&1 | sed "s/(lang dune .*)/(lang dune )/" Info: Creating file dune-project with this contents: | (lang dune ) - $ dune ocaml-merlin < (4:File${#FILE}:$FILE) + > EOF + ((?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.main.eobjs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Dune__exe?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) + + $ FILE=$PWD/lib3.ml + $ dune ocaml-merlin < (4:File${#FILE}:$FILE) > EOF - ((5:ERROR82:No configuration file found. Try calling `dune build` to generate `.merlin` files.)) + ((?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) + diff --git a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t index 91fe595ec30..2eb8487a324 100644 --- a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t @@ -13,12 +13,27 @@ library also has more than one src dir. $ cat >lib2/dune < (library (name lib2) (libraries lib1) (modules ())) > EOF - $ dune build lib2/.merlin - $ cat lib2/.merlin - EXCLUDE_QUERY_DIR - B ../_build/default/lib1/.lib1.objs/byte - B ../_build/default/lib2/.lib2.objs/byte - S ../lib1 - S ../lib1/sub - S . - FLG -open Lib2 -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs + + $ dune build lib2/.merlin-conf/lib-lib2 + $ dune ocaml-merlin --dump-config=$(pwd)/lib2 + lib2 + ((EXCLUDE_QUERY_DIR) + (B + $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/byte) + (B + $TESTCASE_ROOT/_build/default/lib2/.lib2.objs/byte) + (S + $TESTCASE_ROOT/lib1) + (S + $TESTCASE_ROOT/lib1/sub) + (S + $TESTCASE_ROOT/lib2) + (FLG + (-open + Lib2 + -w + @1..3@5..28@30..39@43@46..47@49..57@61..62-40 + -strict-sequence + -strict-formats + -short-paths + -keep-locs))) From 176efcac2f4e5dbf7b3e35ddb55b6ae5bdb0ae52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 21 Oct 2020 16:46:50 +0200 Subject: [PATCH 15/36] Add new 'disable-promotion' test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../test-cases/disable-promotion.t/dune | 4 ++++ .../disable-promotion.t/dune-project | 4 ++++ .../test-cases/disable-promotion.t/foo.ml | 1 + .../test-cases/disable-promotion.t/run.t | 18 ++++++++++++++++++ 4 files changed, 27 insertions(+) create mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/dune create mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/dune-project create mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/foo.ml create mode 100644 test/blackbox-tests/test-cases/disable-promotion.t/run.t diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/dune b/test/blackbox-tests/test-cases/disable-promotion.t/dune new file mode 100644 index 00000000000..3f494460791 --- /dev/null +++ b/test/blackbox-tests/test-cases/disable-promotion.t/dune @@ -0,0 +1,4 @@ +(executable + (name foo) + (public_name foo) + (promote (until-clean))) diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/dune-project b/test/blackbox-tests/test-cases/disable-promotion.t/dune-project new file mode 100644 index 00000000000..7f1979c9176 --- /dev/null +++ b/test/blackbox-tests/test-cases/disable-promotion.t/dune-project @@ -0,0 +1,4 @@ +(lang dune 1.11) + +(package + (name foo)) diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/foo.ml b/test/blackbox-tests/test-cases/disable-promotion.t/foo.ml new file mode 100644 index 00000000000..5aefdf4ef7d --- /dev/null +++ b/test/blackbox-tests/test-cases/disable-promotion.t/foo.ml @@ -0,0 +1 @@ +print_endline "Hello Caml" diff --git a/test/blackbox-tests/test-cases/disable-promotion.t/run.t b/test/blackbox-tests/test-cases/disable-promotion.t/run.t new file mode 100644 index 00000000000..c3542785aad --- /dev/null +++ b/test/blackbox-tests/test-cases/disable-promotion.t/run.t @@ -0,0 +1,18 @@ +This tests shows how all promotion to the source dir may be disabled. This +includes .install files and manually promoted executables + + $ dune build -p foo --disable-promotion + +foo.exe and foo.install are absent + $ test -f foo.exe && echo "foo.exe exists" + [1] + $ test -f foo.install && echo "foo.install exists" + [1] + +now we build without the option and see that they are present: + $ dune build -p foo + + $ test -f foo.exe && echo "foo.exe exists" + foo.exe exists + $ test -f foo.install && echo "foo.install exists" + foo.install exists From cdcb45e0f5d9adbf69d5b9920e95e046a59a4e10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 22 Oct 2020 17:46:20 +0200 Subject: [PATCH 16/36] Use abstract type ident for more clarity MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/buildable_rules.ml | 4 ++-- src/dune_rules/buildable_rules.mli | 4 ++-- src/dune_rules/exe_rules.ml | 7 ++----- src/dune_rules/gen_rules.ml | 4 ++-- src/dune_rules/lib_rules.ml | 4 ++-- src/dune_rules/merlin.ml | 16 +++++++++------- src/dune_rules/merlin.mli | 21 +++++++++++++-------- src/dune_rules/merlin_server.ml | 2 +- 8 files changed, 33 insertions(+), 29 deletions(-) diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 4238d9e3a02..3ee24c21462 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -15,13 +15,13 @@ let gen_select_rules t ~dir compile_info = Build.fail { fail = (fun () -> raise e) } |> Build.with_targets ~targets:[ dst ] )) -let with_lib_deps ~merlin_ident (t : Context.t) compile_info ~dir ~f = +let with_lib_deps (t : Context.t) merlin_ident compile_info ~dir ~f = let prefix = Build.label (Lib_deps_info.Label (Lib.Compile.lib_deps_info compile_info)) in let prefix = if t.merlin then - Path.Build.relative dir (Merlin.make_merlin_exists ~ident:merlin_ident) + Path.Build.relative dir (Merlin.make_merlin_exists merlin_ident) |> Path.build |> Build.path >>> prefix else prefix diff --git a/src/dune_rules/buildable_rules.mli b/src/dune_rules/buildable_rules.mli index 9b5122f6538..702a7e8213b 100644 --- a/src/dune_rules/buildable_rules.mli +++ b/src/dune_rules/buildable_rules.mli @@ -16,8 +16,8 @@ val gen_select_rules : (** Generate the rules for the [(select ...)] forms in library dependencies *) val with_lib_deps : - merlin_ident:string - -> Context.t + Context.t + -> Merlin.ident -> Lib.Compile.t -> dir:Path.Build.t -> f:(unit -> 'a) diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 99a79772281..6f89c28ca9f 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -207,10 +207,7 @@ let rules ~sctx ~dir ~dir_contents ~scope ~expander in Buildable_rules.gen_select_rules sctx compile_info ~dir; Bootstrap_info.gen_rules sctx exes ~dir compile_info; - let merlin_ident = - Printf.sprintf "exe-%s" - (String.concat ~sep:"-" (List.map ~f:snd exes.names)) - in - Buildable_rules.with_lib_deps ~merlin_ident + Buildable_rules.with_lib_deps (Super_context.context sctx) + (Merlin.make_exe_ident exes) compile_info ~dir ~f diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 29154325857..796431ad11d 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -24,7 +24,7 @@ module For_stanza : sig -> dir_contents:Dir_contents.t -> expander:Expander.t -> files_to_install:(Install_conf.t -> unit) - -> ( (string * Merlin.t) list + -> ( (Merlin.ident * Merlin.t) list , (Loc.t * Compilation_context.t) list , Path.Build.t list , Path.Source.t list ) @@ -232,7 +232,7 @@ let gen_rules sctx dir_contents cctxs expander let more_src_dirs = lib_src_dirs ~dir_contents |> List.rev_append source_dirs in - Merlin.add_rules sctx ~ident ~dir:ctx_dir ~more_src_dirs ~expander + Merlin.add_rules sctx ident ~dir:ctx_dir ~more_src_dirs ~expander (Merlin.add_source_dir merlin src_dir)); List.iter stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index dc5eff81379..20f3526d3a3 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -442,7 +442,7 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : library_rules lib ~cctx ~source_modules ~dir_contents ~compile_info in Buildable_rules.gen_select_rules sctx compile_info ~dir; - let merlin_ident = Merlin.make_lib_ident lib in - Buildable_rules.with_lib_deps ~merlin_ident + Buildable_rules.with_lib_deps (Super_context.context sctx) + (Merlin.make_lib_ident lib) compile_info ~dir ~f diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 7dbff603739..01920c5652d 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -12,7 +12,9 @@ module Extensions = Comparable.Make (struct let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn end) -let merlin_file_name = ".merlin-conf/" +type ident = string + +let merlin_folder_name = ".merlin-conf" let merlin_exist_name = ".merlin-exist" @@ -23,7 +25,7 @@ let make_exe_ident exes = Printf.sprintf "exe-%s" (String.concat ~sep:"-" (List.map ~f:snd exes.Dune_file.Executables.names)) -let make_merlin_exists ~ident = +let make_merlin_exists ident = String.concat ~sep:"-" [ merlin_exist_name; ident ] module Processed = struct @@ -308,10 +310,10 @@ end include Unprocessed -let dot_merlin sctx ~ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = +let dot_merlin sctx ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in - let merlin_file_name = merlin_file_name ^ ident in - let merlin_exist_name = make_merlin_exists ~ident in + let merlin_file_name = Filename.concat merlin_folder_name ident in + let merlin_exist_name = make_merlin_exists ident in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of @@ -335,6 +337,6 @@ let dot_merlin sctx ~ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = in SC.add_rule sctx ~dir action -let add_rules sctx ~ident ~dir ~more_src_dirs ~expander merlin = +let add_rules sctx ident ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then - dot_merlin sctx ~ident ~more_src_dirs ~expander ~dir merlin + dot_merlin sctx ident ~more_src_dirs ~expander ~dir merlin diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index ea34b72cdfa..d9af97ec892 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -10,17 +10,22 @@ open! Dune_engine open! Stdune open Import -(** Merlin config file base name *) -val merlin_file_name : string +(** Dune produces one-merlin file per stanza, whose name is the result of the + concatenation of base names and unique identifiers *) -(** Merlin exist file base name *) -val merlin_exist_name : string +type ident -val make_lib_ident : Dune_file.Library.t -> string +(** Merlin config folder name *) +val merlin_folder_name : string -val make_exe_ident : Dune_file.Executables.t -> string +(** Create a unique ident from a library stanza *) +val make_lib_ident : Dune_file.Library.t -> ident -val make_merlin_exists : ident:string -> string +(** Create a unique ident from an executables stanza *) +val make_exe_ident : Dune_file.Executables.t -> ident + +(** Return the name of the merlin file for a given ident *) +val make_merlin_exists : ident -> string (** Type of "unprocessed" merlin information *) type t @@ -54,7 +59,7 @@ val make : identified by [ident] in a directory *) val add_rules : Super_context.t - -> ident:string + -> ident -> dir:Path.Build.t -> more_src_dirs:Path.Source.t list -> expander:Expander.t diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index c05b3260015..b0a199c1127 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -55,7 +55,7 @@ let get_merlin_files_paths local_path = let ctx = Context_name.to_string context in let ctx_root = Path.Build.(relative root ctx) in let dir_path = Path.Build.(append_local ctx_root local_path) in - let merlin_path = Path.Build.relative dir_path Merlin.merlin_file_name in + let merlin_path = Path.Build.relative dir_path Merlin.merlin_folder_name in let files = Result.value ~default:[] (Path.readdir_unsorted (Path.build merlin_path)) |> List.fast_sort ~cmp:Stdlib.compare From 4f01776d26b26acce1de48287ff4214dd0e0b938 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 22 Oct 2020 18:16:30 +0200 Subject: [PATCH 17/36] More comments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 01920c5652d..ed1a3baa662 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -30,7 +30,10 @@ let make_merlin_exists ident = module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] - function from the unprocessed info gathered through [gen_rules]. *) + function from the unprocessed info gathered through [gen_rules]. The first + three fields map directly to Merlin's B, S and FLG directives and the last + one represents a list of preprocessors described by a preprocessing flag + and its arguments. *) type config = { obj_dirs : Path.Set.t ; src_dirs : Path.Set.t From 8c44d7befae9ba1dfea48a67795e03c6ce51be5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 23 Oct 2020 18:01:54 +0200 Subject: [PATCH 18/36] Deprecate `allow_approx_merlin` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_engine/dune_project.ml | 29 ++++++++++++++++------------- src/dune_engine/dune_project.mli | 2 -- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 503c60b5db7..291af965990 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -160,7 +160,6 @@ type t = ; implicit_transitive_deps : bool ; wrapped_executables : bool ; dune_version : Dune_lang.Syntax.Version.t - ; allow_approx_merlin : bool ; generate_opam_files : bool ; file_key : File_key.t ; dialects : Dialect.DB.t @@ -190,8 +189,6 @@ let file_key t = t.file_key let implicit_transitive_deps t = t.implicit_transitive_deps -let allow_approx_merlin t = t.allow_approx_merlin - let generate_opam_files t = t.generate_opam_files let dialects t = t.dialects @@ -211,7 +208,6 @@ let to_dyn ; implicit_transitive_deps ; wrapped_executables ; dune_version - ; allow_approx_merlin ; generate_opam_files ; file_key ; dialects @@ -233,7 +229,6 @@ let to_dyn ; ("implicit_transitive_deps", bool implicit_transitive_deps) ; ("wrapped_executables", bool wrapped_executables) ; ("dune_version", Dune_lang.Syntax.Version.to_dyn dune_version) - ; ("allow_approx_merlin", bool allow_approx_merlin) ; ("generate_opam_files", bool generate_opam_files) ; ("file_key", string file_key) ; ("dialects", Dialect.DB.to_dyn dialects) @@ -609,7 +604,6 @@ let infer ~dir packages = ; extension_args ; parsing_context ; dune_version = lang.version - ; allow_approx_merlin = true ; generate_opam_files = false ; file_key ; dialects = Dialect.DB.builtin @@ -669,9 +663,22 @@ let parse ~dir ~lang ~opam_packages ~file = and+ wrapped_executables = field_o_b "wrapped_executables" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11)) - and+ allow_approx_merlin = - field_o_b "allow_approximate_merlin" - ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9)) + and+ _allow_approx_merlin = + (* TODO DUNE3 remove this field from parsing *) + let+ loc = loc + and+ f = + field_o_b "allow_approximate_merlin" + ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9)) + in + if + Option.is_some f + && Dune_lang.Syntax.Version.Infix.(lang.version >= (2, 8)) + then + Dune_lang.Syntax.Warning.deprecated_in + ~extra_info: + "It is useless since the Merlin configurations are not ambiguous \ + anymore." + loc lang.syntax (2, 8) ~what:"This field" and+ () = Dune_lang.Versioned_file.no_more_lang and+ generate_opam_files = field_o_b "generate_opam_files" @@ -784,9 +791,6 @@ let parse ~dir ~lang ~opam_packages ~file = ~default:(strict_package_deps_default ~lang) in let dune_version = lang.version in - let allow_approx_merlin = - Option.value ~default:(dune_version < (1, 9)) allow_approx_merlin - in let explicit_js_mode = Option.value explicit_js_mode ~default:(explicit_js_mode_default ~lang) in @@ -819,7 +823,6 @@ let parse ~dir ~lang ~opam_packages ~file = ; implicit_transitive_deps ; wrapped_executables ; dune_version - ; allow_approx_merlin ; generate_opam_files ; dialects ; explicit_js_mode diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index 243e2e12efb..86573882cd3 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -63,8 +63,6 @@ val root : t -> Path.Source.t val stanza_parser : t -> Stanza.t list Dune_lang.Decoder.t -val allow_approx_merlin : t -> bool - val generate_opam_files : t -> bool val dialects : t -> Dialect.DB.t From add8359600f480d95af127cad7ba1e855e0e9431 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Sat, 24 Oct 2020 12:32:19 +0200 Subject: [PATCH 19/36] Remove uses of approx merlin in tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../private-public-overlap.t/private-rewriter/dune-project | 2 -- .../private-public-overlap.t/private-runtime-deps/dune-project | 2 -- 2 files changed, 4 deletions(-) diff --git a/test/blackbox-tests/test-cases/private-public-overlap.t/private-rewriter/dune-project b/test/blackbox-tests/test-cases/private-public-overlap.t/private-rewriter/dune-project index 7e0c68660a9..92de1220186 100644 --- a/test/blackbox-tests/test-cases/private-public-overlap.t/private-rewriter/dune-project +++ b/test/blackbox-tests/test-cases/private-public-overlap.t/private-rewriter/dune-project @@ -1,4 +1,2 @@ (lang dune 1.9) (name mylib) - -(allow_approximate_merlin true) diff --git a/test/blackbox-tests/test-cases/private-public-overlap.t/private-runtime-deps/dune-project b/test/blackbox-tests/test-cases/private-public-overlap.t/private-runtime-deps/dune-project index 7e0c68660a9..92de1220186 100644 --- a/test/blackbox-tests/test-cases/private-public-overlap.t/private-runtime-deps/dune-project +++ b/test/blackbox-tests/test-cases/private-public-overlap.t/private-runtime-deps/dune-project @@ -1,4 +1,2 @@ (lang dune 1.9) (name mylib) - -(allow_approximate_merlin true) From 7343503e17d0fd434655f186ca0fddbc40dc9cb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Sat, 24 Oct 2020 12:32:53 +0200 Subject: [PATCH 20/36] Add test for merlin approx deprecation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../deprecated-fields/d-allow-approx-merlin.t | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 test/blackbox-tests/test-cases/deprecated-fields/d-allow-approx-merlin.t diff --git a/test/blackbox-tests/test-cases/deprecated-fields/d-allow-approx-merlin.t b/test/blackbox-tests/test-cases/deprecated-fields/d-allow-approx-merlin.t new file mode 100644 index 00000000000..81b07500919 --- /dev/null +++ b/test/blackbox-tests/test-cases/deprecated-fields/d-allow-approx-merlin.t @@ -0,0 +1,16 @@ + $ cat >dune-project < (lang dune 2.7) + > (allow_approximate_merlin true) + + $ dune build @all + + $ cat >dune-project < (lang dune 2.8) + > (allow_approximate_merlin true) + + $ dune build @all + File "dune-project", line 2, characters 0-31: + 2 | (allow_approximate_merlin true) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning: This field was deprecated in version 2.8 of the dune language. It is + useless since the Merlin configurations are not ambiguous anymore. From e7b50e3fede4ae5fbfae60a5084ba910292e8ece Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 17 Nov 2020 18:46:01 +0100 Subject: [PATCH 21/36] Comment + shorter sprintf MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index ed1a3baa662..50d62ebd58f 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -19,10 +19,10 @@ let merlin_folder_name = ".merlin-conf" let merlin_exist_name = ".merlin-exist" let make_lib_ident lib = - Printf.sprintf "lib-%s" (Dune_file.Library.best_name lib |> Lib_name.to_string) + sprintf "lib-%s" (Dune_file.Library.best_name lib |> Lib_name.to_string) let make_exe_ident exes = - Printf.sprintf "exe-%s" + sprintf "exe-%s" (String.concat ~sep:"-" (List.map ~f:snd exes.Dune_file.Executables.names)) let make_merlin_exists ident = @@ -105,6 +105,7 @@ module Processed = struct String.Map.iteri ~f:(fun name config -> let sexp = to_sexp config in + (* TODO Switch to Pp *) Format.printf "@[%s@,%a@]@." name Sexp.pp sexp) t end From 70a4172650b186cbfd77d8c3e0884886e53f9293 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 17 Nov 2020 20:01:37 +0100 Subject: [PATCH 22/36] [WIP] Test vendoring causes Memo cycle MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_engine/dune_project.ml | 8 ++++++++ src/dune_engine/dune_project.mli | 2 ++ src/dune_engine/file_tree.ml | 4 ++++ 3 files changed, 14 insertions(+) diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 291af965990..4e311395e69 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -185,6 +185,8 @@ let stanza_parser t = t.stanza_parser let file t = t.project_file.file +let dir_status = Fdecl.create (fun _ -> Dyn.opaque) + let file_key t = t.file_key let implicit_transitive_deps t = t.implicit_transitive_deps @@ -670,9 +672,15 @@ let parse ~dir ~lang ~opam_packages ~file = field_o_b "allow_approximate_merlin" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9)) in + let vendored = + match (Fdecl.get dir_status) dir with + | Some Sub_dirs.Status.Vendored -> true + | _ -> false + in if Option.is_some f && Dune_lang.Syntax.Version.Infix.(lang.version >= (2, 8)) + && not vendored then Dune_lang.Syntax.Warning.deprecated_in ~extra_info: diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index 86573882cd3..32f04dcd140 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -51,6 +51,8 @@ end val to_dyn : t -> Dyn.t +val dir_status : (Path.Source.t -> Sub_dirs.Status.t option) Fdecl.t + val file_key : t -> File_key.t val packages : t -> Package.t Package.Name.Map.t diff --git a/src/dune_engine/file_tree.ml b/src/dune_engine/file_tree.ml index 2c2bb41dc0a..c1f11fb235f 100644 --- a/src/dune_engine/file_tree.ml +++ b/src/dune_engine/file_tree.ml @@ -781,3 +781,7 @@ let find_dir_specified_on_command_line ~dir = [ Pp.textf "Don't know about directory %s specified on the command line!" (Path.Source.to_string_maybe_quoted dir) ] + +let () = + Fdecl.set Dune_project.dir_status (fun dir -> + Option.map (find_dir dir) ~f:(fun d -> Dir.status d)) From 61477b3a9e2f2980ee90f44ef2198b9b71ce3c83 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 17 Nov 2020 14:33:19 -0800 Subject: [PATCH 23/36] Revert "[WIP] Test vendoring causes Memo cycle" This reverts commit b332ce9e2c8e253be0d3339c91ef6a7fa4dd4b3f. Signed-off-by: Rudi Grinberg --- src/dune_engine/dune_project.ml | 8 -------- src/dune_engine/dune_project.mli | 2 -- src/dune_engine/file_tree.ml | 4 ---- 3 files changed, 14 deletions(-) diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 4e311395e69..291af965990 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -185,8 +185,6 @@ let stanza_parser t = t.stanza_parser let file t = t.project_file.file -let dir_status = Fdecl.create (fun _ -> Dyn.opaque) - let file_key t = t.file_key let implicit_transitive_deps t = t.implicit_transitive_deps @@ -672,15 +670,9 @@ let parse ~dir ~lang ~opam_packages ~file = field_o_b "allow_approximate_merlin" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9)) in - let vendored = - match (Fdecl.get dir_status) dir with - | Some Sub_dirs.Status.Vendored -> true - | _ -> false - in if Option.is_some f && Dune_lang.Syntax.Version.Infix.(lang.version >= (2, 8)) - && not vendored then Dune_lang.Syntax.Warning.deprecated_in ~extra_info: diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index 32f04dcd140..86573882cd3 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -51,8 +51,6 @@ end val to_dyn : t -> Dyn.t -val dir_status : (Path.Source.t -> Sub_dirs.Status.t option) Fdecl.t - val file_key : t -> File_key.t val packages : t -> Package.t Package.Name.Map.t diff --git a/src/dune_engine/file_tree.ml b/src/dune_engine/file_tree.ml index c1f11fb235f..2c2bb41dc0a 100644 --- a/src/dune_engine/file_tree.ml +++ b/src/dune_engine/file_tree.ml @@ -781,7 +781,3 @@ let find_dir_specified_on_command_line ~dir = [ Pp.textf "Don't know about directory %s specified on the command line!" (Path.Source.to_string_maybe_quoted dir) ] - -let () = - Fdecl.set Dune_project.dir_status (fun dir -> - Option.map (find_dir dir) ~f:(fun d -> Dir.status d)) From 5b47e1d5b59f2707b95348bcaf6452bbafc6291b Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 17 Nov 2020 14:37:22 -0800 Subject: [PATCH 24/36] Add dir_status when creating dune_project necessary for handling warnings Signed-off-by: Rudi Grinberg --- src/dune_engine/dune_project.ml | 16 +++++++++++----- src/dune_engine/dune_project.mli | 1 + src/dune_engine/file_tree.ml | 5 +++-- src/dune_rules/dune_init.ml | 2 +- src/dune_rules/watermarks.ml | 7 ++++++- 5 files changed, 22 insertions(+), 9 deletions(-) diff --git a/src/dune_engine/dune_project.ml b/src/dune_engine/dune_project.ml index 291af965990..2dfeeb3ec93 100644 --- a/src/dune_engine/dune_project.ml +++ b/src/dune_engine/dune_project.ml @@ -641,7 +641,7 @@ end let anonymous ~dir = infer ~dir Package.Name.Map.empty -let parse ~dir ~lang ~opam_packages ~file = +let parse ~dir ~lang ~opam_packages ~file ~dir_status = fields (let+ name = field_o "name" Name.decode and+ version = field_o "version" string @@ -670,9 +670,15 @@ let parse ~dir ~lang ~opam_packages ~file = field_o_b "allow_approximate_merlin" ~check:(Dune_lang.Syntax.since Stanza.syntax (1, 9)) in + let vendored = + match dir_status with + | Sub_dirs.Status.Vendored -> true + | _ -> false + in if Option.is_some f && Dune_lang.Syntax.Version.Infix.(lang.version >= (2, 8)) + && not vendored then Dune_lang.Syntax.Warning.deprecated_in ~extra_info: @@ -831,12 +837,12 @@ let parse ~dir ~lang ~opam_packages ~file = ; cram }) -let load_dune_project ~dir opam_packages = +let load_dune_project ~dir opam_packages ~dir_status = let file = Path.Source.relative dir filename in load_exn (Path.source file) ~f:(fun lang -> - parse ~dir ~lang ~opam_packages ~file) + parse ~dir ~lang ~opam_packages ~file ~dir_status) -let load ~dir ~files ~infer_from_opam_files = +let load ~dir ~files ~infer_from_opam_files ~dir_status = let opam_packages = String.Set.fold files ~init:[] ~f:(fun fn acc -> match Package.Name.of_opam_file_basename fn with @@ -852,7 +858,7 @@ let load ~dir ~files ~infer_from_opam_files = |> Package.Name.Map.of_list_exn in if String.Set.mem files filename then - Some (load_dune_project ~dir opam_packages) + Some (load_dune_project ~dir opam_packages ~dir_status) else if Path.Source.is_root dir || (infer_from_opam_files && not (Package.Name.Map.is_empty opam_packages)) diff --git a/src/dune_engine/dune_project.mli b/src/dune_engine/dune_project.mli index 86573882cd3..f3580e0bcde 100644 --- a/src/dune_engine/dune_project.mli +++ b/src/dune_engine/dune_project.mli @@ -125,6 +125,7 @@ val load : dir:Path.Source.t -> files:String.Set.t -> infer_from_opam_files:bool + -> dir_status:Sub_dirs.Status.t -> t option (** Create an anonymous project with no package rooted at the given directory *) diff --git a/src/dune_engine/file_tree.ml b/src/dune_engine/file_tree.ml index 2c2bb41dc0a..5265e2c89b7 100644 --- a/src/dune_engine/file_tree.ml +++ b/src/dune_engine/file_tree.ml @@ -564,7 +564,7 @@ end = struct let project = match Dune_project.load ~dir:path ~files:readdir.files - ~infer_from_opam_files:true + ~infer_from_opam_files:true ~dir_status with | None -> Dune_project.anonymous ~dir:path | Some p -> p @@ -618,7 +618,8 @@ end = struct else Option.value (Dune_project.load ~dir:path ~files:readdir.files - ~infer_from_opam_files:settings.recognize_jbuilder_projects) + ~infer_from_opam_files:settings.recognize_jbuilder_projects + ~dir_status) ~default:parent_dir.project in let vcs = get_vcs ~default:parent_dir.vcs ~readdir ~path in diff --git a/src/dune_rules/dune_init.ml b/src/dune_rules/dune_init.ml index e298d895019..472e0cf9a6a 100644 --- a/src/dune_rules/dune_init.ml +++ b/src/dune_rules/dune_init.ml @@ -179,7 +179,7 @@ module Init_context = struct let project = match Dune_project.load ~dir:Path.Source.root ~files:String.Set.empty - ~infer_from_opam_files:true + ~infer_from_opam_files:true ~dir_status:Normal with | Some p -> p | None -> Dune_project.anonymous ~dir:Path.Source.root diff --git a/src/dune_rules/watermarks.ml b/src/dune_rules/watermarks.ml index 62b37dc5968..572905187dc 100644 --- a/src/dune_rules/watermarks.ml +++ b/src/dune_rules/watermarks.ml @@ -146,7 +146,12 @@ module Dune_project = struct let filename = Path.in_source Dune_project.filename let load ~dir ~files ~infer_from_opam_files = - let project = Dune_project.load ~dir ~files ~infer_from_opam_files in + let project = + (* XXX dir_status only affects warning status, but it will not matter + here. dune subst will fail with a hard error if the name is missing *) + let dir_status = Sub_dirs.Status.Normal in + Dune_project.load ~dir ~files ~infer_from_opam_files ~dir_status + in match project with | Some project -> let file = Dune_project.file project in From c5229a28a0809ce9299ad6b15c1f5b9a9ae9fc45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 18 Nov 2020 10:31:00 +0100 Subject: [PATCH 25/36] Add test for no warning in vendor MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../merlin/allow_approximate_merlin.t/dune-project | 1 + .../merlin/allow_approximate_merlin_warn.t/dune | 1 + .../allow_approximate_merlin_warn.t/dune-project | 2 ++ .../notvendor/dune-project | 2 ++ .../merlin/allow_approximate_merlin_warn.t/run.t | 13 +++++++++++++ .../vendor/dune-project | 2 ++ 6 files changed, 21 insertions(+) create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/notvendor/dune-project create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t create mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/vendor/dune-project diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project new file mode 100644 index 00000000000..e8b83749778 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project @@ -0,0 +1 @@ +(lang dune 2.6) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune new file mode 100644 index 00000000000..94865487d0e --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune @@ -0,0 +1 @@ +(vendored_dirs vendor) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project new file mode 100644 index 00000000000..01b4776ac95 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 2.8) +(allow_approximate_merlin) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/notvendor/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/notvendor/dune-project new file mode 100644 index 00000000000..01b4776ac95 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/notvendor/dune-project @@ -0,0 +1,2 @@ +(lang dune 2.8) +(allow_approximate_merlin) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t new file mode 100644 index 00000000000..dac5db4fc99 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t @@ -0,0 +1,13 @@ +The vendored project does not trigger a third warning. + + $ dune build @check + File "dune-project", line 2, characters 0-26: + 2 | (allow_approximate_merlin) + ^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning: This field was deprecated in version 2.8 of the dune language. It is + useless since the Merlin configurations are not ambiguous anymore. + File "notvendor/dune-project", line 2, characters 0-26: + 2 | (allow_approximate_merlin) + ^^^^^^^^^^^^^^^^^^^^^^^^^^ + Warning: This field was deprecated in version 2.8 of the dune language. It is + useless since the Merlin configurations are not ambiguous anymore. diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/vendor/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/vendor/dune-project new file mode 100644 index 00000000000..01b4776ac95 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/vendor/dune-project @@ -0,0 +1,2 @@ +(lang dune 2.8) +(allow_approximate_merlin) From 58395f39d8d958fe445dc9b9475489d4be25afea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 18 Nov 2020 14:26:10 +0100 Subject: [PATCH 26/36] Remove redundant dune-project in tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../test-cases/merlin/allow_approximate_merlin.t/dune-project | 1 - 1 file changed, 1 deletion(-) delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project deleted file mode 100644 index e8b83749778..00000000000 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune-project +++ /dev/null @@ -1 +0,0 @@ -(lang dune 2.6) From df1994a2964968ad72c54af6718a78f5ae3f1343 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 18 Nov 2020 14:39:35 +0100 Subject: [PATCH 27/36] Move merlin "ident" generation to `Lib.Compile.make` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/buildable_rules.ml | 7 +++-- src/dune_rules/buildable_rules.mli | 7 +---- src/dune_rules/exe_rules.ml | 7 ++--- src/dune_rules/gen_rules.ml | 15 +++++------ src/dune_rules/lib.ml | 9 +++++++ src/dune_rules/lib.mli | 2 ++ src/dune_rules/lib_rules.ml | 7 ++--- src/dune_rules/merlin.ml | 43 ++++++++++++++---------------- src/dune_rules/merlin.mli | 17 +++--------- 9 files changed, 54 insertions(+), 60 deletions(-) diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 3ee24c21462..6185b86014e 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -15,13 +15,16 @@ let gen_select_rules t ~dir compile_info = Build.fail { fail = (fun () -> raise e) } |> Build.with_targets ~targets:[ dst ] )) -let with_lib_deps (t : Context.t) merlin_ident compile_info ~dir ~f = +let with_lib_deps (t : Context.t) compile_info ~dir ~f = let prefix = Build.label (Lib_deps_info.Label (Lib.Compile.lib_deps_info compile_info)) in + let merlin_exists = + Merlin.make_merlin_exists (Lib.Compile.merlin_ident compile_info) + in let prefix = if t.merlin then - Path.Build.relative dir (Merlin.make_merlin_exists merlin_ident) + Path.Build.relative dir merlin_exists |> Path.build |> Build.path >>> prefix else prefix diff --git a/src/dune_rules/buildable_rules.mli b/src/dune_rules/buildable_rules.mli index 702a7e8213b..e90d2374499 100644 --- a/src/dune_rules/buildable_rules.mli +++ b/src/dune_rules/buildable_rules.mli @@ -16,9 +16,4 @@ val gen_select_rules : (** Generate the rules for the [(select ...)] forms in library dependencies *) val with_lib_deps : - Context.t - -> Merlin.ident - -> Lib.Compile.t - -> dir:Path.Build.t - -> f:(unit -> 'a) - -> 'a + Context.t -> Lib.Compile.t -> dir:Path.Build.t -> f:(unit -> 'a) -> 'a diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 6f89c28ca9f..96c68f1e41f 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -180,10 +180,12 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~promote:exes.promote ~embed_in_plugin_libraries in ( cctx - , Merlin.make () ~requires:requires_compile ~flags ~modules + , Merlin.make ~requires:requires_compile ~flags ~modules ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~obj_dir - ~dialects:(Dune_project.dialects (Scope.project scope)) ) + ~dialects:(Dune_project.dialects (Scope.project scope)) + ~ident:(Lib.Compile.merlin_ident compile_info) + () ) let compile_info ~scope (exes : Dune_file.Executables.t) = let dune_version = Scope.project scope |> Dune_project.dune_version in @@ -209,5 +211,4 @@ let rules ~sctx ~dir ~dir_contents ~scope ~expander Bootstrap_info.gen_rules sctx exes ~dir compile_info; Buildable_rules.with_lib_deps (Super_context.context sctx) - (Merlin.make_exe_ident exes) compile_info ~dir ~f diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 796431ad11d..a300d44e860 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -24,7 +24,7 @@ module For_stanza : sig -> dir_contents:Dir_contents.t -> expander:Expander.t -> files_to_install:(Install_conf.t -> unit) - -> ( (Merlin.ident * Merlin.t) list + -> ( Merlin.t list , (Loc.t * Compilation_context.t) list , Path.Build.t list , Path.Source.t list ) @@ -76,8 +76,7 @@ end = struct let cctx, merlin = Lib_rules.rules lib ~sctx ~dir ~scope ~dir_contents ~expander in - let merlin_ident = Merlin.make_lib_ident lib in - { merlin = Some (merlin_ident, merlin) + { merlin = Some merlin ; cctx = Some (lib.buildable.loc, cctx) ; js = None ; source_dirs = None @@ -90,8 +89,7 @@ end = struct let cctx, merlin = Exe_rules.rules exes ~sctx ~dir ~scope ~expander ~dir_contents in - let merlin_ident = Merlin.make_exe_ident exes in - { merlin = Some (merlin_ident, merlin) + { merlin = Some merlin ; cctx = Some (exes.buildable.loc, cctx) ; js = Some @@ -108,8 +106,7 @@ end = struct let cctx, merlin = Test_rules.rules tests ~sctx ~dir ~scope ~expander ~dir_contents in - let merlin_ident = Merlin.make_exe_ident tests.exes in - { merlin = Some (merlin_ident, merlin) + { merlin = Some merlin ; cctx = Some (tests.exes.buildable.loc, cctx) ; js = None ; source_dirs = None @@ -228,11 +225,11 @@ let gen_rules sctx dir_contents cctxs expander For_stanza.of_stanzas stanzas ~cctxs ~sctx ~src_dir ~ctx_dir ~scope ~dir_contents ~expander ~files_to_install in - List.iter merlins ~f:(fun (ident, merlin) -> + List.iter merlins ~f:(fun merlin -> let more_src_dirs = lib_src_dirs ~dir_contents |> List.rev_append source_dirs in - Merlin.add_rules sctx ident ~dir:ctx_dir ~more_src_dirs ~expander + Merlin.add_rules sctx ~dir:ctx_dir ~more_src_dirs ~expander (Merlin.add_source_dir merlin src_dir)); List.iter stanzas ~f:(fun stanza -> match (stanza : Stanza.t) with diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 28327652065..9fc36edfe51 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1615,6 +1615,7 @@ module Compile = struct ; resolved_selects : Resolved_select.t list ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t + ; name_for_merlin : string } let make_lib_deps_info ~user_written_deps ~pps ~kind = @@ -1662,12 +1663,14 @@ module Compile = struct >>= Resolve.compile_closure_with_overlap_checks db ~stack:Dep_stack.empty ~forbidden_libraries:Map.empty ) in + let name_for_merlin = sprintf "lib-%s" (Lib_name.to_string t.name) in { direct_requires = requires ; requires_link ; resolved_selects = t.resolved_selects ; pps = t.pps ; lib_deps_info ; sub_systems = t.sub_systems + ; name_for_merlin } let direct_requires t = t.direct_requires @@ -1680,6 +1683,8 @@ module Compile = struct let lib_deps_info t = t.lib_deps_info + let merlin_ident t = t.name_for_merlin + let sub_systems t = Sub_system_name.Map.values t.sub_systems |> List.map ~f:(fun (lazy (Sub_system0.Instance.T ((module M), t))) -> @@ -1831,12 +1836,16 @@ module DB = struct |> Result.map_error ~f:(fun e -> Dep_path.prepend_exn e (Executables exes))) in + let name_for_merlin = + sprintf "exe-%s" (String.concat ~sep:"-" (List.map ~f:snd exes)) + in { Compile.direct_requires = res ; requires_link ; pps ; resolved_selects ; lib_deps_info ; sub_systems = Sub_system_name.Map.empty + ; name_for_merlin } (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 4e1a112f7ac..29e85306cfd 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -143,6 +143,8 @@ module Compile : sig val lib_deps_info : t -> Lib_deps_info.t + val merlin_ident : t -> string + (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list end diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 20f3526d3a3..7c26e186741 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -420,10 +420,12 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ; compile_info }; ( cctx - , Merlin.make () ~requires:requires_compile ~flags ~modules + , Merlin.make ~requires:requires_compile ~flags ~modules ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~libname:(snd lib.name) ~obj_dir - ~dialects:(Dune_project.dialects (Scope.project scope)) ) + ~ident:(Lib.Compile.merlin_ident compile_info) + ~dialects:(Dune_project.dialects (Scope.project scope)) + () ) let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : Compilation_context.t * Merlin.t = @@ -444,5 +446,4 @@ let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : Buildable_rules.gen_select_rules sctx compile_info ~dir; Buildable_rules.with_lib_deps (Super_context.context sctx) - (Merlin.make_lib_ident lib) compile_info ~dir ~f diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 50d62ebd58f..58e67198104 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -1,7 +1,6 @@ open! Dune_engine open! Stdune open Import -open! No_io module SC = Super_context module Extensions = Comparable.Make (struct @@ -12,19 +11,10 @@ module Extensions = Comparable.Make (struct let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn end) -type ident = string - let merlin_folder_name = ".merlin-conf" let merlin_exist_name = ".merlin-exist" -let make_lib_ident lib = - sprintf "lib-%s" (Dune_file.Library.best_name lib |> Lib_name.to_string) - -let make_exe_ident exes = - sprintf "exe-%s" - (String.concat ~sep:"-" (List.map ~f:snd exes.Dune_file.Executables.names)) - let make_merlin_exists ident = String.concat ~sep:"-" [ merlin_exist_name; ident ] @@ -125,13 +115,19 @@ module Unprocessed = struct ; extensions : Extensions.Set.t } - type t = config Module_name.Map.t + type t = + { ident : string + ; configs : config Module_name.Map.t + } let add_source_dir t dir = - Module_name.Map.map t ~f:(fun cu_config -> - { cu_config with - source_dirs = Path.Source.Set.add cu_config.source_dirs dir - }) + { t with + configs = + Module_name.Map.map t.configs ~f:(fun cu_config -> + { cu_config with + source_dirs = Path.Source.Set.add cu_config.source_dirs dir + }) + } (* Since one merlin configuration per stanza is generated, merging should always be trivial *) @@ -139,7 +135,8 @@ module Unprocessed = struct let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ?libname - ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects () = + ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~ident + () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) let requires = match requires with @@ -189,7 +186,7 @@ module Unprocessed = struct ~f:(fun m -> (Module.name m, cu_config)) (Modules.impl_only modules) in - Module_name.Map.of_list_reduce modules ~f:merge_config + { ident; configs = Module_name.Map.of_list_reduce modules ~f:merge_config } let quote_if_needed s = if String.need_quoting s then @@ -314,10 +311,10 @@ end include Unprocessed -let dot_merlin sctx ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = +let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in - let merlin_file_name = Filename.concat merlin_folder_name ident in - let merlin_exist_name = make_merlin_exists ident in + let merlin_file_name = Filename.concat merlin_folder_name t.ident in + let merlin_exist_name = make_merlin_exists t.ident in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of @@ -334,13 +331,13 @@ let dot_merlin sctx ident ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = Path.Set.singleton (Path.build merlin_file) |> Rules.Produce.Alias.add_deps (Alias.check ~dir); - let merlin = Unprocessed.process sctx ~more_src_dirs ~expander t in + let merlin = Unprocessed.process sctx ~more_src_dirs ~expander t.configs in let action = Build.With_targets.write_file_dyn merlin_file (Build.With_targets.map ~f:Processed.Persist.to_string merlin) in SC.add_rule sctx ~dir action -let add_rules sctx ident ~dir ~more_src_dirs ~expander merlin = +let add_rules sctx ~dir ~more_src_dirs ~expander merlin = if (SC.context sctx).merlin then - dot_merlin sctx ident ~more_src_dirs ~expander ~dir merlin + dot_merlin sctx ~more_src_dirs ~expander ~dir merlin diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index d9af97ec892..606da4ea2f6 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -10,22 +10,11 @@ open! Dune_engine open! Stdune open Import -(** Dune produces one-merlin file per stanza, whose name is the result of the - concatenation of base names and unique identifiers *) - -type ident - (** Merlin config folder name *) val merlin_folder_name : string -(** Create a unique ident from a library stanza *) -val make_lib_ident : Dune_file.Library.t -> ident - -(** Create a unique ident from an executables stanza *) -val make_exe_ident : Dune_file.Executables.t -> ident - -(** Return the name of the merlin file for a given ident *) -val make_merlin_exists : ident -> string +(** Return the name of the merlin file for a given stanza *) +val make_merlin_exists : string -> string (** Type of "unprocessed" merlin information *) type t @@ -52,6 +41,7 @@ val make : -> modules:Modules.t -> obj_dir:Path.Build.t Obj_dir.t -> dialects:Dialect.DB.t + -> ident:string -> unit -> t @@ -59,7 +49,6 @@ val make : identified by [ident] in a directory *) val add_rules : Super_context.t - -> ident -> dir:Path.Build.t -> more_src_dirs:Path.Source.t list -> expander:Expander.t From d3db2bf864c0465795740e87c0ea6b7f9a5fec58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 19 Nov 2020 12:37:29 +0100 Subject: [PATCH 28/36] Move ident gen to merlin module and use polymorphic variant for type compatibility MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/exe_rules.ml | 2 +- src/dune_rules/lib.ml | 8 +++----- src/dune_rules/lib.mli | 2 +- src/dune_rules/lib_rules.ml | 2 +- src/dune_rules/merlin.ml | 24 +++++++++++++++++------- src/dune_rules/merlin.mli | 9 +++++++-- 6 files changed, 30 insertions(+), 17 deletions(-) diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 96c68f1e41f..3e40fe9387a 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -184,7 +184,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) - ~ident:(Lib.Compile.merlin_ident compile_info) + ~for_:(Lib.Compile.merlin_ident compile_info) () ) let compile_info ~scope (exes : Dune_file.Executables.t) = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 9fc36edfe51..927df11043a 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1615,7 +1615,7 @@ module Compile = struct ; resolved_selects : Resolved_select.t list ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t - ; name_for_merlin : string + ; name_for_merlin : [ `Lib of Lib_name.t | `Exes of string list ] } let make_lib_deps_info ~user_written_deps ~pps ~kind = @@ -1663,7 +1663,7 @@ module Compile = struct >>= Resolve.compile_closure_with_overlap_checks db ~stack:Dep_stack.empty ~forbidden_libraries:Map.empty ) in - let name_for_merlin = sprintf "lib-%s" (Lib_name.to_string t.name) in + let name_for_merlin = `Lib t.name in { direct_requires = requires ; requires_link ; resolved_selects = t.resolved_selects @@ -1836,9 +1836,7 @@ module DB = struct |> Result.map_error ~f:(fun e -> Dep_path.prepend_exn e (Executables exes))) in - let name_for_merlin = - sprintf "exe-%s" (String.concat ~sep:"-" (List.map ~f:snd exes)) - in + let name_for_merlin = `Exes (List.map ~f:snd exes) in { Compile.direct_requires = res ; requires_link ; pps diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 29e85306cfd..9682f05ed4d 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -143,7 +143,7 @@ module Compile : sig val lib_deps_info : t -> Lib_deps_info.t - val merlin_ident : t -> string + val merlin_ident : t -> [ `Lib of Lib_name.t | `Exes of string list ] (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 7c26e186741..260779de143 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -423,8 +423,8 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents , Merlin.make ~requires:requires_compile ~flags ~modules ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~libname:(snd lib.name) ~obj_dir - ~ident:(Lib.Compile.merlin_ident compile_info) ~dialects:(Dune_project.dialects (Scope.project scope)) + ~for_:(Lib.Compile.merlin_ident compile_info) () ) let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 58e67198104..726f41753fc 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -15,8 +15,17 @@ let merlin_folder_name = ".merlin-conf" let merlin_exist_name = ".merlin-exist" -let make_merlin_exists ident = - String.concat ~sep:"-" [ merlin_exist_name; ident ] +type for_ = + [ `Lib of Lib_name.t + | `Exes of string list + ] + +let make_ident = function + | `Lib name -> sprintf "lib-%s" (Lib_name.to_string name) + | `Exes names -> sprintf "exe-%s" (String.concat ~sep:"-" names) + +let make_merlin_exists for_ = + String.concat ~sep:"-" [ merlin_exist_name; make_ident for_ ] module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] @@ -116,7 +125,7 @@ module Unprocessed = struct } type t = - { ident : string + { for_ : for_ ; configs : config Module_name.Map.t } @@ -135,7 +144,7 @@ module Unprocessed = struct let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ?libname - ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~ident + ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~for_ () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) let requires = @@ -186,7 +195,7 @@ module Unprocessed = struct ~f:(fun m -> (Module.name m, cu_config)) (Modules.impl_only modules) in - { ident; configs = Module_name.Map.of_list_reduce modules ~f:merge_config } + { for_; configs = Module_name.Map.of_list_reduce modules ~f:merge_config } let quote_if_needed s = if String.need_quoting s then @@ -313,8 +322,9 @@ include Unprocessed let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in - let merlin_file_name = Filename.concat merlin_folder_name t.ident in - let merlin_exist_name = make_merlin_exists t.ident in + let ident = make_ident t.for_ in + let merlin_file_name = Filename.concat merlin_folder_name ident in + let merlin_exist_name = make_merlin_exists t.for_ in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 606da4ea2f6..b005992ebf9 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -10,11 +10,16 @@ open! Dune_engine open! Stdune open Import +type for_ = + [ `Lib of Lib_name.t + | `Exes of string list + ] + (** Merlin config folder name *) val merlin_folder_name : string (** Return the name of the merlin file for a given stanza *) -val make_merlin_exists : string -> string +val make_merlin_exists : for_ -> string (** Type of "unprocessed" merlin information *) type t @@ -41,7 +46,7 @@ val make : -> modules:Modules.t -> obj_dir:Path.Build.t Obj_dir.t -> dialects:Dialect.DB.t - -> ident:string + -> for_:for_ -> unit -> t From 03beecb0f153eeed46f38ad3864332464fc76fdb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 19 Nov 2020 15:04:53 +0100 Subject: [PATCH 29/36] Delete useless test and improve the one for warnings MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- .../merlin/allow_approximate_merlin.t/a.ml | 0 .../merlin/allow_approximate_merlin.t/b.ml | 0 .../merlin/allow_approximate_merlin.t/dune | 8 ------- .../merlin/allow_approximate_merlin.t/run.t | 21 ------------------- .../dune-project | 2 -- .../allow_approximate_merlin_warn.t/run.t | 10 ++++----- 6 files changed, 4 insertions(+), 37 deletions(-) delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/a.ml delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/b.ml delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t delete mode 100644 test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/a.ml b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/a.ml deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/b.ml b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/b.ml deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune deleted file mode 100644 index 2ea4a7195b9..00000000000 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/dune +++ /dev/null @@ -1,8 +0,0 @@ -(executable - (name a) - (modules a) - (preprocess future_syntax)) - -(executable - (name b) - (modules b)) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t deleted file mode 100644 index f74628a1ead..00000000000 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin.t/run.t +++ /dev/null @@ -1,21 +0,0 @@ -TODO this test is now obsolete - -If different options apply to two stanzas in the same directory, the .merlin -file is the union of the two and a warning is emitted. - -The output depends on dune-project. - -For lang >= 1.9, a warning is printed: - - $ echo '(lang dune 1.9)' > dune-project - $ dune build @check - -Indeed, adding this will suppress the warning: - - $ printf '(lang dune 1.9)\n(allow_approximate_merlin)\n' > dune-project - $ dune build @check - -However, the warning is not emitted if it is not fixable (#2399). - - $ echo '(lang dune 1.8)' > dune-project - $ dune build @check diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project deleted file mode 100644 index 01b4776ac95..00000000000 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/dune-project +++ /dev/null @@ -1,2 +0,0 @@ -(lang dune 2.8) -(allow_approximate_merlin) diff --git a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t index dac5db4fc99..1db51434377 100644 --- a/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/allow_approximate_merlin_warn.t/run.t @@ -1,11 +1,9 @@ -The vendored project does not trigger a third warning. +The vendored project does not trigger a third warning +When the root project is on dune lang <= 2.7 it does not raise a warning +However the non-vendored sub-dir on dune lang >= 2.8 does raise a warning + $ echo "(lang dune 2.7)\n (allow_approximate_merlin)" > dune-project $ dune build @check - File "dune-project", line 2, characters 0-26: - 2 | (allow_approximate_merlin) - ^^^^^^^^^^^^^^^^^^^^^^^^^^ - Warning: This field was deprecated in version 2.8 of the dune language. It is - useless since the Merlin configurations are not ambiguous anymore. File "notvendor/dune-project", line 2, characters 0-26: 2 | (allow_approximate_merlin) ^^^^^^^^^^^^^^^^^^^^^^^^^^ From 3076689bf834173ac9afde3f8c166d4dffae954c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Nov 2020 17:43:26 +0100 Subject: [PATCH 30/36] Move Merlin ident type to a separate module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/exe_rules.ml | 2 +- src/dune_rules/lib.ml | 12 ++++++------ src/dune_rules/lib.mli | 2 +- src/dune_rules/lib_rules.ml | 2 +- src/dune_rules/merlin.ml | 23 +++++++---------------- src/dune_rules/merlin.mli | 9 ++------- src/dune_rules/merlin_ident.ml | 14 ++++++++++++++ src/dune_rules/merlin_ident.mli | 9 +++++++++ 8 files changed, 41 insertions(+), 32 deletions(-) create mode 100644 src/dune_rules/merlin_ident.ml create mode 100644 src/dune_rules/merlin_ident.mli diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 3e40fe9387a..96c68f1e41f 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -184,7 +184,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) - ~for_:(Lib.Compile.merlin_ident compile_info) + ~ident:(Lib.Compile.merlin_ident compile_info) () ) let compile_info ~scope (exes : Dune_file.Executables.t) = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 927df11043a..defe1e00412 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -1615,7 +1615,7 @@ module Compile = struct ; resolved_selects : Resolved_select.t list ; lib_deps_info : Lib_deps_info.t ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t - ; name_for_merlin : [ `Lib of Lib_name.t | `Exes of string list ] + ; merlin_ident : Merlin_ident.t } let make_lib_deps_info ~user_written_deps ~pps ~kind = @@ -1663,14 +1663,14 @@ module Compile = struct >>= Resolve.compile_closure_with_overlap_checks db ~stack:Dep_stack.empty ~forbidden_libraries:Map.empty ) in - let name_for_merlin = `Lib t.name in + let merlin_ident = Merlin_ident.for_lib t.name in { direct_requires = requires ; requires_link ; resolved_selects = t.resolved_selects ; pps = t.pps ; lib_deps_info ; sub_systems = t.sub_systems - ; name_for_merlin + ; merlin_ident } let direct_requires t = t.direct_requires @@ -1683,7 +1683,7 @@ module Compile = struct let lib_deps_info t = t.lib_deps_info - let merlin_ident t = t.name_for_merlin + let merlin_ident t = t.merlin_ident let sub_systems t = Sub_system_name.Map.values t.sub_systems @@ -1836,14 +1836,14 @@ module DB = struct |> Result.map_error ~f:(fun e -> Dep_path.prepend_exn e (Executables exes))) in - let name_for_merlin = `Exes (List.map ~f:snd exes) in + let merlin_ident = Merlin_ident.for_exes ~names:(List.map ~f:snd exes) in { Compile.direct_requires = res ; requires_link ; pps ; resolved_selects ; lib_deps_info ; sub_systems = Sub_system_name.Map.empty - ; name_for_merlin + ; merlin_ident } (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index 9682f05ed4d..fdac40a808c 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -143,7 +143,7 @@ module Compile : sig val lib_deps_info : t -> Lib_deps_info.t - val merlin_ident : t -> [ `Lib of Lib_name.t | `Exes of string list ] + val merlin_ident : t -> Merlin_ident.t (** Sub-systems used in this compilation context *) val sub_systems : t -> sub_system list diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 260779de143..56b3a5eba4b 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -424,7 +424,7 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ~preprocess:(Preprocess.Per_module.single_preprocess preprocess) ~libname:(snd lib.name) ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) - ~for_:(Lib.Compile.merlin_ident compile_info) + ~ident:(Lib.Compile.merlin_ident compile_info) () ) let rules (lib : Library.t) ~sctx ~dir_contents ~dir ~expander ~scope : diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 726f41753fc..ae25c18832f 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -15,17 +15,8 @@ let merlin_folder_name = ".merlin-conf" let merlin_exist_name = ".merlin-exist" -type for_ = - [ `Lib of Lib_name.t - | `Exes of string list - ] - -let make_ident = function - | `Lib name -> sprintf "lib-%s" (Lib_name.to_string name) - | `Exes names -> sprintf "exe-%s" (String.concat ~sep:"-" names) - -let make_merlin_exists for_ = - String.concat ~sep:"-" [ merlin_exist_name; make_ident for_ ] +let make_merlin_exists ident = + String.concat ~sep:"-" [ merlin_exist_name; Merlin_ident.to_string ident ] module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] @@ -125,7 +116,7 @@ module Unprocessed = struct } type t = - { for_ : for_ + { ident : Merlin_ident.t ; configs : config Module_name.Map.t } @@ -144,7 +135,7 @@ module Unprocessed = struct let make ?(requires = Ok []) ~flags ?(preprocess = Preprocess.No_preprocessing) ?libname - ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~for_ + ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~ident () = (* Merlin shouldn't cause the build to fail, so we just ignore errors *) let requires = @@ -195,7 +186,7 @@ module Unprocessed = struct ~f:(fun m -> (Module.name m, cu_config)) (Modules.impl_only modules) in - { for_; configs = Module_name.Map.of_list_reduce modules ~f:merge_config } + { ident; configs = Module_name.Map.of_list_reduce modules ~f:merge_config } let quote_if_needed s = if String.need_quoting s then @@ -322,9 +313,9 @@ include Unprocessed let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in - let ident = make_ident t.for_ in + let ident = Merlin_ident.to_string t.ident in let merlin_file_name = Filename.concat merlin_folder_name ident in - let merlin_exist_name = make_merlin_exists t.for_ in + let merlin_exist_name = make_merlin_exists t.ident in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index b005992ebf9..bf79fa8462b 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -10,16 +10,11 @@ open! Dune_engine open! Stdune open Import -type for_ = - [ `Lib of Lib_name.t - | `Exes of string list - ] - (** Merlin config folder name *) val merlin_folder_name : string (** Return the name of the merlin file for a given stanza *) -val make_merlin_exists : for_ -> string +val make_merlin_exists : Merlin_ident.t -> string (** Type of "unprocessed" merlin information *) type t @@ -46,7 +41,7 @@ val make : -> modules:Modules.t -> obj_dir:Path.Build.t Obj_dir.t -> dialects:Dialect.DB.t - -> for_:for_ + -> ident:Merlin_ident.t -> unit -> t diff --git a/src/dune_rules/merlin_ident.ml b/src/dune_rules/merlin_ident.ml new file mode 100644 index 00000000000..9140788ba5d --- /dev/null +++ b/src/dune_rules/merlin_ident.ml @@ -0,0 +1,14 @@ +open Dune_engine +open Import + +type t = + | Lib of Lib_name.t + | Exes of string list + +let for_lib l = Lib l + +let for_exes ~names = Exes names + +let to_string = function + | Lib name -> sprintf "lib-%s" (Lib_name.to_string name) + | Exes names -> sprintf "exe-%s" (String.concat ~sep:"-" names) diff --git a/src/dune_rules/merlin_ident.mli b/src/dune_rules/merlin_ident.mli new file mode 100644 index 00000000000..ac91bd9234f --- /dev/null +++ b/src/dune_rules/merlin_ident.mli @@ -0,0 +1,9 @@ +(** Merlin identifiers allow the unique identification of a merlin file attached + to a specific [library] or [executable] stanza. *) +type t + +val for_lib : Dune_engine.Lib_name.t -> t + +val for_exes : names:string list -> t + +val to_string : t -> string From f148734fdf6db286d563ac8c5ab5c1730f540a37 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 25 Nov 2020 13:59:48 +0100 Subject: [PATCH 31/36] Refactor `merlin_exists_name` and mov to `Merlin_ident` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/buildable_rules.ml | 6 ++---- src/dune_rules/merlin.ml | 9 ++------- src/dune_rules/merlin.mli | 3 --- src/dune_rules/merlin_ident.ml | 6 ++++++ src/dune_rules/merlin_ident.mli | 5 +++++ 5 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/dune_rules/buildable_rules.ml b/src/dune_rules/buildable_rules.ml index 6185b86014e..751455a9132 100644 --- a/src/dune_rules/buildable_rules.ml +++ b/src/dune_rules/buildable_rules.ml @@ -19,12 +19,10 @@ let with_lib_deps (t : Context.t) compile_info ~dir ~f = let prefix = Build.label (Lib_deps_info.Label (Lib.Compile.lib_deps_info compile_info)) in - let merlin_exists = - Merlin.make_merlin_exists (Lib.Compile.merlin_ident compile_info) - in let prefix = if t.merlin then - Path.Build.relative dir merlin_exists + Merlin_ident.merlin_exists_path dir + (Lib.Compile.merlin_ident compile_info) |> Path.build |> Build.path >>> prefix else prefix diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index ae25c18832f..11e06df9e7e 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -13,11 +13,6 @@ end) let merlin_folder_name = ".merlin-conf" -let merlin_exist_name = ".merlin-exist" - -let make_merlin_exists ident = - String.concat ~sep:"-" [ merlin_exist_name; Merlin_ident.to_string ident ] - module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] function from the unprocessed info gathered through [gen_rules]. The first @@ -315,7 +310,7 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in let ident = Merlin_ident.to_string t.ident in let merlin_file_name = Filename.concat merlin_folder_name ident in - let merlin_exist_name = make_merlin_exists t.ident in + let merlin_exist = Merlin_ident.merlin_exists_path dir t.ident in let merlin_file = Path.Build.relative dir merlin_file_name in (* We make the compilation of .ml/.mli files depend on the existence of @@ -327,7 +322,7 @@ let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = of a file, so we have to use this trick. *) SC.add_rule sctx ~dir ( Build.with_no_targets (Build.path (Path.build merlin_file)) - >>> Build.create_file (Path.Build.relative dir merlin_exist_name) ); + >>> Build.create_file merlin_exist ); Path.Set.singleton (Path.build merlin_file) |> Rules.Produce.Alias.add_deps (Alias.check ~dir); diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index bf79fa8462b..b3460251511 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -13,9 +13,6 @@ open Import (** Merlin config folder name *) val merlin_folder_name : string -(** Return the name of the merlin file for a given stanza *) -val make_merlin_exists : Merlin_ident.t -> string - (** Type of "unprocessed" merlin information *) type t diff --git a/src/dune_rules/merlin_ident.ml b/src/dune_rules/merlin_ident.ml index 9140788ba5d..ac929d536be 100644 --- a/src/dune_rules/merlin_ident.ml +++ b/src/dune_rules/merlin_ident.ml @@ -12,3 +12,9 @@ let for_exes ~names = Exes names let to_string = function | Lib name -> sprintf "lib-%s" (Lib_name.to_string name) | Exes names -> sprintf "exe-%s" (String.concat ~sep:"-" names) + +let merlin_exist_name = ".merlin-exist" + +let merlin_exists_path path ident = + String.concat ~sep:"-" [ merlin_exist_name; to_string ident ] + |> Path.Build.relative path diff --git a/src/dune_rules/merlin_ident.mli b/src/dune_rules/merlin_ident.mli index ac91bd9234f..7b7d8d03167 100644 --- a/src/dune_rules/merlin_ident.mli +++ b/src/dune_rules/merlin_ident.mli @@ -1,3 +1,5 @@ +open! Stdune + (** Merlin identifiers allow the unique identification of a merlin file attached to a specific [library] or [executable] stanza. *) type t @@ -7,3 +9,6 @@ val for_lib : Dune_engine.Lib_name.t -> t val for_exes : names:string list -> t val to_string : t -> string + +(** Return the path of the merlin_exist file for a given stanza *) +val merlin_exists_path : Path.Build.t -> t -> Path.Build.t From c84e53ef91665ded3a51adc59592e7fa7d933367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 25 Nov 2020 14:17:23 +0100 Subject: [PATCH 32/36] Move `merlin_file_path` to `Merlin_ident` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin.ml | 6 +----- src/dune_rules/merlin.mli | 3 --- src/dune_rules/merlin_ident.ml | 6 ++++++ src/dune_rules/merlin_ident.mli | 6 +++++- src/dune_rules/merlin_server.ml | 4 +++- 5 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 11e06df9e7e..9c38211af23 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -11,8 +11,6 @@ module Extensions = Comparable.Make (struct let to_dyn = Tuple.T2.to_dyn String.to_dyn String.to_dyn end) -let merlin_folder_name = ".merlin-conf" - module Processed = struct (* The actual content of the merlin file as built by the [Unprocessed.process] function from the unprocessed info gathered through [gen_rules]. The first @@ -308,10 +306,8 @@ include Unprocessed let dot_merlin sctx ~dir ~more_src_dirs ~expander (t : Unprocessed.t) = let open Build.With_targets.O in - let ident = Merlin_ident.to_string t.ident in - let merlin_file_name = Filename.concat merlin_folder_name ident in let merlin_exist = Merlin_ident.merlin_exists_path dir t.ident in - let merlin_file = Path.Build.relative dir merlin_file_name in + let merlin_file = Merlin_ident.merlin_file_path dir t.ident in (* We make the compilation of .ml/.mli files depend on the existence of .merlin so that they are always generated, however the command themselves diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index b3460251511..a31c27731da 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -10,9 +10,6 @@ open! Dune_engine open! Stdune open Import -(** Merlin config folder name *) -val merlin_folder_name : string - (** Type of "unprocessed" merlin information *) type t diff --git a/src/dune_rules/merlin_ident.ml b/src/dune_rules/merlin_ident.ml index ac929d536be..665c1726636 100644 --- a/src/dune_rules/merlin_ident.ml +++ b/src/dune_rules/merlin_ident.ml @@ -15,6 +15,12 @@ let to_string = function let merlin_exist_name = ".merlin-exist" +let merlin_folder_name = ".merlin-conf" + let merlin_exists_path path ident = String.concat ~sep:"-" [ merlin_exist_name; to_string ident ] |> Path.Build.relative path + +let merlin_file_path path ident = + Filename.concat merlin_folder_name (to_string ident) + |> Path.Build.relative path diff --git a/src/dune_rules/merlin_ident.mli b/src/dune_rules/merlin_ident.mli index 7b7d8d03167..caaf0b257a4 100644 --- a/src/dune_rules/merlin_ident.mli +++ b/src/dune_rules/merlin_ident.mli @@ -8,7 +8,11 @@ val for_lib : Dune_engine.Lib_name.t -> t val for_exes : names:string list -> t -val to_string : t -> string +(** Merlin config folder name *) +val merlin_folder_name : string (** Return the path of the merlin_exist file for a given stanza *) val merlin_exists_path : Path.Build.t -> t -> Path.Build.t + +(** Return the path of the merlin file for a given stanza *) +val merlin_file_path : Path.Build.t -> t -> Path.Build.t diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index b0a199c1127..0e28f01815e 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -55,7 +55,9 @@ let get_merlin_files_paths local_path = let ctx = Context_name.to_string context in let ctx_root = Path.Build.(relative root ctx) in let dir_path = Path.Build.(append_local ctx_root local_path) in - let merlin_path = Path.Build.relative dir_path Merlin.merlin_folder_name in + let merlin_path = + Path.Build.relative dir_path Merlin_ident.merlin_folder_name + in let files = Result.value ~default:[] (Path.readdir_unsorted (Path.build merlin_path)) |> List.fast_sort ~cmp:Stdlib.compare From ef45bba0343993b626a64f75b1d9f3f2ced9b971 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 25 Nov 2020 14:56:35 +0100 Subject: [PATCH 33/36] Multiple `Merlin_server` tweaks MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- src/dune_rules/merlin_server.ml | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/dune_rules/merlin_server.ml b/src/dune_rules/merlin_server.ml index 0e28f01815e..366892c1001 100644 --- a/src/dune_rules/merlin_server.ml +++ b/src/dune_rules/merlin_server.ml @@ -42,8 +42,8 @@ let to_local abs_file_path = in match path_opt with | Some path -> ( - try Ok Path.(Filename.concat "." path |> of_string |> local_part) - with _ -> Printf.sprintf "Could not resolve path %s" path |> error ) + try Ok (Filename.concat "." path |> Path.Local.of_string) + with User_error.E mess -> User_message.to_string mess |> error ) | None -> Printf.sprintf "Path is not in dune workspace %s" abs_file_path |> error @@ -65,9 +65,6 @@ let get_merlin_files_paths local_path = List.map files ~f:(fun f -> Path.Build.relative merlin_path f |> Path.build) let load_merlin_file local_path file = - let no_config_error () = - Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" - in (* We search for an appropriate merlin configuration in the current directory and its parents *) let rec find_closest path = @@ -76,23 +73,25 @@ let load_merlin_file local_path file = let result = List.find_map file_paths ~f:(fun file_path -> if Path.exists file_path then - match Merlin.Processed.load_file file_path with - | Some config -> Merlin.Processed.get config ~filename - | None -> None + let open Option.O in + let* config = Merlin.Processed.load_file file_path in + Merlin.Processed.get config ~filename else None) in match result with | Some p -> Some p | None -> - Option.bind + Option.bind ~f:find_closest ( if Path.Local.is_root path then None else Path.Local.parent path ) - ~f:find_closest in - Option.value (find_closest local_path) ~default:(no_config_error ()) + let default = + Merlin_conf.make_error "Project isn't built. (Try calling `dune build`.)" + in + Option.value (find_closest local_path) ~default let print_merlin_conf file = let abs_root, file = Filename.(dirname file, basename file) in From 1c1476778923ff7fe81859302e3fd9011b0fad04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 25 Nov 2020 15:20:15 +0100 Subject: [PATCH 34/36] Add Changelog entry MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- CHANGES.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 91eba8e40c6..3cd9de7ed18 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -97,6 +97,10 @@ Unreleased preprocessing, to let merlin know of additional file extensions (#3977, @vouillon) +- Stop promoting `.merlin` files. Write per-stanza Merlin configurations in + binary form. Add a new subcommand `dune ocaml-merlin` that Merlin can use to + query the configuration files. (#3554, @voodoos) + 2.7.1 (2/09/2020) ----------------- From 83550c16eeb6e8af15534e531c9800033fb0541f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 30 Nov 2020 13:28:51 +0100 Subject: [PATCH 35/36] Update tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- test/blackbox-tests/test-cases/merlin/suffix.t/run.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/blackbox-tests/test-cases/merlin/suffix.t/run.t b/test/blackbox-tests/test-cases/merlin/suffix.t/run.t index f688a79955e..490120298a2 100644 --- a/test/blackbox-tests/test-cases/merlin/suffix.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/suffix.t/run.t @@ -1,5 +1,5 @@ $ dune build @check - $ cat .merlin | grep SUFFIX - SUFFIX .aml .amli - SUFFIX .baml .bamli + $ dune ocaml-merlin --dump-config=$(pwd) | grep SUFFIX + (SUFFIX ".aml .amli") + (SUFFIX ".baml .bamli")) From 9dc5e548a88fc7cff9d2c0f30d30ec4b0d49f2d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 30 Nov 2020 17:28:37 +0100 Subject: [PATCH 36/36] Edit changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ulysse Gérard --- CHANGES.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 3cd9de7ed18..ff267c5f3e4 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -99,7 +99,8 @@ Unreleased - Stop promoting `.merlin` files. Write per-stanza Merlin configurations in binary form. Add a new subcommand `dune ocaml-merlin` that Merlin can use to - query the configuration files. (#3554, @voodoos) + query the configuration files. The `allow_approximate_merlin` option is now + useless and deprecated. (#3554, @voodoos) 2.7.1 (2/09/2020) -----------------