Skip to content

Commit a150653

Browse files
marcndoNathanReb
andauthored
detect class declaration (#90)
* detect class declaration * add test for class declaration * add cram test for class declaration * Polish changelog 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 7521196 commit a150653

File tree

9 files changed

+200
-4
lines changed

9 files changed

+200
-4
lines changed

CHANGES.md

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,9 +2,9 @@
22

33
### Added
44

5-
- Add detection of modified type declarations
6-
(#92, @azzsal)
7-
- Add support for module_type declarations (#93, @NchamJosephMuam)
5+
- Add detection of modified type declarations (#92, @azzsal)
6+
- Add detection of module_type declarations changes (#93, @NchamJosephMuam)
7+
- Add detection of classes addition and removal (#90, @marcndo)
88

99
### Changed
1010

lib/diff.ml

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,13 @@ type type_ = {
1717
tdiff : (type_declaration, type_declaration atomic_modification) t;
1818
}
1919

20+
type class_modification = Unsupported
21+
22+
and class_ = {
23+
cname : string;
24+
cdiff : (class_declaration, class_modification) t;
25+
}
26+
2027
type module_ = {
2128
mname : string;
2229
mdiff : (module_declaration, signature_modification) t;
@@ -34,6 +41,7 @@ and sig_item =
3441
| Module of module_
3542
| Type of type_
3643
| Modtype of modtype
44+
| Class of class_
3745

3846
let extract_items items =
3947
List.fold_left
@@ -50,6 +58,8 @@ let extract_items items =
5058
| Sig_type (id, type_decl, _, _) ->
5159
Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Type
5260
(type_decl, id) tbl
61+
| Sig_class (id, cls_decl, _, _) ->
62+
Sig_item_map.add ~name:(Ident.name id) Sig_item_map.Class cls_decl tbl
5363
| _ -> tbl)
5464
Sig_item_map.empty items
5565

@@ -110,6 +120,14 @@ let value_item ~typing_env ~name ~reference ~current =
110120
Some (Value { vname = name; vdiff = Modified { reference; current } })
111121
)
112122

123+
let class_item ~name ~(reference : class_declaration option)
124+
~(current : class_declaration option) =
125+
match (reference, current) with
126+
| None, None -> None
127+
| None, Some curr_cls -> Some (Class { cname = name; cdiff = Added curr_cls })
128+
| Some ref_cls, None -> Some (Class { cname = name; cdiff = Removed ref_cls })
129+
| Some _, Some _ -> None
130+
113131
let rec items ~reference ~current =
114132
let env = Typing_env.for_diff ~reference ~current in
115133
let ref_items = extract_items reference in
@@ -121,6 +139,7 @@ let rec items ~reference ~current =
121139
| Module -> module_item ~typing_env:env ~name ~reference ~current
122140
| Modtype -> module_type_item ~typing_env:env ~name ~reference ~current
123141
| Type -> type_item ~typing_env:env ~name ~reference ~current
142+
| Class -> class_item ~name ~reference ~current
124143
in
125144
Sig_item_map.diff ~diff_item:{ diff_item } ref_items curr_items
126145

lib/diff.mli

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

10+
type class_ = {
11+
cname : string;
12+
cdiff : (Types.class_declaration, class_modification) t;
13+
}
14+
15+
and class_modification = Unsupported
16+
1017
type type_ = {
1118
tname : string;
1219
tdiff : (Types.type_declaration, Types.type_declaration atomic_modification) t;
@@ -29,6 +36,7 @@ and sig_item =
2936
| Module of module_
3037
| Type of type_
3138
| Modtype of modtype
39+
| Class of class_
3240

3341
val interface :
3442
module_name:string ->

lib/sig_item_map.ml

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,20 +5,23 @@ type t = {
55
modules_map : module_declaration String_map.t;
66
modtypes_map : modtype_declaration String_map.t;
77
types_map : (type_declaration * Ident.t) String_map.t;
8+
class_map : class_declaration String_map.t;
89
}
910

1011
type _ item_type =
1112
| Value : value_description item_type
1213
| Module : module_declaration item_type
1314
| Modtype : modtype_declaration item_type
1415
| Type : (type_declaration * Ident.t) item_type
16+
| Class : class_declaration item_type
1517

1618
let empty : t =
1719
{
1820
values_map = String_map.empty;
1921
modules_map = String_map.empty;
2022
modtypes_map = String_map.empty;
2123
types_map = String_map.empty;
24+
class_map = String_map.empty;
2225
}
2326

2427
let add (type a) ~name (item_type : a item_type) (item : a) maps : t =
@@ -29,6 +32,7 @@ let add (type a) ~name (item_type : a item_type) (item : a) maps : t =
2932
| Modtype ->
3033
{ maps with modtypes_map = String_map.add name item maps.modtypes_map }
3134
| Type -> { maps with types_map = String_map.add name item maps.types_map }
35+
| Class -> { maps with class_map = String_map.add name item maps.class_map }
3236

3337
type ('a, 'diff) diff_item =
3438
'a item_type -> string -> 'a option -> 'a option -> 'diff option
@@ -60,4 +64,10 @@ let diff ~diff_item:{ diff_item } ref_maps curr_maps : 'diff list =
6064
ref_maps.types_map curr_maps.types_map
6165
|> String_map.bindings |> List.map snd
6266
in
63-
value_diffs @ module_diffs @ modtype_diffs @ type_diffs
67+
let class_diffs =
68+
String_map.merge
69+
(fun name ref_opt curr_opt -> diff_item Class name ref_opt curr_opt)
70+
ref_maps.class_map curr_maps.class_map
71+
|> String_map.bindings |> List.map snd
72+
in
73+
value_diffs @ module_diffs @ modtype_diffs @ type_diffs @ class_diffs

lib/sig_item_map.mli

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ type _ item_type =
77
| Module : module_declaration item_type
88
| Modtype : modtype_declaration item_type
99
| Type : (type_declaration * Ident.t) item_type
10+
| Class : class_declaration item_type
1011

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

lib/text_diff.ml

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,14 @@ let mtd_to_lines name mtd =
5656
let abstract_module_type_str = "module type " ^ name in
5757
CCString.lines abstract_module_type_str
5858

59+
let cd_to_lines name cd =
60+
let buf = Buffer.create 256 in
61+
let formatter = Format.formatter_of_buffer buf in
62+
Printtyp.class_declaration (Ident.create_local name) formatter cd;
63+
Format.pp_print_flush formatter ();
64+
let class_str = Buffer.contents buf in
65+
CCString.lines class_str
66+
5967
let process_diff (diff : (_, _ Diff.atomic_modification) Diff.t) name to_lines =
6068
match diff with
6169
| Added item -> [ { orig = []; new_ = to_lines name item } ]
@@ -69,6 +77,12 @@ let process_value_diff (val_diff : Diff.value) =
6977
let process_type_diff (type_diff : Diff.type_) =
7078
process_diff type_diff.tdiff type_diff.tname td_to_lines
7179

80+
let process_class_diff (class_diff : Diff.class_) =
81+
match class_diff.cdiff with
82+
| Added cd -> [ { orig = []; new_ = cd_to_lines class_diff.cname cd } ]
83+
| Removed cd -> [ { orig = cd_to_lines class_diff.cname cd; new_ = [] } ]
84+
| Modified _ -> []
85+
7286
let rec process_sig_diff :
7387
type a. _ -> (string -> a -> string list) -> (a, _) Diff.t * _ -> _ -> _ =
7488
fun path to_lines ((diff : (a, _) Diff.t), name) acc ->
@@ -115,6 +129,12 @@ and signature_changes module_path items acc =
115129
(function
116130
| None -> Some diff | Some existing -> Some (existing @ diff))
117131
acc'
132+
| Class class_diff ->
133+
let diff = process_class_diff class_diff in
134+
String_map.update module_path
135+
(function
136+
| None -> Some diff | Some existing -> Some (existing @ diff))
137+
acc'
118138
| Module sub_module_diff ->
119139
let sub_module_path =
120140
match sub_module_diff.mdiff with

tests/api-diff/class_detection.t

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
Here we generate a `.mli` file with the class declaration:
2+
3+
$ cat > ref_class.mli << EOF
4+
> class ref_class : object
5+
> method get : int
6+
> method set : int -> unit
7+
> end
8+
> EOF
9+
10+
We generate .cmi file
11+
$ ocamlc ref_class.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_class.cmi ref_class.cmi
15+
16+
### Adding a new class:
17+
18+
Generate a new .mli file with an additional class
19+
$ cat > add_class.mli << EOF
20+
> class ref_class : object
21+
> method get : int
22+
> method set : int -> unit
23+
> end
24+
> class add_class : object
25+
> method calculate : float -> float
26+
> end
27+
> EOF
28+
29+
Compile the new .mli file to a .cmi file
30+
$ ocamlc add_class.mli
31+
32+
Run api-diff and check the output
33+
$ api-diff ref_class.cmi add_class.cmi
34+
diff module Add_class:
35+
+type add_class = < calculate : float -> float >
36+
+class add_class : object method calculate : float -> float end
37+
38+
[1]
39+
40+
### Removing a class:
41+
42+
Generate a new .mli file with the class now removed
43+
$ cat > remove_class.mli << EOF
44+
> EOF
45+
46+
Compile the new .mli file to a .cmi file
47+
$ ocamlc remove_class.mli
48+
49+
Run api-diff and check the output
50+
$ api-diff ref_class.cmi remove_class.cmi
51+
diff module Remove_class:
52+
-type ref_class = < get : int; set : int -> unit >
53+
-class ref_class : object method get : int method set : int -> unit end
54+
55+
[1]

tests/api-watch/test_diff_class.ml

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
open Api_watch
2+
open Test_helpers
3+
4+
let%expect_test "Class Addition" =
5+
let reference =
6+
{|
7+
class cls1 : object
8+
method m1 : int -> int
9+
end
10+
class cls2 : object
11+
method m2 : string -> string
12+
end
13+
|}
14+
in
15+
let current =
16+
{|
17+
class cls1 : object
18+
method m1 : int -> int
19+
end
20+
class cls2 : object
21+
method m2 : string -> string
22+
end
23+
class cls3 : object
24+
method m3 : float -> float
25+
end
26+
|}
27+
in
28+
try
29+
let ref_compiled = compile_interface reference in
30+
let curr_compiled = compile_interface current in
31+
let result =
32+
Diff.interface ~module_name:"Main" ~reference:ref_compiled
33+
~current:curr_compiled
34+
in
35+
Format.printf "%a" pp_diff_option result;
36+
[%expect
37+
{|
38+
Some (Module Main: {Modified (Supported [ Type (cls3, Added);
39+
Class (cls3, Added)])})
40+
|}]
41+
with e ->
42+
Format.printf "Error: %s" (Printexc.to_string e);
43+
[%expect.unreachable]
44+
45+
let%expect_test "Class Removal" =
46+
let reference =
47+
{|
48+
class cls1 : object
49+
method m1 : int -> int
50+
end
51+
class cls2 : object
52+
method m2 : string -> string
53+
end
54+
|}
55+
in
56+
let current = {|
57+
class cls1 : object
58+
method m1 : int -> int
59+
end
60+
|} in
61+
try
62+
let ref_compiled = compile_interface reference in
63+
let curr_compiled = compile_interface current in
64+
let result =
65+
Diff.interface ~module_name:"Main" ~reference:ref_compiled
66+
~current:curr_compiled
67+
in
68+
Format.printf "%a" pp_diff_option result;
69+
[%expect
70+
{|
71+
Some (Module Main: {Modified (Supported [ Type (cls2, Removed);
72+
Class (cls2, Removed)])})
73+
|}]
74+
with e ->
75+
Format.printf "Error: %s" (Printexc.to_string e);
76+
[%expect.unreachable]

tests/test_helpers/test_helpers.ml

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ and pp_item_diff fmt = function
1414
| Module module_diff -> pp_module_diff fmt module_diff
1515
| Type type_diff -> pp_type_diff fmt type_diff
1616
| Modtype module_type_diff -> pp_module_type_diff fmt module_type_diff
17+
| Class class_diff -> pp_class_diff fmt class_diff
1718

1819
and pp_value_diff fmt { vname; vdiff } =
1920
match vdiff with
@@ -43,6 +44,12 @@ and pp_module_type_diff fmt { mtname; mtdiff } =
4344
Format.fprintf fmt "Module_type %s: {Modified (%a)}" mtname
4445
pp_module_modification mtdiff
4546

47+
and pp_class_diff fmt { cname; cdiff } =
48+
match cdiff with
49+
| Added _ -> Format.fprintf fmt "Class (%s, Added)" cname
50+
| Removed _ -> Format.fprintf fmt "Class (%s, Removed)" cname
51+
| Modified _ -> Format.fprintf fmt "Class (%s, Modified)" cname
52+
4653
let pp_diff_option fmt = function
4754
| None -> Format.fprintf fmt "None"
4855
| Some module_diff ->

0 commit comments

Comments
 (0)