Ignore hidden branches when listing occurrences (fixes ocaml#1671)

src/analysis/browse_tree.ml

@@ -115,7 +115,10 @@ let all_occurrences path =
       | [] -> acc
       | paths -> (t, paths) :: acc
     in
-    List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
+    if Browse_raw.has_attr ~name:"merlin.hide" t.t_node then
+      acc
+    else
+      List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
   in
   aux []
 
@@ -131,7 +134,10 @@ let all_constructor_occurrences ({t_env = env; _},d) t =
         {d' with Location.txt = t} :: acc
       | _ -> acc
     in
-    List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
+    if Browse_raw.has_attr ~name:"merlin.hide" t.t_node then
+      acc
+    else
+      List.fold_left ~f:aux ~init:acc (Lazy.force t.t_children)
   in
   aux [] t
 

src/kernel/mbrowse.ml

@@ -78,34 +78,32 @@ let drop_leaf t =
   | [] | [ _ ] -> None
   | _leaf :: parents -> Some parents
 
-let has_attr attr_name attrs =
-  List.exists ~f:(fun a ->
-    let (str,_) = Ast_helper.Attr.as_tuple a in
-    str.Location.txt = attr_name
-  ) attrs
+let is_hidden node =
+  Browse_raw.has_attr ~name:"merlin.hide" node
+
+let is_focus node =
+  Browse_raw.has_attr ~name:"merlin.focus" node
 
 let select_leafs pos root =
   let branches = ref [] in
   let rec select_child branch env node has_selected =
     let loc = node_merlin_loc node in
-    let attrs = Browse_raw.node_attributes node in
     if Location_aux.compare_pos pos loc = 0 &&
-       not (has_attr "merlin.hide" attrs)
+       not (is_hidden node)
     then
       (traverse ((env, node) :: branch); true)
     else
       has_selected
   and traverse branch =
     let env, node = leaf_node branch in
-    let attrs = Browse_raw.node_attributes node in
-    if (has_attr "merlin.focus" attrs) then (
+    if (is_focus node) then (
       branches := [];
       let has_leaves = fold_node (select_child branch) env node false in
       if not has_leaves then
         branches := [branch];
       raise Exit
     )
-    else if not (has_attr "merlin.hide" attrs) then (
+    else if not (is_hidden node) then (
       let has_leaves = fold_node (select_child branch) env node false in
       if not has_leaves then
         branches := branch :: !branches

src/ocaml/merlin_specific/browse_raw.ml

@@ -193,6 +193,13 @@ let node_attributes = function
   | Record_field (`Pattern obj,_,_) -> obj.pat_attributes
   | _ -> []
 
+let has_attr ~name node =
+  let attrs = node_attributes node in
+  List.exists ~f:(fun a ->
+    let (str,_) = Ast_helper.Attr.as_tuple a in
+    str.Location.txt = name
+  ) attrs
+
 let node_merlin_loc loc0 node =
   let attributes = node_attributes node in
   let loc =

src/ocaml/merlin_specific/browse_raw.mli

@@ -108,6 +108,7 @@ val node_update_env : Env.t -> node -> Env.t
 val node_real_loc : Location.t -> node -> Location.t
 val node_merlin_loc : Location.t -> node -> Location.t
 val node_attributes : node -> attribute list
+val has_attr : name:string -> node -> bool
 
 val string_of_node : node -> string
 

tests/test-dirs/with-ppx/issue1671-string.t

@@ -43,82 +43,22 @@ FIX upstream: locs issued by the ppx does not enable Merlin to work as expected
     "notifications": []
   }
 
-FIXME: Merlin should ignore hidden nodes in occurrences results to prevent
-broken renaming
+Merlin should ignore hidden nodes in occurrences results
   $ $MERLIN single occurrences -identifier-at 1:6 \
   > -filename main.ml <main.ml
-
-  $ $MERLIN single dump -what typedtree -filename main.ml <main.ml
   {
     "class": "return",
-    "value": "[
-    structure_item (main.ml[1,0+0]..main.ml[3,21+97])
-      Tstr_value Nonrec
-      [
-        <def>
-          pattern (main.ml[1,0+4]..main.ml[1,0+5])
-            Tpat_var \"f/273\"
-          expression (main.ml[1,0+6]..main.ml[3,21+97]) ghost
-            Texp_function
-            Nolabel
-            [
-              <case>
-                pattern (main.ml[1,0+6]..main.ml[1,0+7])
-                  Tpat_var \"x/275\"
-                expression (main.ml[2,10+2]..main.ml[3,21+97])
-                  attribute \"merlin.hide\"
-                    []
-                  Texp_apply
-                  expression (main.ml[2,10+2]..main.ml[3,21+97])
-                    Texp_ident \"Stdlib!.String.concat\"
-                  [
-                    <arg>
-                      Nolabel
-                      expression (main.ml[2,10+2]..main.ml[3,21+97])
-                        Texp_constant Const_string(\"\",(main.ml[2,10+2]..main.ml[3,21+97]),None)
-                    <arg>
-                      Nolabel
-                      expression (main.ml[2,10+2]..main.ml[3,21+97])
-                        Texp_construct \"::\"
-                        [
-                          expression (main.ml[3,21+5]..main.ml[3,21+91]) ghost
-                            Texp_constant Const_string(\"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa      \",(main.ml[3,21+5]..main.ml[3,21+91]) ghost,None)
-                          expression (main.ml[2,10+2]..main.ml[3,21+97])
-                            Texp_construct \"::\"
-                            [
-                              expression (main.ml[3,21+93]..main.ml[3,21+94])
-                                Texp_ident \"x/275\"
-                              expression (main.ml[2,10+2]..main.ml[3,21+97])
-                                Texp_construct \"[]\"
-                                []
-                            ]
-                        ]
-                  ]
-            ]
-      ]
-    structure_item (main.ml[5,122+0]..main.ml[5,122+23])
-      Tstr_eval
-      expression (main.ml[5,122+0]..main.ml[5,122+23])
-        Texp_apply
-        expression (main.ml[5,122+0]..main.ml[5,122+13])
-          Texp_ident \"Stdlib!.print_endline\"
-        [
-          <arg>
-            Nolabel
-            expression (main.ml[5,122+17]..main.ml[5,122+23])
-              Texp_apply
-              expression (main.ml[5,122+17]..main.ml[5,122+18])
-                Texp_ident \"f/273\"
-              [
-                <arg>
-                  Nolabel
-                  expression (main.ml[5,122+19]..main.ml[5,122+23])
-                    Texp_constant Const_string(\"42\",(main.ml[5,122+20]..main.ml[5,122+22]),None)
-              ]
-        ]
-  ]
-  
-  
-  ",
+    "value": [
+      {
+        "start": {
+          "line": 1,
+          "col": 6
+        },
+        "end": {
+          "line": 1,
+          "col": 7
+        }
+      }
+    ],
     "notifications": []
   }