package pfff

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file unit_graph_code.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
open Common

open OUnit

open Dependencies_matrix_code
module E = Entity_code
module G = Graph_code
module DM = Dependencies_matrix_code
module DMBuild = Dependencies_matrix_build

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

(*****************************************************************************)
(* Data *)
(*****************************************************************************)
let build_g_and_dm () =
  let g = G.create () in
  g +> G.add_node (".", E.Dir);
  g +> G.add_node ("foo.ml", E.File);
  g +> G.add_node ("a", E.Dir);
  g +> G.add_node ("a/x.ml", E.File);
  g +> G.add_node ("a/y.ml", E.File);
  g +> G.add_node ("bar.ml", E.File);
  g +> G.add_edge ((".", E.Dir), ("foo.ml", E.File)) G.Has;
  g +> G.add_edge ((".", E.Dir), ("bar.ml", E.File)) G.Has;
  g +> G.add_edge ((".", E.Dir), ("a", E.Dir)) G.Has;
  g +> G.add_edge (("a", E.Dir), ("a/x.ml", E.File)) G.Has;
  g +> G.add_edge (("a", E.Dir), ("a/y.ml", E.File)) G.Has;

  g +> G.add_edge (("a/x.ml", E.File), ("foo.ml", E.File)) G.Use;
  g +> G.add_edge (("a/y.ml", E.File), ("foo.ml", E.File)) G.Use;
  g +> G.add_edge (("bar.ml", E.File), ("foo.ml", E.File)) G.Use;
  g +> G.add_edge (("a/y.ml", E.File), ("a/x.ml", E.File)) G.Use;
  g +> G.add_edge (("bar.ml", E.File), ("a/y.ml", E.File)) G.Use;

  let dm = {
    matrix = [|
      [| 0; 0; 0; 0|];
      [| 1; 0; 0; 0|];
      [| 1; 2; 0; 0|];
      [| 1; 0; 3; 0|];
    |];
    name_to_i = Common.hash_of_list [
      ("foo.ml", E.File), 0;
      ("a/x.ml", E.File), 1;
      ("a/y.ml", E.File), 2;
      ("bar.ml", E.File), 3;
    ];
    i_to_name = [|
      ("foo.ml", E.File);
      ("a/x.ml", E.File);
      ("a/y.ml", E.File);
      ("bar.ml", E.File);
    |];
    config = 
      Node ((".", E.Dir), [
        Node (("foo.ml", E.File), []);
        Node (("a", E.Dir), [
          Node (("a/x.ml", E.File), []);
          Node (("a/y.ml", E.File), []);
        ]);
        Node (("bar.ml", E.File), []);
      ]);
  } in
  g, dm

(*****************************************************************************)
(* Unit tests *)
(*****************************************************************************)

