Remove duplicate types and class types signature items (#105)

azzsal · web-flow · commit f99f00fc04a5 · 2024-12-10T10:32:47.000+01:00
* Update class and class types tests

* Add remove and has functions in Sig_item_map module

* Remove unused remove function for Sig_item_map module

* Add a changelog entry

* Fix changelog entry
diff --git a/CHANGES.md b/CHANGES.md
@@ -14,6 +14,7 @@
 ### Fixed
 
 - Ignore hidden signature items (#102, @NchamJosephMuam)
+- Remove duplicate items in class and class types (#105, @azzsal)
 
 ### Removed
 
diff --git a/lib/diff.ml b/lib/diff.ml
@@ -64,13 +64,21 @@ let extract_items items =
       | Sig_value (id, val_des, Exported) ->
           Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Value val_des tbl
       | Sig_type (id, type_decl, _, Exported) ->
-          Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Type
-            (type_decl, id) tbl
+          if
+            Sig_item_map.has ~name:(Ident.name id) Sig_item_map.Class tbl
+            || Sig_item_map.has ~name:(Ident.name id) Sig_item_map.Classtype tbl
+          then tbl
+          else
+            Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Type
+              (type_decl, id) tbl
       | Sig_class (id, cls_decl, _, Exported) ->
           Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Class cls_decl tbl
       | Sig_class_type (id, class_type_decl, _, Exported) ->
-          Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Classtype
-            class_type_decl tbl
+          if Sig_item_map.has ~name:(Ident.name id) Sig_item_map.Class tbl then
+            tbl
+          else
+            Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Classtype
+              class_type_decl tbl
       | _ -> tbl)
     Sig_item_map.empty items
 
diff --git a/lib/sig_item_map.ml b/lib/sig_item_map.ml
@@ -42,6 +42,15 @@ let add (type a) ~name (item_type : a item_type) (item : a) maps : t =
         class_type_map = String_map.add name item maps.class_type_map;
       }
 
+let has (type a) ~name (item_type : a item_type) maps : bool =
+  match item_type with
+  | Value -> String_map.mem name maps.values_map
+  | Module -> String_map.mem name maps.modules_map
+  | Modtype -> String_map.mem name maps.modtypes_map
+  | Type -> String_map.mem name maps.types_map
+  | Class -> String_map.mem name maps.class_map
+  | Classtype -> String_map.mem name maps.class_type_map
+
 type ('a, 'diff) diff_item =
   'a item_type -> string -> 'a option -> 'a option -> 'diff option
 
diff --git a/lib/sig_item_map.mli b/lib/sig_item_map.mli
@@ -12,6 +12,7 @@ type _ item_type =
 
 val empty : t
 val add : name:string -> 'a item_type -> 'a -> t -> t
+val has : name:string -> 'a item_type -> t -> bool
 
 type ('a, 'diff) diff_item =
   'a item_type -> string -> 'a option -> 'a option -> 'diff option
diff --git a/tests/api-diff/class_detection.t b/tests/api-diff/class_detection.t
@@ -32,9 +32,7 @@ Compile the new .mli file to a .cmi file
 Run api-diff and check the output
   $ api-diff ref_class.cmi add_class.cmi
   diff module Add_class:
-  +type add_class = < calculate : float -> float >
   +class add_class : object method calculate : float -> float end
-  +class type add_class = object method calculate : float -> float end
   
   [1]
 
@@ -50,8 +48,6 @@ Compile the new .mli file to a .cmi file
 Run api-diff and check the output
   $ api-diff ref_class.cmi remove_class.cmi
   diff module Remove_class:
-  -type ref_class = < get : int; set : int -> unit >
   -class ref_class : object method get : int method set : int -> unit end
-  -class type ref_class = object method get : int method set : int -> unit end
   
   [1]
diff --git a/tests/api-diff/cltype_tests.t b/tests/api-diff/cltype_tests.t
@@ -33,7 +33,6 @@ Compile the new .mli file to a .cmi file
 Run api-diff and check the output
   $ api-diff ref_cltype.cmi add_cltype.cmi
   diff module Add_cltype:
-  +type new_cltype = < mk : int -> unit; mn : int -> int >
   +class type new_cltype =
   +  object method mk : int -> unit method mn : int -> int end
   
@@ -51,7 +50,6 @@ Compile the new .mli file to a .cmi file
 Run api-diff and check the output
   $ api-diff ref_cltype.cmi remove_cltype.cmi
   diff module Remove_cltype:
-  -type ref_cltype = < m1 : string; m2 : string -> unit >
   -class type ref_cltype =
   -  object method m1 : string method m2 : string -> unit end
   
diff --git a/tests/api-watch/test_diff_class.ml b/tests/api-watch/test_diff_class.ml
@@ -34,11 +34,7 @@ let%expect_test "Class Addition" =
     in
     Format.printf "%a" pp_diff_option result;
     [%expect
-      {|
-      Some (Module Main: {Modified (Supported [ Type (cls3, Added);
-      Class (cls3, Added);
-      Class_type (cls3, Added)])})
-      |}]
+      {| Some (Module Main: {Modified (Supported [ Class (cls3, Added)])}) |}]
   with e ->
     Format.printf "Error: %s" (Printexc.to_string e);
     [%expect.unreachable]
@@ -68,11 +64,7 @@ let%expect_test "Class Removal" =
     in
     Format.printf "%a" pp_diff_option result;
     [%expect
-      {|
-    Some (Module Main: {Modified (Supported [ Type (cls2, Removed);
-    Class (cls2, Removed);
-    Class_type (cls2, Removed)])})
-    |}]
+      {| Some (Module Main: {Modified (Supported [ Class (cls2, Removed)])}) |}]
   with e ->
     Format.printf "Error: %s" (Printexc.to_string e);
     [%expect.unreachable]
diff --git a/tests/api-watch/test_diff_cltype.ml b/tests/api-watch/test_diff_cltype.ml
@@ -16,10 +16,7 @@ let%expect_test "Class type addition" =
   let result = Diff.interface ~module_name:"Main" ~reference ~current in
   Format.printf "%a" pp_diff_option result;
   [%expect
-    {|
-      Some (Module Main: {Modified (Supported [ Type (cltype, Added);
-      Class_type (cltype, Added)])})
-    |}]
+    {| Some (Module Main: {Modified (Supported [ Class_type (cltype, Added)])}) |}]
 
 let%expect_test "Class type removal" =
   let reference =
@@ -36,7 +33,4 @@ let%expect_test "Class type removal" =
   let result = Diff.interface ~module_name:"Main" ~reference ~current in
   Format.printf "%a" pp_diff_option result;
   [%expect
-    {|
-        Some (Module Main: {Modified (Supported [ Type (cltype, Removed);
-        Class_type (cltype, Removed)])})
-      |}]
+    {| Some (Module Main: {Modified (Supported [ Class_type (cltype, Removed)])}) |}]
