Skip to content

Commit 80637c4

Browse files
azzsalazzsal
authored
Detect addition and removal of class type declarations (#103)
* Add tests for class type declarations * Add initial implementation for detecting added and removed class type declarations * Update change log * Fix change log entry * Remove unnecessary mutual recursion in types
1 parent ebf71e4 commit 80637c4

File tree

11 files changed

+188
-8
lines changed

11 files changed

+188
-8
lines changed

‎CHANGES.md‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,10 @@
22

33
### Added
44

5-
- Add detection of modified type declarations (#92, @azzsal)
5+
- Add detection of type declarations changes (#92, @azzsal)
66
- Add detection of module_type declarations changes (#93, @NchamJosephMuam)
77
- Add detection of classes addition and removal (#90, @marcndo)
8+
- Add detection of addition and removal of class type declarations (#103, @azzsal)
89

910
### Changed
1011

‎lib/diff.ml‎

Lines changed: 23 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,18 @@ type type_ = {
1919

2020
type class_modification = Unsupported
2121

22-
and class_ = {
22+
type class_ = {
2323
cname : string;
2424
cdiff : (class_declaration, class_modification) t;
2525
}
2626

27+
type class_type_modification = Unsupported
28+
29+
type cltype = {
30+
ctname : string;
31+
ctdiff : (class_type_declaration, class_type_modification) t;
32+
}
33+
2734
type module_ = {
2835
mname : string;
2936
mdiff : (module_declaration, signature_modification) t;
@@ -42,6 +49,7 @@ and sig_item =
4249
| Type of type_
4350
| Modtype of modtype
4451
| Class of class_
52+
| Classtype of cltype
4553

4654
let extract_items items =
4755
List.fold_left
@@ -60,6 +68,9 @@ let extract_items items =
6068
(type_decl, id) tbl
6169
| Sig_class (id, cls_decl, _, Exported) ->
6270
Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Class cls_decl tbl
71+
| Sig_class_type (id, class_type_decl, _, Exported) ->
72+
Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Classtype
73+
class_type_decl tbl
6374
| _ -> tbl)
6475
Sig_item_map.empty items
6576

@@ -128,6 +139,16 @@ let class_item ~name ~(reference : class_declaration option)
128139
| Some ref_cls, None -> Some (Class { cname = name; cdiff = Removed ref_cls })
129140
| Some _, Some _ -> None
130141

142+
let class_type_item ~name ~(reference : class_type_declaration option)
143+
~(current : class_type_declaration option) =
144+
match (reference, current) with
145+
| None, None -> None
146+
| None, Some curr_class_type ->
147+
Some (Classtype { ctname = name; ctdiff = Added curr_class_type })
148+
| Some ref_class_type, None ->
149+
Some (Classtype { ctname = name; ctdiff = Removed ref_class_type })
150+
| Some _, Some _ -> None
151+
131152
let rec items ~reference ~current =
132153
let env = Typing_env.for_diff ~reference ~current in
133154
let ref_items = extract_items reference in
@@ -140,6 +161,7 @@ let rec items ~reference ~current =
140161
| Modtype -> module_type_item ~typing_env:env ~name ~reference ~current
141162
| Type -> type_item ~typing_env:env ~name ~reference ~current
142163
| Class -> class_item ~name ~reference ~current
164+
| Classtype -> class_type_item ~name ~reference ~current
143165
in
144166
Sig_item_map.diff ~diff_item:{ diff_item } ref_items curr_items
145167

‎lib/diff.mli‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,19 @@ type value = {
77
(Types.value_description, Types.value_description atomic_modification) t;
88
}
99

10-
type class_ = {
10+
type class_modification = Unsupported
11+
12+
and class_ = {
1113
cname : string;
1214
cdiff : (Types.class_declaration, class_modification) t;
1315
}
1416

15-
and class_modification = Unsupported
17+
type class_type_modification = Unsupported
18+
19+
and cltype = {
20+
ctname : string;
21+
ctdiff : (Types.class_type_declaration, class_type_modification) t;
22+
}
1623

1724
type type_ = {
1825
tname : string;
@@ -37,6 +44,7 @@ and sig_item =
3744
| Type of type_
3845
| Modtype of modtype
3946
| Class of class_
47+
| Classtype of cltype
4048

4149
val interface :
4250
module_name:string ->

‎lib/sig_item_map.ml‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ type t = {
66
modtypes_map : modtype_declaration String_map.t;
77
types_map : (type_declaration * Ident.t) String_map.t;
88
class_map : class_declaration String_map.t;
9+
class_type_map : class_type_declaration String_map.t;
910
}
1011

1112
type _ item_type =
@@ -14,6 +15,7 @@ type _ item_type =
1415
| Modtype : modtype_declaration item_type
1516
| Type : (type_declaration * Ident.t) item_type
1617
| Class : class_declaration item_type
18+
| Classtype : class_type_declaration item_type
1719

1820
let empty : t =
1921
{
@@ -22,6 +24,7 @@ let empty : t =
2224
modtypes_map = String_map.empty;
2325
types_map = String_map.empty;
2426
class_map = String_map.empty;
27+
class_type_map = String_map.empty;
2528
}
2629

2730
let add (type a) ~name (item_type : a item_type) (item : a) maps : t =
@@ -33,6 +36,11 @@ let add (type a) ~name (item_type : a item_type) (item : a) maps : t =
3336
{ maps with modtypes_map = String_map.add name item maps.modtypes_map }
3437
| Type -> { maps with types_map = String_map.add name item maps.types_map }
3538
| Class -> { maps with class_map = String_map.add name item maps.class_map }
39+
| Classtype ->
40+
{
41+
maps with
42+
class_type_map = String_map.add name item maps.class_type_map;
43+
}
3644

3745
type ('a, 'diff) diff_item =
3846
'a item_type -> string -> 'a option -> 'a option -> 'diff option
@@ -70,4 +78,11 @@ let diff ~diff_item:{ diff_item } ref_maps curr_maps : 'diff list =
7078
ref_maps.class_map curr_maps.class_map
7179
|> String_map.bindings |> List.map snd
7280
in
81+
let class_type_diffs =
82+
String_map.merge
83+
(fun name ref_opt curr_opt -> diff_item Classtype name ref_opt curr_opt)
84+
ref_maps.class_type_map curr_maps.class_type_map
85+
|> String_map.bindings |> List.map snd
86+
in
7387
value_diffs @ module_diffs @ modtype_diffs @ type_diffs @ class_diffs
88+
@ class_type_diffs

‎lib/sig_item_map.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ type _ item_type =
88
| Modtype : modtype_declaration item_type
99
| Type : (type_declaration * Ident.t) item_type
1010
| Class : class_declaration item_type
11+
| Classtype : class_type_declaration item_type
1112

1213
val empty : t
1314
val add : name:string -> 'a item_type -> 'a -> t -> t

‎lib/text_diff.ml‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,14 @@ let cd_to_lines name cd =
6464
let class_str = Buffer.contents buf in
6565
CCString.lines class_str
6666

67+
let ctd_to_lines name cd =
68+
let buf = Buffer.create 256 in
69+
let formatter = Format.formatter_of_buffer buf in
70+
Printtyp.cltype_declaration (Ident.create_local name) formatter cd;
71+
Format.pp_print_flush formatter ();
72+
let class_str = Buffer.contents buf in
73+
CCString.lines class_str
74+
6775
let process_diff (diff : (_, _ Diff.atomic_modification) Diff.t) name to_lines =
6876
match diff with
6977
| Added item -> [ { orig = []; new_ = to_lines name item } ]
@@ -83,6 +91,14 @@ let process_class_diff (class_diff : Diff.class_) =
8391
| Removed cd -> [ { orig = cd_to_lines class_diff.cname cd; new_ = [] } ]
8492
| Modified _ -> []
8593

94+
let process_class_type_diff (class_type_diff : Diff.cltype) =
95+
match class_type_diff.ctdiff with
96+
| Added ctd ->
97+
[ { orig = []; new_ = ctd_to_lines class_type_diff.ctname ctd } ]
98+
| Removed ctd ->
99+
[ { orig = ctd_to_lines class_type_diff.ctname ctd; new_ = [] } ]
100+
| Modified _ -> []
101+
86102
let rec process_sig_diff :
87103
type a. _ -> (string -> a -> string list) -> (a, _) Diff.t * _ -> _ -> _ =
88104
fun path to_lines ((diff : (a, _) Diff.t), name) acc ->
@@ -135,6 +151,12 @@ and signature_changes module_path items acc =
135151
(function
136152
| None -> Some diff | Some existing -> Some (existing @ diff))
137153
acc'
154+
| Classtype class_type_diff ->
155+
let diff = process_class_type_diff class_type_diff in
156+
String_map.update module_path
157+
(function
158+
| None -> Some diff | Some existing -> Some (existing @ diff))
159+
acc'
138160
| Module sub_module_diff ->
139161
let sub_module_path =
140162
match sub_module_diff.mdiff with

‎tests/api-diff/class_detection.t‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ Run api-diff and check the output
3434
diff module Add_class:
3535
+type add_class = < calculate : float -> float >
3636
+class add_class : object method calculate : float -> float end
37+
+class type add_class = object method calculate : float -> float end
3738

3839
[1]
3940

@@ -51,5 +52,6 @@ Run api-diff and check the output
5152
diff module Remove_class:
5253
-type ref_class = < get : int; set : int -> unit >
5354
-class ref_class : object method get : int method set : int -> unit end
55+
-class type ref_class = object method get : int method set : int -> unit end
5456

5557
[1]

‎tests/api-diff/cltype_tests.t‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
Here we generate a basic `.mli` file with a class type declaration (class interface):
2+
3+
$ cat > ref_cltype.mli << EOF
4+
> class type ref_cltype = object
5+
> method m1 : string
6+
> method m2 : string -> unit
7+
> end
8+
> EOF
9+
10+
We generate .cmi file
11+
$ ocamlc ref_cltype.mli
12+
13+
Now, we run api-diff on the same cmi file as both arguments, there should be no difference
14+
$ api-diff ref_cltype.cmi ref_cltype.cmi
15+
16+
### Adding a new class type:
17+
18+
Generate a new .mli file with an additional class type
19+
$ cat > add_cltype.mli << EOF
20+
> class type ref_cltype = object
21+
> method m1 : string
22+
> method m2 : string -> unit
23+
> end
24+
> class type new_cltype = object
25+
> method mk : int -> unit
26+
> method mn : int -> int
27+
> end
28+
> EOF
29+
30+
Compile the new .mli file to a .cmi file
31+
$ ocamlc add_cltype.mli
32+
33+
Run api-diff and check the output
34+
$ api-diff ref_cltype.cmi add_cltype.cmi
35+
diff module Add_cltype:
36+
+type new_cltype = < mk : int -> unit; mn : int -> int >
37+
+class type new_cltype =
38+
+ object method mk : int -> unit method mn : int -> int end
39+
40+
[1]
41+
42+
### Removing a class type:
43+
44+
Generate a new .mli file with the class type now removed
45+
$ cat > remove_cltype.mli << EOF
46+
> EOF
47+
48+
Compile the new .mli file to a .cmi file
49+
$ ocamlc remove_cltype.mli
50+
51+
Run api-diff and check the output
52+
$ api-diff ref_cltype.cmi remove_cltype.cmi
53+
diff module Remove_cltype:
54+
-type ref_cltype = < m1 : string; m2 : string -> unit >
55+
-class type ref_cltype =
56+
- object method m1 : string method m2 : string -> unit end
57+
58+
[1]

‎tests/api-watch/test_diff_class.ml‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,9 +35,10 @@ let%expect_test "Class Addition" =
3535
Format.printf "%a" pp_diff_option result;
3636
[%expect
3737
{|
38-
Some (Module Main: {Modified (Supported [ Type (cls3, Added);
39-
Class (cls3, Added)])})
40-
|}]
38+
Some (Module Main: {Modified (Supported [ Type (cls3, Added);
39+
Class (cls3, Added);
40+
Class_type (cls3, Added)])})
41+
|}]
4142
with e ->
4243
Format.printf "Error: %s" (Printexc.to_string e);
4344
[%expect.unreachable]
@@ -69,7 +70,8 @@ let%expect_test "Class Removal" =
6970
[%expect
7071
{|
7172
Some (Module Main: {Modified (Supported [ Type (cls2, Removed);
72-
Class (cls2, Removed)])})
73+
Class (cls2, Removed);
74+
Class_type (cls2, Removed)])})
7375
|}]
7476
with e ->
7577
Format.printf "Error: %s" (Printexc.to_string e);

‎tests/api-watch/test_diff_cltype.ml‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
open Api_watch
2+
open Test_helpers
3+
4+
let%expect_test "Class type addition" =
5+
let reference = compile_interface {||} in
6+
let current =
7+
compile_interface
8+
{|
9+
class type cltype =
10+
object
11+
method m1 : float
12+
method m2 : int -> int
13+
end
14+
|}
15+
in
16+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
17+
Format.printf "%a" pp_diff_option result;
18+
[%expect
19+
{|
20+
Some (Module Main: {Modified (Supported [ Type (cltype, Added);
21+
Class_type (cltype, Added)])})
22+
|}]
23+
24+
let%expect_test "Class type removal" =
25+
let reference =
26+
compile_interface
27+
{|
28+
class type cltype =
29+
object
30+
method m1 : float
31+
method m2 : int -> int
32+
end
33+
|}
34+
in
35+
let current = compile_interface {||} in
36+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
37+
Format.printf "%a" pp_diff_option result;
38+
[%expect
39+
{|
40+
Some (Module Main: {Modified (Supported [ Type (cltype, Removed);
41+
Class_type (cltype, Removed)])})
42+
|}]

0 commit comments

Comments
 (0)