let unittest ~graph_of_string =
  "graph_code" >::: [

(*---------------------------------------------------------------------------*)
(* The graph *)
(*---------------------------------------------------------------------------*)
    "graph" >::: [
      
      "scc" >:: (fun () ->
        let g = G.create () in
        let (-->) f1 f2 =
          let f1 = f1, E.Function in
          let f2 = f2, E.Function in
          if not (G.has_node f1 g)
          then G.add_node f1 g;
          if not (G.has_node f2 g)
          then G.add_node f2 g;
          G.add_edge (f1, f2) G.Use g
        in
        (* foo -> bar <-> bar_mutual
         *          \
         *           -> bar_bis
         *)
        "foo" --> "bar";
        "bar" --> "bar_mutual";
        "bar_mutual" --> "bar";
        "bar" --> "bar_bis";
        
        let (scc, _hscc) = G.strongly_connected_components_use_graph g in
        assert_equal
          ~msg:"it should find the right strongly connected components"
          [|
            [("bar_bis", E.Function)];
            [("bar_mutual", E.Function); ("bar", E.Function)];
            [("foo", E.Function)]
          |]
          scc;

        let numbering = G.top_down_numbering g in
        let xs = Common.hash_to_list numbering +> Common.sort_by_val_lowfirst in
        assert_equal
          ~msg:"it should find the right ordering of nodes"
          [("foo", E.Function), 0;
           ("bar", E.Function), 1;
           ("bar_mutual", E.Function), 1;
           ("bar_bis", E.Function), 2;
          ]
          xs;

        let numbering = G.bottom_up_numbering g in
        let xs = Common.hash_to_list numbering +> Common.sort_by_val_lowfirst in
        assert_equal
          ~msg:"it should find the right ordering of nodes" 
          [
            ("bar_bis", E.Function), 0;
            ("bar", E.Function), 1;
            ("bar_mutual", E.Function), 1;
            ("foo", E.Function), 2;
          ]
          xs;
      );


      "adjust graph" >:: (fun () ->
        let (g, _dm) = build_g_and_dm () in
        let adjust = [("a", "EXTRA_DIR")] in
        Graph_code.adjust_graph g adjust [];
        let gopti = Graph_code_opti.convert g in
        let config = DM.basic_config g in
        let _dm = DMBuild.build config None gopti in
        ()
      );

      "create fake dotdotdot entries" >:: (fun () ->
        let (g, _dm) = build_g_and_dm () in
        let gopti = Graph_code_opti.convert g in
        Common.save_excursion DMBuild.threshold_pack 2 (fun () ->
          let config = DM.basic_config_opti gopti in
          let dm, gopti = DMBuild.build config None gopti in
          let config2 = 
            DM.expand_node_opti ("./...", E.Dir) dm.config gopti in
          let dm, gopti = DMBuild.build config2 None gopti in
          (* pr2_gen dm; *)
          let _xs = DM.explain_cell_list_use_edges (1, 0) dm gopti in
          (* pr2_gen xs *)
          ()
        )
      );

(*
      "uses and users of file XXX" >:: (fun () ->
        let g = G.create () in
        let nodeinfo f =
          { G.
            props = [];
            pos = { Parse_info.
              str = ""; charpos = -1; line = 1; column = 0;
              file = fst f ^ ".php";
            };
          }
        in
        let (-->) f1 f2 =
          let f1 = f1, E.Function in
          let f2 = f2, E.Function in
          if not (G.has_node f1 g)
          then begin 
            G.add_node f1 g;
            G.add_nodeinfo f1 (nodeinfo f1) g;
          end;
          if not (G.has_node f2 g)
          then begin 
            G.add_node f2 g;
            G.add_nodeinfo f2 (nodeinfo f2) g;
          end;
          G.add_edge (f1, f2) G.Use g
        in
        (* foo.php -> bar.php <-> bar_mutial.php
         *  \
         *   -> bar_bis.php
         *)
        "foo" --> "bar";
        "bar" --> "bar_mutual";
        "bar_mutual" --> "bar";
        "bar" --> "bar_bis";

        let uses_of_file, users_of_file =
          Graph_code_analysis.build_uses_and_users_of_file g in
        let uses = List.assoc "bar.php" uses_of_file in
        let users = List.assoc "bar.php" users_of_file in
        assert_equal
          ~msg:"it should find all uses"
          ["bar_bis.php"; "bar_mutual.php"]
          uses;
        assert_equal
          ~msg:"it should find all users"
          ["bar_mutual.php"; "foo.php"]
          users;
      );
*)
   
      "class analysis" >:: (fun () ->
        let file_content = "
class A { 
public function foo() { }
}
class B extends A { 
public function foo() { }
}
class C {
public function foo() { }
}
" in
        let g = graph_of_string file_content in
        let dag = Graph_code_class_analysis.class_hierarchy g in
        
        let node = ("A", E.Class) in
        let children = Graphe.succ node dag in
        assert_equal ~msg:"it should find the direct children of a class"
          ["B"]
          (children +> List.map fst);

        let dag = Graph_code_class_analysis.class_hierarchy g in
        let hmethods = Graph_code_class_analysis.toplevel_methods g dag in
        let xs = Hashtbl.find_all hmethods "foo" in
        assert_equal ~msg:"it should find the toplevel methods"
            ["C.foo";"A.foo"]
            (xs +> List.map fst);

        let node = ("A.foo", E.Method) in
        let methods = Graph_code_class_analysis.dispatched_methods g dag node in
        assert_equal ~msg:"it should find the dispatched methods"
            ["B.foo"]
            (methods +> List.map fst);
      );
    ];

(*---------------------------------------------------------------------------*)
(* The matrix *)
(*---------------------------------------------------------------------------*)

    "dm" >::: [

      "dead columns" >:: (fun () ->
        let (_, dm) = build_g_and_dm () in
        assert_equal false (DM.is_dead_column 0 dm);
        assert_equal true (DM.is_dead_column 3 dm);
        ()
      );
      "internal helpers" >:: (fun () ->
        let (_, dm) = build_g_and_dm () in
        let arr = DM.parents_of_indexes dm in
        assert_equal arr
          [| [(".", E.Dir)];
             [(".", E.Dir); ("a", E.Dir); ];
             [(".", E.Dir); ("a", E.Dir); ];
             [(".", E.Dir)];
          |];
        assert_equal
          ~msg:"It should not find distance between foo.ml and a/x.ml"
          (DM.distance_entity (0, 1) arr) 0;
        assert_equal
          ~msg:"It should find distance between a/x.ml and foo.ml"
          (DM.distance_entity (1, 0) arr) 1;
        assert_equal
          ~msg:"It should not find distance between a/x.ml a/y.ml"
          (DM.distance_entity (1, 2) arr) 0;

        assert_equal 
          false (DM.is_internal_helper 0 dm);
        assert_equal 
          true (DM.is_internal_helper 1 dm);
        assert_equal 
          false (DM.is_internal_helper 2 dm);
      );

      "explain cell" >:: (fun () ->
        let (g, dm) = build_g_and_dm () in
        let gopti = Graph_code_opti.convert g in
        let xs = DM.explain_cell_list_use_edges (2, 1) dm gopti in
        assert_equal xs [
          ("a/y.ml", E.File), ("a/x.ml", E.File);
        ];
      );
    ]
  ]
OCaml

Innovation. Community. Security.