mte/unikernel/duniverse/mirage/test/functoria/test_graph.ml
2025-11-11 02:07:51 +01:00

93 lines
2.8 KiB
OCaml

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);
]