force open

Author: zth

compiler/ext/warnings.ml

@@ -432,12 +432,10 @@ let message = function
     ^ "\nThe first one was selected. Disambiguate if this is wrong."
   | Nonoptional_label s -> "the label " ^ s ^ " is not optional."
   | Open_shadow_identifier (kind, s) ->
-    (* TODO(actions) Force open *)
     Printf.sprintf
       "this open statement shadows the %s identifier %s (which is later used)"
       kind s
   | Open_shadow_label_constructor (kind, s) ->
-    (* TODO(actions) Force open *)
     Printf.sprintf "this open statement shadows the %s %s (which is later used)"
       kind s
   | Attribute_payload (a, s) ->

compiler/ml/cmt_utils.ml

@@ -16,6 +16,7 @@ type action_type =
   | RemoveUnusedType
   | RemoveUnusedModule
   | RemoveRecFlag
+  | ForceOpen
 
 (* TODO: 
 - Unused var in patterns (and aliases )*)
@@ -51,6 +52,7 @@ let action_to_string = function
     Printf.sprintf "RewriteIdent(%s)"
       (Longident.flatten new_ident |> String.concat ".")
   | RemoveRecFlag -> "RemoveRecFlag"
+  | ForceOpen -> "ForceOpen"
 
 let _add_possible_action : (cmt_action -> unit) ref = ref (fun _ -> ())
 let add_possible_action action = !_add_possible_action action
@@ -87,6 +89,8 @@ let emit_possible_actions_from_warning loc w =
   | Unused_rec_flag ->
     add_possible_action
       {loc; action = RemoveRecFlag; description = "Remove rec flag"}
+  | Open_shadow_identifier _ | Open_shadow_label_constructor _ ->
+    add_possible_action {loc; action = ForceOpen; description = "Force open"}
   | _ -> ()
 
 let _ =

tests/build_tests/actions/expected/Actions_ForceOpen_applied.res

@@ -0,0 +1,32 @@
+type person = {
+  name: string,
+  age: int,
+}
+
+module X = {
+  let ff = 15
+}
+
+let ff = 16
+
+open! X
+
+let f2 = ff
+
+module RecordExample = {
+  type t = {
+    name: string,
+    age: int,
+  }
+  let person = {name: "John", age: 30}
+}
+
+open! RecordExample
+
+let p = {name: "Jane", age: 25}
+
+/* === AVAILABLE ACTIONS:
+- ForceOpen - Force open
+- ForceOpen - Force open
+- ForceOpen - Force open
+*/

tests/build_tests/actions/fixtures/Actions_ForceOpen.res

@@ -0,0 +1,26 @@
+type person = {
+  name: string,
+  age: int,
+}
+
+module X = {
+  let ff = 15
+}
+
+let ff = 16
+
+open X
+
+let f2 = ff
+
+module RecordExample = {
+  type t = {
+    name: string,
+    age: int,
+  }
+  let person = {name: "John", age: 30}
+}
+
+open RecordExample
+
+let p = {name: "Jane", age: 25}

tools/src/tools.ml

@@ -1308,7 +1308,24 @@ module Actions = struct
                   | _ -> None)
                 actions
             in
+            let force_open_action_locs =
+              List.filter_map
+                (fun (action : Cmt_utils.cmt_action) ->
+                  match action.action with
+                  | ForceOpen -> Some action.loc
+                  | _ -> None)
+                actions
+            in
             match str_item.pstr_desc with
+            | Pstr_open ({popen_override = Fresh} as open_desc)
+              when List.mem str_item.pstr_loc force_open_action_locs ->
+              let str_item =
+                Ast_mapper.default_mapper.structure_item mapper str_item
+              in
+              {
+                str_item with
+                pstr_desc = Pstr_open {open_desc with popen_override = Override};
+              }
             | Pstr_value (Recursive, ({pvb_pat = {ppat_loc}} :: _ as bindings))
               when List.mem ppat_loc remove_rec_flag_action_locs ->
               let str_item =
@@ -1663,7 +1680,8 @@ module Actions = struct
                    List.mem "RemoveUnusedVariable" filter
                  | RemoveUnusedType -> List.mem "RemoveUnusedType" filter
                  | RemoveUnusedModule -> List.mem "RemoveUnusedModule" filter
-                 | RemoveRecFlag -> List.mem "RemoveRecFlag" filter)
+                 | RemoveRecFlag -> List.mem "RemoveRecFlag" filter
+                 | ForceOpen -> List.mem "ForceOpen" filter)
       in
       match applyActionsToFile path possible_actions with
       | Ok applied ->