diff --git a/CHANGES.md b/CHANGES.md index fbe09a20b7..7602212bb8 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,6 +3,8 @@ unreleased + merlin binary - Support for OCaml 5.3 + - Use new 5.3 features to improve locate behavior in some cases. Merlin no + longer confuses uids from interfaces and implementations. (#1857) + vim plugin - Added support for search-by-type (#1846) This is exposed through the existing `:MerlinSearch` command, that diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index a91e37b4a6..8c6294e3ef 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -33,7 +33,10 @@ let last_location = ref Location.none let { Logger.log } = Logger.for_section "locate" type config = - { mconfig : Mconfig.t; ml_or_mli : [ `ML | `MLI ]; traverse_aliases : bool } + { mconfig : Mconfig.t; + ml_or_mli : [ `ML | `Smart | `MLI ]; + traverse_aliases : bool + } type result = { uid : Shape.Uid.t; @@ -66,6 +69,8 @@ module File : sig val explain_not_found : ?doc_from:string -> string -> t -> [> `File_not_found of string ] + + val is_source : t -> bool end = struct type t = | ML of string @@ -143,10 +148,14 @@ end = struct str_ident in `File_not_found msg + + let is_source = function + | ML _ | MLL _ | MLI _ -> true + | CMT _ | CMTI _ -> false end module Preferences : sig - val set : [ `ML | `MLI ] -> unit + val set : [ `ML | `Smart | `MLI ] -> unit val src : string -> File.t val build : string -> File.t @@ -158,7 +167,7 @@ end = struct let set choice = prioritize_impl := match choice with - | `ML -> true + | `ML | `Smart -> true | _ -> false let src file = if !prioritize_impl then File.ml file else File.mli file @@ -251,7 +260,15 @@ module Utils = struct List.dedup_adjacent files ~cmp:String.compare let find_file_with_path ~config ?(with_fallback = false) file path = - if File.name file = Misc.unitname Mconfig.(config.query.filename) then + let title = "find_file_with_path" in + let filename = File.name file in + log ~title "Try find %S" filename; + if + File.is_source file + && filename = Misc.unitname Mconfig.(config.query.filename) + then + (* No need to search when looking for the source of the current buffer's + compilation unit *) Some Mconfig.(config.query.filename) else let attempt_search src_suffix_pair = @@ -261,6 +278,7 @@ module Utils = struct else None in let fname = File.with_ext ~src_suffix_pair file in + log ~title "Trying %S" fname; try Some (Misc.find_in_path_normalized ?fallback path fname) with Not_found -> None in @@ -305,10 +323,12 @@ let move_to filename cmt_infos = File_switching.move_to ~digest filename let load_cmt ~config ?(with_fallback = true) comp_unit = + let title = "load_cmt" in Preferences.set config.ml_or_mli; let file = Preferences.build comp_unit in match Utils.find_file ~config:config.mconfig ~with_fallback file with | Some path -> + log ~title "Found %S at path %S" comp_unit path; let cmt_infos = (Cmt_cache.read path).cmt_infos in let source_file = cmt_infos.cmt_sourcefile in let source_file = Option.value ~default:"*pack*" source_file in @@ -337,8 +357,8 @@ let scrape_alias ~env ~fallback_uid ~namespace path = when namespace = Shape.Sig_component_kind.Module_type -> (* This case is necessary to traverse module type aliases *) non_alias_declaration_uid ~fallback_uid alias_path - | _, md_uid -> md_uid - | exception Not_found -> fallback_uid + | _, md_uid -> (path, md_uid) + | exception Not_found -> (path, fallback_uid) in non_alias_declaration_uid ~fallback_uid path @@ -481,21 +501,31 @@ let find_source ~config loc path = doesn't know which is the right one: %s" matches) -(** [find_loc_of_uid] uid's location are given by tables stored int he cmt files - for external compilation units or computed by Merlin for the current buffer. - This function lookups a uid's location in the appropriate table. *) -let find_loc_of_uid ~config ~local_defs uid comp_unit = - let title = "find_loc_of_uid" in - let loc_of_decl ~uid def = - match Typedtree_utils.location_of_declaration ~uid def with - | Some loc -> - log ~title "Found location: %a" Logger.fmt (fun fmt -> - Location.print_loc fmt loc.loc); - `Some (uid, loc.loc) - | None -> - log ~title "The declaration has no location."; - `None +let lookup_uid_decl ~config:mconfig uid = + let title = "lookup_uid_decl" in + let item = + match uid with + | Shape.Uid.Internal | Predef _ | Compilation_unit _ -> None + | Item { from = Intf; comp_unit; _ } -> Some (`MLI, comp_unit) + | Item { from = _; comp_unit; _ } -> Some (`ML, comp_unit) in + Option.bind item ~f:(fun (ml_or_mli, comp_unit) -> + let config = { mconfig; ml_or_mli; traverse_aliases = false } in + match load_cmt ~config comp_unit with + | Ok (_pos_fname, cmt) -> + log ~title "Cmt successfully loaded, looking for %a" Logger.fmt + (fun fmt -> Shape.Uid.print fmt uid); + Shape.Uid.Tbl.find_opt cmt.cmt_uid_to_decl uid + | _ -> + log ~title "Failed to load the cmt file"; + None) + +(** uid's location are given by tables stored int he cmt files for external + compilation units or computed by Merlin for the current buffer. + [find_loc_of_uid] function lookups a uid's location in the appropriate + table. *) +let find_loc_of_item ~config ~local_defs uid comp_unit = + let title = "find_loc_of_uid" in if Env.get_current_unit_name () = comp_unit then begin log ~title "We look for %a in the current compilation unit." Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); @@ -503,28 +533,14 @@ let find_loc_of_uid ~config ~local_defs uid comp_unit = Shape.Uid.print fmt uid); let tbl = Ast_iterators.build_uid_to_locs_tbl ~local_defs () in match Shape.Uid.Tbl.find_opt tbl uid with - | Some { Location.loc; _ } -> `Some (uid, loc) + | Some loc -> Some loc | None -> log ~title "Uid not found in the local table."; - `None - end - else begin - log ~title "Loading the cmt file for unit %S" comp_unit; - match load_cmt ~config comp_unit with - | Ok (_pos_fname, cmt) -> - log ~title "Shapes successfully loaded, looking for %a" Logger.fmt - (fun fmt -> Shape.Uid.print fmt uid); - begin - match Shape.Uid.Tbl.find_opt cmt.cmt_uid_to_decl uid with - | Some decl -> loc_of_decl ~uid decl - | None -> - log ~title "Uid not found in the cmt's table."; - `None - end - | _ -> - log ~title "Failed to load the cmt file"; - `None + None end + else + lookup_uid_decl ~config:config.mconfig uid + |> Option.bind ~f:(Typedtree_utils.location_of_declaration ~uid) let find_loc_of_comp_unit ~config uid comp_unit = let title = "find_loc_of_comp_unit" in @@ -538,6 +554,43 @@ let find_loc_of_comp_unit ~config uid comp_unit = log ~title "Failed to load the CU's cmt"; `None +let find_loc_of_uid ~config ~local_defs ~ident ?fallback (uid : Shape.Uid.t) = + let find_loc_of_item ~comp_unit = + match (find_loc_of_item ~config ~local_defs uid comp_unit, fallback) with + | Some { loc; txt }, _ when String.equal txt ident -> + (* Checking the ident prevent returning nonsensical results when some uid + were swaped but the cmt files were not rebuilt. *) + Some (uid, loc) + | (Some _ | None), Some fallback -> + find_loc_of_item ~config ~local_defs fallback comp_unit + |> Option.map ~f:(fun { Location.loc; _ } -> (fallback, loc)) + | _ -> None + in + match uid with + | Predef s -> `Builtin (uid, s) + | Internal -> `Builtin (uid, "") + | Item { comp_unit; _ } -> `Opt (find_loc_of_item ~comp_unit) + | Compilation_unit comp_unit -> find_loc_of_comp_unit ~config uid comp_unit + +let get_linked_uids ~config ~comp_unit decl_uid = + let title = "linked_uids" in + log ~title "Try find cmt file for %s" comp_unit; + match load_cmt ~config comp_unit with + | Ok (_pos_fname, cmt) -> + log ~title "Cmt successfully loaded, looking for %a" Logger.fmt (fun fmt -> + Shape.Uid.print fmt decl_uid); + List.filter_map + ~f:(function + | Cmt_format.Definition_to_declaration, def, decl when decl = decl_uid + -> Some def + | Cmt_format.Definition_to_declaration, def, decl when def = decl_uid -> + Some decl + | _ -> None) + cmt.cmt_declaration_dependencies + | _ -> + log ~title "Failed to load the cmt file"; + [] + let find_definition_uid ~config ~env ~(decl : Env_lookup.item) path = let namespace = decl.namespace in let module Reduce = Shape_reduce.Make (struct @@ -589,24 +642,27 @@ let rec uid_of_result ~traverse_aliases = function let from_path ~config ~env ~local_defs ~decl path = let title = "from_path" in let unalias (decl : Env_lookup.item) = - if not config.traverse_aliases then decl.uid + if not config.traverse_aliases then (path, decl.uid) else let namespace = decl.namespace in - let uid = scrape_alias ~fallback_uid:decl.uid ~env ~namespace path in + let path, uid = + scrape_alias ~fallback_uid:decl.uid ~env ~namespace path + in if uid <> decl.uid then log ~title:"uid_of_path" "Unaliased declaration uid: %a -> %a" Logger.fmt (Fun.flip Shape.Uid.print decl.uid) Logger.fmt (Fun.flip Shape.Uid.print uid); - uid + (path, uid) in (* Step 1: Path => Uid *) - let decl : Env_lookup.item = { decl with uid = unalias decl } in + let path, uid = unalias decl in + let decl : Env_lookup.item = { decl with uid } in let uid, approximated = match config.ml_or_mli with | `MLI -> (decl.uid, false) - | `ML -> ( + | `ML | `Smart -> ( let traverse_aliases = config.traverse_aliases in let result = find_definition_uid ~config ~env ~decl path in match uid_of_result ~traverse_aliases result with @@ -617,25 +673,36 @@ let from_path ~config ~env ~local_defs ~decl path = (Fun.flip Shape.Uid.print decl.uid); (decl.uid, true)) in + (* Step 1': Try refine Uid *) + let impl_uid = + (* When looking for a definition but stuck on an interface we load the + corresponding cmt file to try to find a corresponding definition. *) + match (uid, config.ml_or_mli) with + | Item { from = Intf; comp_unit; _ }, `Smart -> ( + match get_linked_uids ~config ~comp_unit uid with + | [ uid ] -> Some uid + | _ -> None) + | _ -> None + in (* Step 2: Uid => Location *) let loc = - match uid with - | Predef s -> `Builtin (uid, s) - | Internal -> `Builtin (uid, "") - | Item { comp_unit; _ } -> find_loc_of_uid ~config ~local_defs uid comp_unit - | Compilation_unit comp_unit -> find_loc_of_comp_unit ~config uid comp_unit + let ident = Path.last path in + match impl_uid with + | Some impl_uid -> + find_loc_of_uid ~config ~local_defs ~ident ~fallback:uid impl_uid + | None -> find_loc_of_uid ~config ~local_defs ~ident uid in let loc = match loc with - | `None -> + | `None | `Opt None -> log ~title "Falling back to the declaration's location: %a" Logger.fmt (Fun.flip Location.print_loc decl.loc); `Some (decl.uid, decl.loc) - | other -> other + | `Opt (Some result) -> `Some result + | (`Builtin _ | `Some _) as other -> other in (* Step 3: Location => Source *) match loc with - | `None -> assert false | `Builtin _ as err -> err | `Some (uid, loc) -> ( match find_source ~config:config.mconfig loc (Path.name path) with @@ -705,7 +772,7 @@ let from_string ~config ~env ~local_defs ~pos ?namespaces path = log ~title:"from_string" "looking for the source of '%s' (prioritizing %s files)" path (match config.ml_or_mli with - | `ML -> ".ml" + | `ML | `Smart -> ".ml" | `MLI -> ".mli"); from_longident ~config ~env ~local_defs nss ident in diff --git a/src/analysis/locate.mli b/src/analysis/locate.mli index f685087caa..d2aa5c9cc9 100644 --- a/src/analysis/locate.mli +++ b/src/analysis/locate.mli @@ -29,7 +29,13 @@ val log : 'a Logger.printf type config = - { mconfig : Mconfig.t; ml_or_mli : [ `ML | `MLI ]; traverse_aliases : bool } + { mconfig : Mconfig.t; + ml_or_mli : [ `ML | `Smart | `MLI ]; + (** When [ml_or_mli] is [`Smart], if locate blocks on an interface uid, + it will use the [cmt_declaration_dependencies] to try finding a + unique corresponding definition in the implementation. *) + traverse_aliases : bool + } type result = { uid : Shape.Uid.t; @@ -42,6 +48,16 @@ type result = val uid_of_result : traverse_aliases:bool -> Shape_reduce.result -> Shape.Uid.t option * bool +(** Lookup the delcaration of the given Uid in the appropriate cmt file *) +val lookup_uid_decl : + config:Mconfig.t -> Shape.Uid.t -> Typedtree.item_declaration option + +(** [get_linked_uids] queries the [cmt_declaration_dependencies] table and + returns udis related to the one passed as argument. TODO right now this + function only returns simple links tagged with [Definition_to_declaration] *) +val get_linked_uids : + config:config -> comp_unit:string -> Shape.Uid.t -> Shape.Uid.t list + val find_source : config:Mconfig.t -> Warnings.loc -> diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index 42eb8fc5d6..cd9acd810a 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -116,10 +116,66 @@ let get_buffer_locs result uid = if Shape.Uid.equal uid uid' then Lid_set.add loc acc else acc) (Mtyper.get_index result) Lid_set.empty -let is_in_interface (config : Mconfig.t) (loc : Warnings.loc) = - let extension = Filename.extension loc.loc_start.pos_fname in - List.exists config.merlin.suffixes ~f:(fun (_impl, intf) -> - String.equal extension intf) +let get_external_locs ~(config : Mconfig.t) ~current_buffer_path uid = + let title = "get_external_locs" in + List.filter_map config.merlin.index_files ~f:(fun file -> + log ~title "Lookin for occurrences of %a in index %s" Logger.fmt + (Fun.flip Shape.Uid.print uid) + file; + let external_locs = + try + let external_index = Index_cache.read file in + Index_format.Uid_map.find_opt uid external_index.defs + |> Option.map ~f:(fun uid_locs -> (external_index, uid_locs)) + with Index_format.Not_an_index _ | Sys_error _ -> + log ~title "Could not load index %s" file; + None + in + Option.map external_locs ~f:(fun (index, locs) -> + let stats = Stat_check.create ~cache_size:128 index in + ( Lid_set.filter + (fun { loc; _ } -> + (* We ignore external results that concern the current buffer *) + let file = loc.Location.loc_start.Lexing.pos_fname in + let file, buf = + match config.merlin.source_root with + | Some root -> (Filename.concat root file, current_buffer_path) + | None -> (file, config.query.filename) + in + let file = Misc.canonicalize_filename file in + let buf = Misc.canonicalize_filename buf in + if String.equal file buf then false + else begin + (* We ignore external results if their source was modified *) + let check = Stat_check.check stats ~file in + if not check then + log ~title "File %s might be out-of-sync." file; + check + end) + locs, + Stat_check.get_outdated_files stats ))) + +let find_linked_uids ~config ~name uid = + let title = "find_linked_uids" in + match uid with + | Shape.Uid.Item { from = _; comp_unit; _ } -> ( + let config = + { Locate.mconfig = config; ml_or_mli = `ML; traverse_aliases = false } + in + match Locate.get_linked_uids ~config ~comp_unit uid with + | [ uid' ] -> + log ~title "Found linked uid: %a" Logger.fmt (fun fmt -> + Shape.Uid.print fmt uid'); + let name_check = + Locate.lookup_uid_decl ~config:config.mconfig uid' + |> Option.bind ~f:(Typedtree_utils.location_of_declaration ~uid:uid') + |> Option.value_map + ~f:(fun { Location.txt; _ } -> String.equal name txt) + ~default:false + in + if name_check then [ uid' ] else [] + | _ -> []) + | _ -> [] let locs_of ~config ~env ~typer_result ~pos ~scope path = log ~title:"occurrences" "Looking for occurences of %s (pos: %s)" path @@ -139,28 +195,11 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = let browse = Mbrowse.of_typedtree local_defs in let env, node = Mbrowse.leaf_node (Mbrowse.enclosing pos [ browse ]) in let node_uid_loc = uid_and_loc_of_node env node in - let scope = - match node_uid_loc with - | Some (_, l) when is_in_interface config l -> - (* There is no way to distinguish uids from interfaces from uids of - implementations. We fallback on buffer occurrences in that case. - TODO: we should be able to improve on that situation when we will be - able to distinguish between impl/intf uids and know which declaration - are actually linked. *) - `Buffer - | _ -> scope - in (node_uid_loc, scope) | `Found { uid; location; approximated = false; _ } | `File_not_found { uid; location; approximated = false; _ } -> log ~title:"locs_of" "Found definition uid using locate: %a " Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); - (* There is no way to distinguish uids from interfaces from uids of - implementations. We fallback on buffer occurrences in that case. - TODO: we should be able to improve on that situation when we will be - able to distinguish between impl/intf uids and know which declaration - are actually linked. *) - let scope = if is_in_interface config location then `Buffer else scope in (Some (uid, location), scope) | `Found { decl_uid; location; approximated = true; _ } | `File_not_found { decl_uid; location; approximated = true; _ } -> @@ -188,41 +227,13 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = let external_locs = if scope = `Buffer then [] else - List.filter_map config.merlin.index_files ~f:(fun file -> - let external_locs = - try - let external_index = Index_cache.read file in - Index_format.Uid_map.find_opt def_uid external_index.defs - |> Option.map ~f:(fun uid_locs -> (external_index, uid_locs)) - with Index_format.Not_an_index _ | Sys_error _ -> - log ~title:"external_index" "Could not load index %s" file; - None - in - Option.map external_locs ~f:(fun (index, locs) -> - let stats = Stat_check.create ~cache_size:128 index in - ( Lid_set.filter - (fun { loc; _ } -> - (* We ignore external results that concern the current buffer *) - let file = loc.Location.loc_start.Lexing.pos_fname in - let file, buf = - match config.merlin.source_root with - | Some root -> - (Filename.concat root file, current_buffer_path) - | None -> (file, config.query.filename) - in - let file = Misc.canonicalize_filename file in - let buf = Misc.canonicalize_filename buf in - if String.equal file buf then false - else begin - (* We ignore external results if their source was modified *) - let check = Stat_check.check stats ~file in - if not check then - log ~title:"locs_of" "File %s might be out-of-sync." - file; - check - end) - locs, - Stat_check.get_outdated_files stats ))) + let name = + String.split_on_char ~sep:'.' path |> List.last |> Option.get + in + let additional_uids = find_linked_uids ~config ~name def_uid in + List.concat_map + (def_uid :: additional_uids) + ~f:(get_external_locs ~config ~current_buffer_path) in let external_locs, out_of_sync_files = List.fold_left diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index 6bd3370997..c1c12ff464 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -509,6 +509,11 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function in if path = "" then `Invalid_context else + let ml_or_mli = + match ml_or_mli with + | `ML -> `Smart + | `MLI -> `MLI + in let config = Locate. { mconfig = Mpipeline.final_config pipeline; diff --git a/src/ocaml-index/lib/index.ml b/src/ocaml-index/lib/index.ml index cbdbd6e629..554880cc43 100644 --- a/src/ocaml-index/lib/index.ml +++ b/src/ocaml-index/lib/index.ml @@ -89,10 +89,8 @@ let index_of_cmt ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath init_load_path_once ~do_not_use_cmt_loadpath ~dirs:build_path cmt_loadpath; let module Reduce = Shape_reduce.Make (Reduce_conf) in let defs = - if Option.is_none cmt_impl_shape then Shape.Uid.Map.empty - else - gather_locs_from_fragments ~root ~rewrite_root Shape.Uid.Map.empty - cmt_uid_to_decl + gather_locs_from_fragments ~root ~rewrite_root Shape.Uid.Map.empty + cmt_uid_to_decl in (* The list [cmt_ident_occurrences] associate each ident usage location in the module with its (partially) reduced shape. We finish the reduction and @@ -104,11 +102,6 @@ let index_of_cmt ~root ~rewrite_root ~build_path ~do_not_use_cmt_loadpath let resolved = match item with | Unresolved shape -> Reduce.reduce_for_uid cmt_initial_env shape - | Resolved _ when Option.is_none cmt_impl_shape -> - (* Right now, without additional information we cannot take the - risk to mix uids from interfaces with the ones from - implementations. We simply ignore items defined in an interface. *) - Internal_error_missing_uid | result -> result in match Locate.uid_of_result ~traverse_aliases:false resolved with diff --git a/src/ocaml-index/tests/tests-dirs/interfaces.t b/src/ocaml-index/tests/tests-dirs/interfaces.t index 2232ed41b6..7514c55cf2 100644 --- a/src/ocaml-index/tests/tests-dirs/interfaces.t +++ b/src/ocaml-index/tests/tests-dirs/interfaces.t @@ -17,7 +17,8 @@ $ ocaml-index aggregate main.cmti -o main.index $ ocaml-index dump main.index - 1 uids: - {uid: Stdlib__Float.81; locs: + 2 uids: + {uid: [intf]Main.0; locs: "t": File "main.mli", line 1, characters 5-6 + uid: Stdlib__Float.81; locs: "Float.t": File "main.mli", line 1, characters 9-16 }, 0 approx shapes: {}, and shapes for CUS . diff --git a/src/ocaml/typing/cmt_format.ml b/src/ocaml/typing/cmt_format.ml index 4a5d2362ef..dda3dcbfba 100644 --- a/src/ocaml/typing/cmt_format.ml +++ b/src/ocaml/typing/cmt_format.ml @@ -454,6 +454,8 @@ let add_saved_type b = saved_types := b :: !saved_types let get_saved_types () = !saved_types let set_saved_types l = saved_types := l +let get_declaration_dependencies () = !uids_deps + let record_declaration_dependency (rk, uid1, uid2) = if not (Uid.equal uid1 uid2) then uids_deps := (rk, uid1, uid2) :: !uids_deps diff --git a/src/ocaml/typing/cmt_format.mli b/src/ocaml/typing/cmt_format.mli index 9b87374a81..f6015ec419 100644 --- a/src/ocaml/typing/cmt_format.mli +++ b/src/ocaml/typing/cmt_format.mli @@ -109,6 +109,7 @@ val add_saved_type : binary_part -> unit val get_saved_types : unit -> binary_part list val set_saved_types : binary_part list -> unit +val get_declaration_dependencies : unit -> (dependency_kind * Uid.t * Uid.t) list val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit (* diff --git a/tests/test-dirs/locate/context-detection/cd-test.t/run.t b/tests/test-dirs/locate/context-detection/cd-test.t/run.t index 3e01314838..867e37d011 100644 --- a/tests/test-dirs/locate/context-detection/cd-test.t/run.t +++ b/tests/test-dirs/locate/context-detection/cd-test.t/run.t @@ -32,7 +32,7 @@ Trying them all: "value": { "file": "$TESTCASE_ROOT/test.ml", "pos": { - "line": 7, + "line": 3, "col": 12 } }, diff --git a/tests/test-dirs/locate/dune b/tests/test-dirs/locate/dune index 7e226fede8..2f1e864e31 100755 --- a/tests/test-dirs/locate/dune +++ b/tests/test-dirs/locate/dune @@ -1,6 +1,6 @@ (cram (applies_to looping-substitution mutually-recursive partial-cmt includes - issue802 issue845 issue1199 issue1524 sig-substs l-413-features + issue802 issue845 issue1848 issue1199 issue1524 sig-substs l-413-features module-aliases locate-constrs without-implem without-sig module-decl-aliases in-implicit-trans-dep) (enabled_if diff --git a/tests/test-dirs/locate/issue1848.t b/tests/test-dirs/locate/issue1848.t new file mode 100644 index 0000000000..a196bc3f2c --- /dev/null +++ b/tests/test-dirs/locate/issue1848.t @@ -0,0 +1,82 @@ +Create a module with an mli file + $ cat > foo.ml << EOF + > type t = Foo + > module Bar = struct + > type t = Bar + > end + > EOF + + $ cat > foo.mli << EOF + > module Bar : sig + > type t + > end + > type t + > EOF + + $ $OCAMLC -c -bin-annot foo.mli + $ $OCAMLC -c -bin-annot foo.ml + +Locate the Bar on line 4 + $ cat > test1.ml << EOF + > module type Foo = sig + > include module type of Foo + > module Bar : sig + > include module type of Bar + > end + > end + > EOF + + + $ $MERLIN single locate -position 4:28 -look-for mli \ + > -filename test1.ml < test1.ml | jq .value + { + "file": "$TESTCASE_ROOT/foo.mli", + "pos": { + "line": 1, + "col": 7 + } + } + +Module Bar in foo.mli is a correct answer, but since there is only +one corresponding implementation we can jump there instead. + $ $MERLIN single locate -position 4:28 -look-for ml \ + > -filename test1.ml < test1.ml | jq .value + { + "file": "$TESTCASE_ROOT/foo.ml", + "pos": { + "line": 2, + "col": 7 + } + } + +Locate the Bar on line 3 + $ cat > test2.ml << EOF + > include Foo + > module Bar = struct + > include Bar + > end + > EOF + +Correctly returns 2:7 + $ $MERLIN single locate -position 3:12 -look-for ml -filename test2.ml < test2.ml | jq .value + { + "file": "$TESTCASE_ROOT/foo.ml", + "pos": { + "line": 2, + "col": 7 + } + } + +Locate the Foo.Bar on line 1 + $ cat > test3.ml << EOF + > include module type of Foo.Bar + > EOF +Correctly returns 2:7 + $ $MERLIN single locate -position 1:28 -look-for ml -filename test3.ml < test3.ml | jq .value + { + "file": "$TESTCASE_ROOT/foo.ml", + "pos": { + "line": 2, + "col": 7 + } + } diff --git a/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t b/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t index 12e0926dcd..23b2a6a91f 100644 --- a/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t +++ b/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t @@ -6,6 +6,7 @@ $ cat >main.ml <<'EOF' > let x = () > type t = unit + > let _ : t = () > EOF $ ocamlc -bin-annot -bin-annot-occurrences -c main.mli main.ml @@ -14,12 +15,19 @@ The indexer should not mixup uids from mli and ml files: $ ocaml-index dump project.ocaml-index - 2 uids: - {uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 - uid: Main.1; locs: "t": File "main.ml", line 2, characters 5-6 }, - 0 approx shapes: {}, and shapes for CUS . + 4 uids: + {uid: [intf]Main.0; locs: + "t": File "main.mli", line 1, characters 5-6; + "t": File "main.mli", line 2, characters 8-9 + uid: Main.0; locs: "x": File "main.ml", line 1, characters 4-5 + uid: [intf]Main.1; locs: "x": File "main.mli", line 2, characters 4-5 + uid: Main.1; locs: + "t": File "main.ml", line 2, characters 5-6; + "t": File "main.ml", line 3, characters 8-9 + }, 0 approx shapes: {}, and shapes for CUS . -Merlin should not mixup uids from mli and ml files: +Merlin should not mixup uids from mli and ml files, and return results in both +the interface and the implementation. $ $MERLIN single occurrences -scope project -identifier-at 2:8 \ > -index-file project.ocaml-index \ > -filename main.mli -index-file project.ocaml-index \ + > -index-file project.ocaml-index \ > -filename main.mli -index-file project.ocaml-index \ + > -filename main.ml -index-file project.ocaml-index \ + > -filename main.ml -index-file project.ocaml-index \ + > -filename main.mli main.ml <<'EOF' + > type t = unit + > let x = () + > let _ : t = () + > EOF + +Merlin should not get confused and return an occurrence of `x` in the interface +when asked from occurrences of `t` in the implementation. + +FIXME: this is based on a heuristic that compares the identifiers it could still +get confused if both identifers are the same. + $ $MERLIN single occurrences -scope project -identifier-at 1:5 \ + > -index-file project.ocaml-index \ + > -filename main.ml