Skip to content

Commit c5c2976

Browse files
azzsalNathanReb
azzsal
and
NathanReb
authored
Detect modification of class and class types (#106)
* Add class and class type modification tests * Detect modification in class and class types * Update changelog * Add more tests * Fix typo in class modification test * Fix formatting Signed-off-by: Nathan Rebours <nathan.p.rebours@gmail.com> --------- Signed-off-by: Nathan Rebours <nathan.p.rebours@gmail.com> Co-authored-by: Nathan Rebours <nathan.p.rebours@gmail.com>
1 parent f296974 commit c5c2976

File tree

8 files changed

+192
-28
lines changed

8 files changed

+192
-28
lines changed

‎CHANGES.md‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
- Add detection of classes addition and removal (#90, @marcndo)
88
- Add detection of addition and removal of class type declarations (#103, @azzsal)
99
- Add initial support for unwrapped libraries (#107, @Siddhi-agg, @azzsal)
10+
- Add detection of modified class declarations and class types (#106, @azzsal)
1011

1112
### Changed
1213

‎lib/diff.ml‎

Lines changed: 37 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -22,18 +22,16 @@ and record_field = {
2222
}
2323

2424
type type_ = { tname : string; tdiff : (type_declaration, type_modification) t }
25-
type class_modification = Unsupported
2625

2726
type class_ = {
2827
cname : string;
29-
cdiff : (class_declaration, class_modification) t;
28+
cdiff : (class_declaration, class_declaration atomic_modification) t;
3029
}
3130

32-
type class_type_modification = Unsupported
33-
3431
type cltype = {
3532
ctname : string;
36-
ctdiff : (class_type_declaration, class_type_modification) t;
33+
ctdiff :
34+
(class_type_declaration, class_type_declaration atomic_modification) t;
3735
}
3836

3937
type module_ = {
@@ -185,23 +183,51 @@ let value_item ~typing_env ~name ~reference ~current =
185183
Some (Value { vname = name; vdiff = Modified { reference; current } })
186184
)
187185

188-
let class_item ~name ~(reference : class_declaration option)
186+
let class_item ~typing_env ~name ~(reference : class_declaration option)
189187
~(current : class_declaration option) =
190188
match (reference, current) with
191189
| None, None -> None
192190
| None, Some curr_cls -> Some (Class { cname = name; cdiff = Added curr_cls })
193191
| Some ref_cls, None -> Some (Class { cname = name; cdiff = Removed ref_cls })
194-
| Some _, Some _ -> None
192+
| Some ref_cls, Some curr_cls -> (
193+
let cls_mismatch_lst =
194+
Includeclass.class_declarations typing_env ref_cls curr_cls
195+
in
196+
match cls_mismatch_lst with
197+
| [] -> None
198+
| _ ->
199+
Some
200+
(Class
201+
{
202+
cname = name;
203+
cdiff = Modified { reference = ref_cls; current = curr_cls };
204+
}))
195205

196-
let class_type_item ~name ~(reference : class_type_declaration option)
206+
let class_type_item ~typing_env ~name
207+
~(reference : class_type_declaration option)
197208
~(current : class_type_declaration option) =
198209
match (reference, current) with
199210
| None, None -> None
200211
| None, Some curr_class_type ->
201212
Some (Classtype { ctname = name; ctdiff = Added curr_class_type })
202213
| Some ref_class_type, None ->
203214
Some (Classtype { ctname = name; ctdiff = Removed ref_class_type })
204-
| Some _, Some _ -> None
215+
| Some ref_class_type, Some curr_class_type -> (
216+
let cls_type_mismatch_lst =
217+
Includeclass.class_type_declarations ~loc:ref_class_type.clty_loc
218+
typing_env ref_class_type curr_class_type
219+
in
220+
match cls_type_mismatch_lst with
221+
| [] -> None
222+
| _ ->
223+
Some
224+
(Classtype
225+
{
226+
ctname = name;
227+
ctdiff =
228+
Modified
229+
{ reference = ref_class_type; current = curr_class_type };
230+
}))
205231

206232
let rec items ~reference ~current =
207233
let env = Typing_env.for_diff ~reference ~current in
@@ -214,8 +240,8 @@ let rec items ~reference ~current =
214240
| Module -> module_item ~typing_env:env ~name ~reference ~current
215241
| Modtype -> module_type_item ~typing_env:env ~name ~reference ~current
216242
| Type -> type_item ~typing_env:env ~name ~reference ~current
217-
| Class -> class_item ~name ~reference ~current
218-
| Classtype -> class_type_item ~name ~reference ~current
243+
| Class -> class_item ~typing_env:env ~name ~reference ~current
244+
| Classtype -> class_type_item ~typing_env:env ~name ~reference ~current
219245
in
220246
Sig_item_map.diff ~diff_item:{ diff_item } ref_items curr_items
221247

‎lib/diff.mli‎

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

10-
type class_modification = Unsupported
11-
1210
and class_ = {
1311
cname : string;
14-
cdiff : (Types.class_declaration, class_modification) t;
12+
cdiff :
13+
(Types.class_declaration, Types.class_declaration atomic_modification) t;
1514
}
1615

17-
type class_type_modification = Unsupported
18-
1916
and cltype = {
2017
ctname : string;
21-
ctdiff : (Types.class_type_declaration, class_type_modification) t;
18+
ctdiff :
19+
( Types.class_type_declaration,
20+
Types.class_type_declaration atomic_modification )
21+
t;
2222
}
2323

2424
type type_modification =

‎lib/text_diff.ml‎

Lines changed: 2 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -138,19 +138,10 @@ and process_changed_labels (lbls_diffs : Diff.record_field list) =
138138
lbls_diffs)
139139

140140
let process_class_diff (class_diff : Diff.class_) =
141-
match class_diff.cdiff with
142-
| Added cd -> [ Change { orig = []; new_ = cd_to_lines class_diff.cname cd } ]
143-
| Removed cd ->
144-
[ Change { orig = cd_to_lines class_diff.cname cd; new_ = [] } ]
145-
| Modified _ -> []
141+
process_atomic_diff class_diff.cdiff class_diff.cname cd_to_lines
146142

147143
let process_class_type_diff (class_type_diff : Diff.cltype) =
148-
match class_type_diff.ctdiff with
149-
| Added ctd ->
150-
[ Change { orig = []; new_ = ctd_to_lines class_type_diff.ctname ctd } ]
151-
| Removed ctd ->
152-
[ Change { orig = ctd_to_lines class_type_diff.ctname ctd; new_ = [] } ]
153-
| Modified _ -> []
144+
process_atomic_diff class_type_diff.ctdiff class_type_diff.ctname ctd_to_lines
154145

155146
let rec process_sig_diff :
156147
type a. _ -> (string -> a -> string list) -> (a, _) Diff.t * _ -> _ -> _ =

‎tests/api-diff/class_detection.t‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,3 +51,25 @@ Run api-diff and check the output
5151
-class ref_class : object method get : int method set : int -> unit end
5252

5353
[1]
54+
55+
### Modifing a class:
56+
57+
$ cat > modify_class.mli <<EOF
58+
> class ref_class : object
59+
> method set : int -> int
60+
> method size : int
61+
> end
62+
> EOF
63+
64+
We generate a .cmi file
65+
66+
$ ocamlc modify_class.mli
67+
68+
Run api-watcher on the two cmi files, there should be a difference
69+
70+
$ api-diff ref_class.cmi modify_class.cmi
71+
diff module Modify_class:
72+
-class ref_class : object method get : int method set : int -> unit end
73+
+class ref_class : object method set : int -> int method size : int end
74+
75+
[1]

‎tests/api-diff/cltype_tests.t‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,3 +54,27 @@ Run api-diff and check the output
5454
- object method m1 : string method m2 : string -> unit end
5555

5656
[1]
57+
58+
### Modifing a class type:
59+
60+
$ cat > modify_cltype.mli << EOF
61+
> class type ref_cltype = object
62+
> method m2 : float -> unit
63+
> method m3 : int -> float
64+
> end
65+
> EOF
66+
67+
We generate a .cmi file
68+
69+
$ ocamlc modify_cltype.mli
70+
71+
Run api-watcher on the two cmi files, there should be a difference
72+
73+
$ api-diff ref_cltype.cmi modify_cltype.cmi
74+
diff module Modify_cltype:
75+
-class type ref_cltype =
76+
- object method m1 : string method m2 : string -> unit end
77+
+class type ref_cltype =
78+
+ object method m2 : float -> unit method m3 : int -> float end
79+
80+
[1]

‎tests/api-watch/test_diff_class.ml‎

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -68,3 +68,52 @@ let%expect_test "Class Removal" =
6868
with e ->
6969
Format.printf "Error: %s" (Printexc.to_string e);
7070
[%expect.unreachable]
71+
72+
let%expect_test "Class Modification" =
73+
let reference =
74+
compile_interface
75+
{|
76+
class cls1 : object
77+
method m1: int -> int
78+
method m2: int -> char
79+
end
80+
|}
81+
in
82+
let current =
83+
compile_interface
84+
{|
85+
class cls1 : object
86+
method m2: float -> float
87+
method m3: char -> char
88+
end
89+
|}
90+
in
91+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
92+
Format.printf "%a" pp_diff_option result;
93+
[%expect
94+
{| Some (Module Main: {Modified (Supported [ Class (cls1, Modified)])}) |}]
95+
96+
let%expect_test "Class Modification" =
97+
let reference =
98+
compile_interface
99+
{|
100+
class cls1 : object
101+
method m1: int -> int
102+
method m2: char -> int
103+
end
104+
|}
105+
in
106+
let current =
107+
compile_interface
108+
{|
109+
class cls1 : object
110+
method m1: int -> int
111+
method m2: char -> int
112+
method m3: string -> string
113+
end
114+
|}
115+
in
116+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
117+
Format.printf "%a" pp_diff_option result;
118+
[%expect
119+
{| Some (Module Main: {Modified (Supported [ Class (cls1, Modified)])}) |}]

‎tests/api-watch/test_diff_cltype.ml‎

Lines changed: 51 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,3 +34,54 @@ let%expect_test "Class type removal" =
3434
Format.printf "%a" pp_diff_option result;
3535
[%expect
3636
{| Some (Module Main: {Modified (Supported [ Class_type (cltype, Removed)])}) |}]
37+
38+
let%expect_test "Class type modification" =
39+
let reference =
40+
compile_interface
41+
{|
42+
class type cltype =
43+
object
44+
method m1 : float
45+
method m2 : int -> int
46+
end
47+
|}
48+
in
49+
let current =
50+
compile_interface
51+
{|
52+
class type cltype =
53+
object
54+
method m2 : int -> float
55+
method m3 : float -> float
56+
end
57+
|}
58+
in
59+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
60+
Format.printf "%a" pp_diff_option result;
61+
[%expect
62+
{| Some (Module Main: {Modified (Supported [ Class_type (cltype, Modified)])}) |}]
63+
64+
let%expect_test "Class type modification" =
65+
let reference =
66+
compile_interface
67+
{|
68+
class type cltype =
69+
object
70+
method m1 : float
71+
end
72+
|}
73+
in
74+
let current =
75+
compile_interface
76+
{|
77+
class type cltype =
78+
object
79+
method m1 : float
80+
method m2 : int -> int
81+
end
82+
|}
83+
in
84+
let result = Diff.interface ~module_name:"Main" ~reference ~current in
85+
Format.printf "%a" pp_diff_option result;
86+
[%expect
87+
{| Some (Module Main: {Modified (Supported [ Class_type (cltype, Modified)])}) |}]

0 commit comments

Comments
 (0)