unikernel/duniverse/mirage/test/functoria/test_graph.ml

@@ -0,0 +1,93 @@
+open Functoria
+
+let x = Impl.v "Foo.Bar" Functoria.job
+let y = Impl.v "X.Y" Functoria.(job @-> job) ~extra_deps:[ Impl.abstract x ]
+let z = Impl.v "Bar" job ~extra_deps:[ Impl.abstract y ]
+
+let z, y, x =
+  let g = Impl.abstract z in
+  let g = Impl.eval ~context:Context.empty g in
+  match Device.Graph.fold List.cons g [] with
+  | [ x; y; z ] -> (x, y, z)
+  | _ -> assert false
+
+let var_name x = Device.Graph.var_name x
+let impl_name x = Device.Graph.impl_name x
+let ident s i = Fmt.str "%s__%d" s i
+
+let test_var_name () =
+  Alcotest.(check string) "x" (ident "foo_bar" 1) (var_name x);
+  Alcotest.(check string) "y" (ident "x_y" 2) (var_name y);
+  Alcotest.(check string) "z" (ident "bar" 3) (var_name z)
+
+let test_impl_name () =
+  Alcotest.(check string) "x" "Foo.Bar" (impl_name x);
+  Alcotest.(check string) "y" (ident "X_y" 2) (impl_name y);
+  Alcotest.(check string) "z" "Bar" (impl_name z)
+
+let d1 = Device.v ~packages:[ package "a" ] "Foo.Bar" job
+let d2 = Device.v ~packages:[ package "b" ] "Foo.Bar" job
+let i1 = of_device d1
+let i2 = of_device d2
+let if1 = if_impl (Key.pure true) i1 i2
+let if2 = if_impl (Key.pure true) i2 i1
+
+let normalise_lines str =
+  let open Astring in
+  let lines = String.cuts ~empty:true ~sep:"\n" str in
+  let lines =
+    List.map
+      (fun line -> if String.for_all Char.Ascii.is_blank line then "" else line)
+      lines
+  in
+  String.concat ~sep:"\n" lines
+
+let graph_str g = normalise_lines (Fmt.to_to_string Impl.pp_dot g)
+
+let digraph i =
+  let j = i + 1 and k = i + 2 in
+  Fmt.str
+    {|digraph G {
+  ordering=out;
+  %d [label="foo_bar__%d\nFoo.Bar\n", shape="box"];
+  %d [label="foo_bar__%d\nFoo.Bar\n", shape="box"];
+  %d [label="If\n"];
+
+  %d -> %d [style="dotted", headport="n"];
+  %d -> %d [style="dotted", headport="n"];
+  %d -> %d [style="bold", style="dotted", headport="n"];
+  }|}
+    i i j j k k i k j k i
+
+let test_graph () =
+  let t1 = Impl.abstract if1 in
+  Alcotest.(check string) "t1.dot" (digraph 1) (graph_str t1);
+  let t2 = Impl.abstract if2 in
+  Alcotest.(check string) "t2.dot" (digraph 1) (graph_str t2);
+  let module M = struct
+    type t = (string * string list) list
+
+    let empty = []
+    let union = List.append
+  end in
+  let packages t =
+    let ctx = Context.empty in
+    Impl.collect
+      (module M)
+      (function
+        | If _ | App -> []
+        | Dev d ->
+            let pkgs = Key.(eval ctx (Device.packages d)) in
+            List.map (fun pkg -> (Package.name pkg, Package.libraries pkg)) pkgs)
+      (Impl.simplify ~full:true ~context:ctx t)
+  in
+  let label = Alcotest.(list (pair string (list string))) in
+  Alcotest.(check label) "t1" [ ("a", [ "a" ]) ] (packages t1);
+  Alcotest.(check label) "t2" [ ("b", [ "b" ]) ] (packages t2)
+
+let suite =
+  [
+    ("var_name", `Quick, test_var_name);
+    ("impl_name", `Quick, test_impl_name);
+    ("test_graph", `Quick, test_graph);
+  ]