diff --git a/src/analysis/index_occurrences.ml b/src/analysis/index_occurrences.ml index 66aa9720e..c0e96ca09 100644 --- a/src/analysis/index_occurrences.ml +++ b/src/analysis/index_occurrences.ml @@ -25,11 +25,13 @@ let decl_of_path_or_lid env namespace path lid = end | _ -> Env_lookup.by_path path namespace env +let should_ignore_lid (lid : Longident.t Location.loc) = + Location.is_none lid.loc + let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid = let add uid loc = Stamped_hashtable.add index ~stamp (uid, loc) () in let f ~namespace env path (lid : Longident.t Location.loc) = log ~title:"index_buffer" "Path: %a" Logger.fmt (Fun.flip Path.print path); - let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in let lid = { lid with loc = set_fname ~file:current_buffer_path lid.loc } in let index_decl () = begin @@ -42,7 +44,7 @@ let iterator ~current_buffer_path ~index ~stamp ~reduce_for_uid = add decl.uid lid end in - if not_ghost lid then + if not (should_ignore_lid lid) then match Env.shape_of_path ~namespace env path with | exception Not_found -> () | path_shape -> diff --git a/src/analysis/occurrences.ml b/src/analysis/occurrences.ml index ba57ffd36..1eabc6484 100644 --- a/src/analysis/occurrences.ml +++ b/src/analysis/occurrences.ml @@ -200,18 +200,25 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path = 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) + (fun ({ loc; _ } as lid) -> + let is_current_buffer = + (* We filter 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 + String.equal file buf in - let file = Misc.canonicalize_filename file in - let buf = Misc.canonicalize_filename buf in - if String.equal file buf then false + let should_be_ignored = + (* We ignore results that don't have a location *) + Index_occurrences.should_ignore_lid lid + in + if is_current_buffer || should_be_ignored then false else begin (* We ignore external results if their source was modified *) let check = Stat_check.check stats ~file in diff --git a/src/ocaml/typing/cmt_format.ml b/src/ocaml/typing/cmt_format.ml index 0670acb0c..f69674ae6 100644 --- a/src/ocaml/typing/cmt_format.ml +++ b/src/ocaml/typing/cmt_format.ml @@ -391,14 +391,12 @@ let index_occurrences binary_annots = ref [] in let f ~namespace env path lid = - let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in - if not_ghost lid then - match Env.shape_of_path ~namespace env path with - | exception Not_found -> () - | { uid = Some (Predef _); _ } -> () - | path_shape -> - let result = Shape_reduce.local_reduce_for_uid env path_shape in - index := (lid, result) :: !index + match Env.shape_of_path ~namespace env path with + | exception Not_found -> () + | { uid = Some (Predef _); _ } -> () + | path_shape -> + let result = Shape_reduce.local_reduce_for_uid env path_shape in + index := (lid, result) :: !index in iter_on_annots (iter_on_occurrences ~f) binary_annots; Array.of_list !index diff --git a/tests/test-dirs/let-punning.t/run.t b/tests/test-dirs/let-punning.t/run.t index a3334a9c6..da397861f 100644 --- a/tests/test-dirs/let-punning.t/run.t +++ b/tests/test-dirs/let-punning.t/run.t @@ -248,8 +248,6 @@ Test that finding occurrences of a variable includes usages in a punned let. i.e finding occurrences of x on line 1 returns the definition on line 1 and the usage on line 2. -TODO: fix these tests - let* $ occurrences 12:8 Occurrences of: @@ -258,6 +256,9 @@ let* Occurrence at 12:8-9: let a = return 1 in ^ + Occurrence at 13:9-10: + let* a in + ^ parallel let* $ occurrences 18:8 @@ -267,6 +268,9 @@ parallel let* Occurrence at 18:8-9: let a = return 1 in ^ + Occurrence at 20:9-10: + let* a and* b in + ^ $ occurrences 19:8 Occurrences of: let b = return 1 in @@ -274,6 +278,9 @@ parallel let* Occurrence at 19:8-9: let b = return 1 in ^ + Occurrence at 20:16-17: + let* a and* b in + ^ sequential let* $ occurrences 25:8 @@ -283,6 +290,9 @@ sequential let* Occurrence at 25:8-9: let a = return 1 in ^ + Occurrence at 27:9-10: + let* a in + ^ $ occurrences 26:8 Occurrences of: let b = return 1 in @@ -290,3 +300,6 @@ sequential let* Occurrence at 26:8-9: let b = return 1 in ^ + Occurrence at 28:9-10: + let* b in + ^ diff --git a/tests/test-dirs/occurrences/project-wide/punning.t/definitions.ml b/tests/test-dirs/occurrences/project-wide/punning.t/definitions.ml new file mode 100644 index 000000000..046d60aed --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/punning.t/definitions.ml @@ -0,0 +1,4 @@ +let a = Some 1 + +type t = { value : string } +let value = "hello" diff --git a/tests/test-dirs/occurrences/project-wide/punning.t/run.t b/tests/test-dirs/occurrences/project-wide/punning.t/run.t new file mode 100644 index 000000000..c1fcfd724 --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/punning.t/run.t @@ -0,0 +1,48 @@ +Test project-wide occurrences in the presence of punning (both let and record punning) + +Compile project, create index file, and configure Merlin to use index file + $ $OCAMLC -bin-annot -bin-annot-occurrences -c definitions.ml usages.ml + $ ocaml-index aggregate definitions.cmt usages.cmt + $ cat > .merlin << EOF + > INDEX project.ocaml-index + > EOF + +Convenience function for querying occurrences + $ occurrences () { + > file="$1" + > location="$2" + > $MERLIN single occurrences -scope project -identifier-at "$location" -filename "$file" < "$file" | \ + > jq -r '.value[] | "\(.file) \(.start.line):\(.start.col)-\(.end.col)"' + > } + +Get occurrences of an identifier that is used as the expression part of a punned let +expression + $ occurrences definitions.ml 1:4 + $TESTCASE_ROOT/definitions.ml 1:4-5 + $TESTCASE_ROOT/usages.ml 6:7-8 + +Get occurrences, with the cursor pointing at the identifier in a punned let. +Merlin returns the occurrences of the new variable bound in that let, rather than the +expression being assigned to the variable. + $ occurrences usages.ml 6:7 + $TESTCASE_ROOT/usages.ml 6:7-8 + $TESTCASE_ROOT/usages.ml 7:7-8 + +Get occurrences of a record field, where there is an instance of punning that field while +creating a record + $ occurrences definitions.ml 3:13 + $TESTCASE_ROOT/definitions.ml 3:11-16 + $TESTCASE_ROOT/usages.ml 10:10-15 + +Get occurrences of a variable that is used as the value being placed into a record in a +punned record field expression + $ occurrences definitions.ml 4:6 + $TESTCASE_ROOT/definitions.ml 4:4-9 + $TESTCASE_ROOT/usages.ml 10:10-15 + +Get occurrences, with the cursor pointing at a punned record field expression. +Merlin finds occurrences of the value being placed into the record rather than the record +field + $ occurrences usages.ml 10:12 + $TESTCASE_ROOT/definitions.ml 4:4-9 + $TESTCASE_ROOT/usages.ml 10:10-15 diff --git a/tests/test-dirs/occurrences/project-wide/punning.t/usages.ml b/tests/test-dirs/occurrences/project-wide/punning.t/usages.ml new file mode 100644 index 000000000..051a50714 --- /dev/null +++ b/tests/test-dirs/occurrences/project-wide/punning.t/usages.ml @@ -0,0 +1,10 @@ +include Definitions + +(* Let punning *) +let _ = + let (let*) = Option.bind in + let* a in + Some a + +(* Record field punning *) +let _ = { value } diff --git a/tests/test-dirs/occurrences/punning.t/run.t b/tests/test-dirs/occurrences/punning.t/run.t new file mode 100644 index 000000000..fa40df83b --- /dev/null +++ b/tests/test-dirs/occurrences/punning.t/run.t @@ -0,0 +1,45 @@ +Test occurrences in the presence of punning (both let and record punning) + +Convenience function for querying occurrences + $ occurrences () { + > location="$1" + > $MERLIN single occurrences -identifier-at "$location" -filename test.ml < test.ml | \ + > jq -r '.value[] | "\(.start.line):\(.start.col)-\(.end.col)"' + > } + +Get occurrences of an identifier that is used as the expression part of a punned let +expression + $ occurrences 4:6 + 4:6-7 + 5:7-8 + +Get occurrences, with the cursor pointing at the identifier in a punned let. +Merlin returns the occurrences of the new variable bound in that let, rather than the +expression being assigned to the variable. + $ occurrences 5:7 + 5:7-8 + 6:7-8 + +Get occurrences of an identifier that was defined in a punned let expression + $ occurrences 5:7 + 5:7-8 + 6:7-8 + +Get occurrences of a record field, where there is an instance of punning that field while +creating a record + $ occurrences 9:13 + 9:11-16 + 11:10-15 + +Get occurrences of a variable that is used as the value being placed into a record in a +punned record field expression + $ occurrences 10:4 + 10:4-9 + 11:10-15 + +Get occurrences, with the cursor pointing at a punned record field expression. +Merlin finds occurrences of the value being placed into the record rather than the record +field + $ occurrences 10:4 + 10:4-9 + 11:10-15 diff --git a/tests/test-dirs/occurrences/punning.t/test.ml b/tests/test-dirs/occurrences/punning.t/test.ml new file mode 100644 index 000000000..540562bef --- /dev/null +++ b/tests/test-dirs/occurrences/punning.t/test.ml @@ -0,0 +1,11 @@ +(* Let punning *) +let _ = + let (let*) = Option.bind in + let a = Some 1 in + let* a in + Some a + +(* Record field punning *) +type t = { value : string } +let value = "hello" +let _ = { value } diff --git a/upstream/ocaml_flambda/base-rev.txt b/upstream/ocaml_flambda/base-rev.txt index 9c8d36450..5f3302d29 100644 --- a/upstream/ocaml_flambda/base-rev.txt +++ b/upstream/ocaml_flambda/base-rev.txt @@ -1 +1 @@ -69c04271e033a9c4420b2391b9e77427bf3c0c9a +0568366c21ca4c1bf1fb2db3dd62f65879100a4a diff --git a/upstream/ocaml_flambda/file_formats/cmt_format.ml b/upstream/ocaml_flambda/file_formats/cmt_format.ml index 9e4f77d33..dc28e4772 100644 --- a/upstream/ocaml_flambda/file_formats/cmt_format.ml +++ b/upstream/ocaml_flambda/file_formats/cmt_format.ml @@ -374,14 +374,12 @@ let index_occurrences binary_annots = ref [] in let f ~namespace env path lid = - let not_ghost { Location.loc = { loc_ghost; _ }; _ } = not loc_ghost in - if not_ghost lid then - match Env.shape_of_path ~namespace env path with - | exception Not_found -> () - | { uid = Some (Predef _); _ } -> () - | path_shape -> - let result = Shape_reduce.local_reduce_for_uid env path_shape in - index := (lid, result) :: !index + match Env.shape_of_path ~namespace env path with + | exception Not_found -> () + | { uid = Some (Predef _); _ } -> () + | path_shape -> + let result = Shape_reduce.local_reduce_for_uid env path_shape in + index := (lid, result) :: !index in iter_on_annots (iter_on_occurrences ~f) binary_annots; Array.of_list !index