unikernel/duniverse/mirage/test/functoria/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (package mirage)
+ (libraries mirage.functoria alcotest cmdliner rresult astring))

unikernel/duniverse/mirage/test/functoria/e2e/app/app.ml

@@ -0,0 +1,31 @@
+open Cmdliner
+
+let opt =
+  let doc = Arg.info ~doc:"An optional key." [ "opt" ] in
+  Arg.(value & opt string "default" doc)
+
+let opt_all =
+  let doc = Arg.info ~doc:"All the optional keys." [ "opt-all" ] in
+  Arg.(value & opt_all string [] doc)
+
+let flag =
+  let doc = Arg.info ~doc:"A flag." [ "flag" ] in
+  Arg.(value & flag doc)
+
+let required =
+  let doc = Arg.info ~doc:"A required key." [ "required" ] in
+  Arg.(required & opt (some string) None doc)
+
+let hello =
+  let doc = Arg.info ~doc:"How to say hello." [ "hello" ] in
+  Arg.(value @@ opt string "Hello World!" doc)
+
+let arg =
+  let doc =
+    Arg.info ~docs:"APPLICATION OPTIONS" ~doc:"A runtime argument." [ "arg" ]
+  in
+  Arg.(value & opt string "-" doc)
+
+module Make (_ : sig end) = struct
+  let start () hello arg = Fmt.pr "Success: hello=%s arg=%s\n%!" hello arg
+end

unikernel/duniverse/mirage/test/functoria/e2e/app/config.ml

@@ -0,0 +1,30 @@
+open Functoria
+open E2e
+
+let opt = runtime_arg ~pos:__POS__ "App.opt"
+let opt_all = runtime_arg ~pos:__POS__ "App.opt_all"
+let flag = runtime_arg ~pos:__POS__ "App.flag"
+let required = runtime_arg ~pos:__POS__ "App.required"
+
+let runtime_args =
+  [ runtime_arg ~pos:__POS__ "App.hello"; runtime_arg ~pos:__POS__ "App.arg" ]
+
+let keys =
+  let connect _ _ = function
+    | [ opt; opt_all; flag; required ] ->
+        code ~pos:__POS__
+          {|
+      let _ : string = %s
+      and _ : string list = %s
+      and _ : bool = %s
+      and _ : string = %s
+      in
+      return ()|}
+          opt opt_all flag required
+    | _ -> failwith "keys: connect needs exactly 4 arguments"
+  in
+  let runtime_args = [ opt; opt_all; flag; required ] in
+  impl ~connect ~runtime_args "Unit" job
+
+let main = main ~runtime_args ~pos:__POS__ "App.Make" (job @-> job)
+let () = register "noop" [ main $ keys ]

unikernel/duniverse/mirage/test/functoria/e2e/build.t

@@ -0,0 +1,73 @@
+Build an application.
+
+  $ ./test.exe configure --file app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ make build
+  dune build --profile release --root . app/dist
+  Your unikernel binary is now ready in app/dist/noop
+  Execute the binary using solo5-hvt, solo5-spt, xl, ...
+  $ ls -a app/
+  .
+  ..
+  app.ml
+  config.ml
+  dist
+  dune
+  dune.build
+  dune.config
+  main.exe
+  test
+  $ ls -a app/test
+  .
+  ..
+  context
+  dune-workspace.config
+  main.ml
+  noop.opam
+  vote
+  warn_error
+  $ ./app/main.exe --required=foo
+  Success: hello=Hello World! arg=-
+  $ ./test.exe clean --file app/config.ml
+  $ ls -a app/
+  .
+  ..
+  app.ml
+  config.ml
+
+Test `--output`:
+
+  $ ./test.exe configure --file app/config.ml -o toto
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ make build
+  dune build --profile release --root . app/dist
+  Your unikernel binary is now ready in app/dist/toto
+  Execute the binary using solo5-hvt, solo5-spt, xl, ...
+  $ ls -a app/
+  .
+  ..
+  app.ml
+  config.ml
+  dist
+  dune
+  dune.build
+  dune.config
+  test
+  toto.exe
+  $ ls -a app/test
+  .
+  ..
+  context
+  dune-workspace.config
+  noop.opam
+  toto.ml
+  vote
+  warn_error
+  $ ./app/toto.exe --required=foo
+  Success: hello=Hello World! arg=-
+  $ ./test.exe clean --file app/config.ml
+  $ ls -a app/
+  .
+  ..
+  app.ml
+  config.ml

unikernel/duniverse/mirage/test/functoria/e2e/cache.t

@@ -0,0 +1,10 @@
+Test that the cache is escaping entries correctly:
+
+  $ ./test.exe configure --file app/config.ml --vote="foo;;bar;;;\n\nllll;;;sdaads;;\n\t\0"
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ make build
+  dune build --profile release --root . app/dist
+  Your unikernel binary is now ready in app/dist/noop
+  Execute the binary using solo5-hvt, solo5-spt, xl, ...
+  $ cat app/test/vote
+  foo;;bar;;;\n\nllll;;;sdaads;;\n\t\0

unikernel/duniverse/mirage/test/functoria/e2e/clean.t

@@ -0,0 +1,96 @@
+Make sure that clean remove everything:
+
+  $ ./test.exe configure --file app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ ls -a app
+  .
+  ..
+  app.ml
+  config.ml
+  dist
+  dune
+  dune.build
+  dune.config
+  test
+  $ ls -a app/test
+  .
+  ..
+  context
+  dune-workspace.config
+  main.ml
+  noop.opam
+  vote
+  warn_error
+  $ ./test.exe clean -v --file app/config.ml
+  test.exe: [INFO] run: clean:
+                        { "context" = ;
+                          "config_file" = app/config.ml;
+                          "output" = None;
+                          "dry_run" = false }
+  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
+  test.exe: [INFO] Generating: dune-project (base)
+  test.exe: [INFO] Generating: app/dune.config (base)
+  config.exe: [INFO] reading cache app/test/context
+  config.exe: [INFO] Name       noop
+                     Keys       vote=cat (default),
+                                warn_error=false (default)
+  test.exe: [INFO] Skipped ./app
+  test.exe: [INFO] Skipped ./context
+  test.exe: [INFO] Skipped ./errors
+  test.exe: [INFO] Skipped ./help.exe
+  test.exe: [INFO] Skipped ./lib
+  test.exe: [INFO] Skipped ./test.exe
+  $ ls -a app
+  .
+  ..
+  app.ml
+  config.ml
+
+Check that clean works with `--output`:
+
+  $ ./test.exe configure --file app/config.ml --output=toto
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ ls -a app
+  .
+  ..
+  app.ml
+  config.ml
+  dist
+  dune
+  dune.build
+  dune.config
+  test
+  $ ls -a app/test
+  .
+  ..
+  context
+  dune-workspace.config
+  noop.opam
+  toto.ml
+  vote
+  warn_error
+  $ ./test.exe clean -v --file app/config.ml
+  test.exe: [INFO] run: clean:
+                        { "context" = ;
+                          "config_file" = app/config.ml;
+                          "output" = None;
+                          "dry_run" = false }
+  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
+  test.exe: [INFO] Generating: dune-project (base)
+  test.exe: [INFO] Generating: app/dune.config (base)
+  config.exe: [INFO] reading cache app/test/context
+  config.exe: [INFO] Name       noop
+                     Keys       vote=cat (default),
+                                warn_error=false (default)
+                     Output     toto
+  test.exe: [INFO] Skipped ./app
+  test.exe: [INFO] Skipped ./context
+  test.exe: [INFO] Skipped ./errors
+  test.exe: [INFO] Skipped ./help.exe
+  test.exe: [INFO] Skipped ./lib
+  test.exe: [INFO] Skipped ./test.exe
+  $ ls -a app
+  .
+  ..
+  app.ml
+  config.ml

unikernel/duniverse/mirage/test/functoria/e2e/configure.t

@@ -0,0 +1,89 @@
+Check that configure generates the file in the right dir when `--file`
+is passed:
+
+  $ ./test.exe configure -v --file app/config.ml
+  test.exe: [INFO] run: configure:
+                        { "args" =
+                           { "context" = ;
+                             "config_file" = app/config.ml;
+                             "output" = None;
+                             "dry_run" = false };
+                          "depext" = true }
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
+  test.exe: [INFO] Generating: dune-project (base)
+  test.exe: [INFO] Generating: app/dune.config (base)
+  test.exe: [INFO] Preserving arguments in app/test/context:
+                   [|"./test.exe"; "configure"; "-v"; "--file";
+                     "app/config.ml"|]
+  test.exe: [INFO] Set-up config skeleton.
+  config.exe: [INFO] reading cache app/test/context
+  config.exe: [INFO] Name       noop
+                     Keys       vote=cat (default),
+                                warn_error=false (default)
+  config.exe: [INFO] Generating: noop.opam (opam)
+  config.exe: [INFO] in dir { "context" = ;
+                              "config_file" = app/config.ml;
+                              "output" = None;
+                              "dry_run" = false }
+  config.exe: [INFO] Generating: main.ml (main file)
+  config.exe: [INFO] Generating: dune.build (dune.build)
+  config.exe: [INFO] Generating: dune-workspace (dune-workspace)
+  config.exe: [INFO] Generating: dune-project (dune-project)
+  config.exe: [INFO] Generating: dune (dune.dist)
+  $ ls -a app/
+  .
+  ..
+  app.ml
+  config.ml
+  dist
+  dune
+  dune.build
+  dune.config
+  test
+  $ ls -a app/test
+  .
+  ..
+  context
+  dune-workspace.config
+  main.ml
+  noop.opam
+  vote
+  warn_error
+  $ ./test.exe clean --file app/config.ml
+
+Check that configure create the correct context file:
+
+  $ ./test.exe configure --file=app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ cat app/test/context
+  configure
+  --file=app/config.ml
+  $ rm -rf custom_build_
+
+  $ ./test.exe configure --file=app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ cat app/test/context
+  configure
+  --file=app/config.ml
+  $ ./test.exe clean --file=app/config.ml
+
+Check that `test help configure` and `test configure --help` have the
+same output.
+
+  $ ./test.exe help configure --file=app/config.ml --help=plain > h1
+  $ ./test.exe configure --help=plain --file=app/config.ml > h2
+  $ ./help.exe diff h1 h2
+
+Check that `test help configure` works when no config.ml file is present.
+
+  $ ./test.exe configure --help=plain > h0
+  $ ./help.exe show h0 SYNOPSIS | xargs
+  test configure [OPTION]…
+
+Check that errors are reported correcty:
+
+  $ ./test.exe configure a b c --file=app/config.ml 2>&1 | tr -d \'
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  Usage: test configure [--help] [OPTION]…
+  test: too many arguments, dont know what to do with a, b, c

unikernel/duniverse/mirage/test/functoria/e2e/context.t

@@ -0,0 +1,57 @@
+Query package - no target - x.context
+  $ ./test.exe query packages --context-file=context/x.context -f context/config.ml
+  "fmt" { ?monorepo }
+  "mirage-runtime" { ?monorepo }
+  "x" { ?monorepo }
+
+Query package - no target - y.context
+  $ ./test.exe query packages --context-file=context/y.context -f context/config.ml
+  "fmt" { ?monorepo }
+  "mirage-runtime" { ?monorepo }
+  "y" { ?monorepo }
+
+Query package - x target  - y.context
+  $ ./test.exe query packages -t x --context-file=context/y.context -f context/config.ml
+  "fmt" { ?monorepo }
+  "mirage-runtime" { ?monorepo }
+  "x" { ?monorepo }
+
+Query package - y target  - x.context
+  $ ./test.exe query packages -t y --context-file=context/x.context -f context/config.ml
+  "fmt" { ?monorepo }
+  "mirage-runtime" { ?monorepo }
+  "y" { ?monorepo }
+
+Describe - no target - x.context
+  $ ./test.exe describe --context-file=context/x.context -f context/config.ml
+  Name       noop
+  Keys       target=x,
+             vote=cat (default),
+             warn_error=false (default)
+
+Describe - no target - y.context
+  $ ./test.exe describe --context-file=context/y.context -f context/config.ml
+  Name       noop
+  Keys       target=y,
+             vote=cat (default),
+             warn_error=false (default)
+
+Describe - x target  - y.context
+  $ ./test.exe describe -t x --context-file=context/y.context -f context/config.ml
+  Name       noop
+  Keys       target=x,
+             vote=cat (default),
+             warn_error=false (default)
+
+Describe - y target  - x.context
+  $ ./test.exe describe -t y --context-file=context/x.context -f context/config.ml
+  Name       noop
+  Keys       target=y,
+             vote=cat (default),
+             warn_error=false (default)
+
+Bad context cache
+  $ ./test.exe configure -t nonexistent --context-file=context/z.context -f context/config.ml 2>&1 | tr -d \'
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  Usage: test configure [--help] [-t ENUM] [OPTION]…
+  test: option -t: invalid value nonexistent, expected either y or x

unikernel/duniverse/mirage/test/functoria/e2e/context/config.ml

@@ -0,0 +1,17 @@
+open E2e
+open Functoria
+open Cmdliner
+
+let x = Impl.v ~packages:[ package "x" ] "X" job
+let y = Impl.v ~packages:[ package "y" ] "Y" job
+
+let target_conv : [ `X | `Y ] Cmdliner.Arg.conv =
+  Cmdliner.Arg.enum [ ("y", `Y); ("x", `X) ]
+
+let target =
+  let doc = Arg.info ~doc:"Target." [ "t" ] in
+  let key = Key.Arg.opt target_conv `X doc in
+  Key.create "target" key
+
+let main = match_impl (Key.value target) ~default:y [ (`X, x) ]
+let () = register ~src:`None "noop" [ main ]

unikernel/duniverse/mirage/test/functoria/e2e/context/x.context

@@ -0,0 +1,2 @@
+-t
+x

unikernel/duniverse/mirage/test/functoria/e2e/context/y.context

@@ -0,0 +1,2 @@
+-t
+y

unikernel/duniverse/mirage/test/functoria/e2e/context/z.context

@@ -0,0 +1,2 @@
+-t
+nonexistent

unikernel/duniverse/mirage/test/functoria/e2e/describe.t

@@ -0,0 +1,24 @@
+Test that `describe` works as expected:
+
+  $ ./test.exe describe --file app/config.ml
+  Name       noop
+  Keys       vote=cat (default),
+             warn_error=false (default)
+  $ ./test.exe describe -v --file app/config.ml
+  test.exe: [INFO] run: describe:
+                        { "args" =
+                           { "context" = ;
+                             "config_file" = app/config.ml;
+                             "output" = None;
+                             "dry_run" = false };
+                          "dotcmd" = "xdot";
+                          "dot" = false;
+                          "eval" = None }
+  test.exe: [INFO] Generating: app/test/dune-workspace.config (base)
+  test.exe: [INFO] Generating: dune-project (base)
+  test.exe: [INFO] Generating: app/dune.config (base)
+  Name       noop
+  Keys       vote=cat (default),
+             warn_error=false (default)
+  Libraries  fmt, mirage-runtime.functoria
+  Packages   fmt { ?monorepo }, mirage-runtime { ?monorepo }

unikernel/duniverse/mirage/test/functoria/e2e/dune

@@ -0,0 +1,23 @@
+(executable
+ (name test)
+ (modules test)
+ (libraries e2e alcotest cmdliner rresult astring))
+
+(executable
+ (name help)
+ (modules help)
+ (libraries astring fmt))
+
+(cram
+ (deps
+  test.exe
+  help.exe
+  (source_tree app)
+  (source_tree lib)
+  (source_tree errors)
+  (source_tree context)
+  (package mirage)
+  (package mirage-runtime))
+ (enabled_if
+  (<> %{architecture} "i386"))
+ (package mirage))

unikernel/duniverse/mirage/test/functoria/e2e/errors.t

@@ -0,0 +1,53 @@
+Check the locations of error messages when something is wrong in the body
+of a device's connect function:
+
+  $ ./test.exe configure -f errors/in_device.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ dune build
+  File "errors/in_device.ml", line 6, characters 2-26:
+  Error: Unbound value Unikernel_make__4.start'
+  Hint: Did you mean start?
+  [1]
+  $ ./test.exe clean -f errors/in_device.ml
+
+Check what happens when the number of the arguments passed to the functor is
+not the right ones. First, too many parameters:
+
+  $ ./test.exe configure -f errors/in_functor_too_many.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ dune build 2>&1 | head -n1 | cut -d',' -f'-2'
+  File "errors/test/main.ml", line 10
+  $ ./test.exe clean -f errors/in_functor_too_many.ml
+
+Then, not enough:
+
+  $ ./test.exe configure -f errors/in_functor_not_enough.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ dune build
+  File "errors/test/main.ml", line 34, characters 3-26:
+  Error: The module Unikernel_make__4 is a functor, it cannot have any components
+  [1]
+  $ ./test.exe clean -f errors/in_functor_not_enough.ml
+
+Also check that we have proper errors when the config file is missing:
+
+Configure failure
+  $ ./test.exe configure --vote=dog
+  configuration file config.ml missing
+  [1]
+
+Query failure
+  $ ./test.exe query --vote=dog
+  configuration file config.ml missing
+  [1]
+
+Describe failure
+  $ ./test.exe describe --vote=dog
+  configuration file config.ml missing
+  [1]
+
+Clean does not fail
+  $ ./test.exe clean --vote=dog
+
+Help does not fail
+  $ ./test.exe help --man-format=plain > /dev/null

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_device.ml

@@ -0,0 +1,11 @@
+open Functoria
+open E2e
+
+let device =
+  let connect _ modname = function
+    | [ _; _ ] -> code ~pos:__POS__ "%s.start' () ()" modname
+    | _ -> assert false
+  in
+  impl ~connect "Unikernel.Make" (job @-> job @-> job)
+
+let () = register "my-app" [ device $ noop $ noop ]

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_device/unikernel.ml

@@ -0,0 +1,3 @@
+module Make (_ : sig end) (_ : sig end) = struct
+  let start _ _ = ()
+end

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_functor_not_enough.ml

@@ -0,0 +1,5 @@
+open Functoria
+open E2e
+
+let device = main "Unikernel.Make" (job @-> job)
+let () = register "my-app" [ device $ noop ]

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_functor_not_enough/unikernel.ml

@@ -0,0 +1,3 @@
+module Make (_ : sig end) (_ : sig end) = struct
+  let start _ _ = ()
+end

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_functor_too_many.ml

@@ -0,0 +1,5 @@
+open Functoria
+open E2e
+
+let device = main "Unikernel.Make" (job @-> job @-> job @-> job)
+let () = register "my-app" [ device $ noop $ noop $ noop ]

unikernel/duniverse/mirage/test/functoria/e2e/errors/in_functor_too_many/unikernel.ml

@@ -0,0 +1,3 @@
+module Make (_ : sig end) (_ : sig end) = struct
+  let start _ _ = ()
+end

unikernel/duniverse/mirage/test/functoria/e2e/errors/unikernel.ml

@@ -0,0 +1,3 @@
+module Make (_ : sig end) (_ : sig end) = struct
+  let start _ _ = ()
+end

unikernel/duniverse/mirage/test/functoria/e2e/help.ml

@@ -0,0 +1,77 @@
+(*
+ * Copyright (c) 2015 Jeremy Yallop
+ * Copyright (c) 2021 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Astring
+
+(* cut a man page into sections *)
+let by_sections s =
+  let lines = String.cuts ~sep:"\n" s in
+  let return l =
+    match List.rev l with [] -> assert false | h :: t -> (h, t)
+  in
+  let rec aux current sections = function
+    | [] -> List.rev (return current :: sections)
+    | h :: t ->
+        if
+          String.length h > 1
+          && String.for_all (fun x -> Char.Ascii.(is_upper x || is_white x)) h
+        then aux [ h ] (return current :: sections) t
+        else aux (h :: current) sections t
+  in
+  aux [ "INIT" ] [] lines
+
+let sections = [ "CONFIGURE OPTIONS"; "APPLICATION OPTIONS"; "COMMON OPTIONS" ]
+
+let read file =
+  let ic = open_in_bin file in
+  let str = really_input_string ic (in_channel_length ic) in
+  close_in ic;
+  by_sections str
+
+let err_usage () =
+  Fmt.pr "[usage]: ./help.exe [diff|show] PARAMS\n";
+  exit 1
+
+let () =
+  if Array.length Sys.argv <> 4 then err_usage ()
+  else
+    match Sys.argv.(1) with
+    | "diff" ->
+        let s1 = read Sys.argv.(2) in
+        let s2 = read Sys.argv.(3) in
+        List.iter
+          (fun name ->
+            match (List.assoc_opt name s1, List.assoc_opt name s2) with
+            | Some s1, Some s2 ->
+                if List.length s1 <> List.length s2 then
+                  Fmt.failwith "Number of lines in %S differs" name
+                else
+                  List.iter2
+                    (fun s1 s2 ->
+                      if s1 <> s2 then
+                        Fmt.failwith "Lines in section %S differ:\n  %S\n  %S\n"
+                          name s1 s2)
+                    s1 s2
+            | _ -> Fmt.failwith "Section %S differs" name)
+          sections
+    | "show" -> (
+        let s1 = read Sys.argv.(2) in
+        let name = Sys.argv.(3) in
+        match List.assoc_opt name s1 with
+        | None -> ()
+        | Some s -> List.iter print_endline s)
+    | _ -> err_usage ()

unikernel/duniverse/mirage/test/functoria/e2e/help.t

@@ -0,0 +1,186 @@
+Test that the help command works without config file:
+
+  $ ./test.exe help -v --help=plain
+  test.exe: [INFO] run: help:
+                        { "context" = ;
+                          "config_file" = config.ml;
+                          "output" = None;
+                          "dry_run" = false }
+  NAME
+         test-help - Display help about test commands.
+  
+  SYNOPSIS
+         test help [--man-format=FMT] [OPTION]… [TOPIC]
+  
+  DESCRIPTION
+         Prints help.
+  
+         Use `test help topics' to get the full list of help topics.
+  
+  DESCRIBE OPTIONS
+         --eval
+             Fully evaluate the graph before showing it. The default when the
+             unikernel has already been configured.
+  
+         --no-eval
+             Do not evaluate the graph before showing it. See --eval. The
+             default when the unikernel has not been configured.
+  
+  CONFIGURE OPTIONS
+         --context-file=FILE (absent=test.context)
+             The context file to use.
+  
+         --depext
+             Enable call to `opam depext' in the project Makefile.
+  
+         --dry-run
+             Display I/O actions instead of executing them.
+  
+         --extra-repos=NAME1:URL1,NAME2:URL2,...
+         (absent=opam-overlays:https://github.com/dune-universe/opam-overlays.git,mirage-overlays:https://github.com/dune-universe/mirage-opam-overlays.git
+         or MIRAGE_EXTRA_REPOS env)
+             Additional opam-repositories to use when using `opam monorepo
+             lock' to gather local sources. Default:
+             https://github.com/dune-universe/opam-overlays.git &
+             https://github.com/dune-universe/mirage-opam-overlays.git.
+  
+         -f FILE, --file=FILE, --config-file=FILE (absent=config.ml)
+             The configuration file to use.
+  
+         --no-depext
+             Disable call to `opam depext' in the project Makefile.
+  
+         --no-extra-repo
+             Disable the use of any overlay repository.
+  
+         -o FILE, --output=FILE
+             Name of the output file.
+  
+  APPLICATION OPTIONS
+         --vote=VOTE (absent=cat)
+             Vote.
+  
+         --warn-error=BOOL (absent=false)
+             Enable -warn-error when compiling OCaml sources.
+  
+  ARGUMENTS
+         TOPIC
+             The topic to get help on.
+  
+  OPTIONS
+         --man-format=FMT (absent=pager)
+             Show output in format FMT. The value FMT must be one of auto,
+             pager, groff or plain. With auto, the format is pager or plain
+             whenever the TERM env var is dumb or undefined.
+  
+  COMMON OPTIONS
+         --color=WHEN (absent=auto)
+             Colorize the output. WHEN must be one of auto, always or never.
+  
+         --help[=FMT] (default=auto)
+             Show this help in format FMT. The value FMT must be one of auto,
+             pager, groff or plain. With auto, the format is pager or plain
+             whenever the TERM env var is dumb or undefined.
+  
+         -q, --quiet
+             Be quiet. Takes over -v and --verbosity.
+  
+         -v, --verbose
+             Increase verbosity. Repeatable, but more than twice does not bring
+             more.
+  
+         --verbosity=LEVEL (absent=warning)
+             Be more or less verbose. LEVEL must be one of quiet, error,
+             warning, info or debug. Takes over -v.
+  
+         --version
+             Show version information.
+  
+  EXIT STATUS
+         test help exits with:
+  
+         0   on success.
+  
+         123 on indiscriminate errors reported on standard error.
+  
+         124 on command line parsing errors.
+  
+         125 on unexpected internal errors (bugs).
+  
+  ENVIRONMENT
+         These environment variables affect the execution of test help:
+  
+         MIRAGE_EXTRA_REPOS
+             See option --extra-repos.
+  
+  SEE ALSO
+         test(1)
+  
+
+
+As well as the default command:
+
+  $ ./test.exe -v
+  NAME
+         test - The test application builder
+  
+  SYNOPSIS
+         test [COMMAND] …
+  
+  DESCRIPTION
+         The test application builder. It glues together a set of libraries and
+         configuration (e.g. network and storage) into a standalone unikernel
+         or UNIX binary.
+  
+         Use test help <command> for more information on a specific command.
+  
+  COMMANDS
+         clean [OPTION]…
+             Clean the files produced by test for a given application.
+  
+         configure [OPTION]…
+             Configure a test application.
+  
+         describe [OPTION]…
+             Describe a test application.
+  
+         help [--man-format=FMT] [OPTION]… [TOPIC]
+             Display help about test commands.
+  
+         query [OPTION]… [INFO]
+             Query information about the test application.
+  
+  COMMON OPTIONS
+         --color=WHEN (absent=auto)
+             Colorize the output. WHEN must be one of auto, always or never.
+  
+         --help[=FMT] (default=auto)
+             Show this help in format FMT. The value FMT must be one of auto,
+             pager, groff or plain. With auto, the format is pager or plain
+             whenever the TERM env var is dumb or undefined.
+  
+         -q, --quiet
+             Be quiet. Takes over -v and --verbosity.
+  
+         -v, --verbose
+             Increase verbosity. Repeatable, but more than twice does not bring
+             more.
+  
+         --verbosity=LEVEL (absent=warning)
+             Be more or less verbose. LEVEL must be one of quiet, error,
+             warning, info or debug. Takes over -v.
+  
+         --version
+             Show version information.
+  
+  EXIT STATUS
+         test exits with:
+  
+         0   on success.
+  
+         123 on indiscriminate errors reported on standard error.
+  
+         124 on command line parsing errors.
+  
+         125 on unexpected internal errors (bugs).
+  

unikernel/duniverse/mirage/test/functoria/e2e/keys.t

@@ -0,0 +1,22 @@
+Test keys.
+
+  $ ./test.exe configure --file app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ make build
+  dune build --profile release --root . app/dist
+  Your unikernel binary is now ready in app/dist/noop
+  Execute the binary using solo5-hvt, solo5-spt, xl, ...
+  $ cat app/test/vote
+  cat
+  $ ./test.exe clean --file app/config.ml
+
+Change the key at configure time:
+
+  $ ./test.exe configure --file app/config.ml --vote=dog
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ make build
+  dune build --profile release --root . app/dist
+  Your unikernel binary is now ready in app/dist/noop
+  Execute the binary using solo5-hvt, solo5-spt, xl, ...
+  $ cat app/test/vote
+  dog

unikernel/duniverse/mirage/test/functoria/e2e/lib/dune

@@ -0,0 +1,3 @@
+(library
+ (name e2e)
+ (libraries mirage.functoria))

unikernel/duniverse/mirage/test/functoria/e2e/lib/e2e.ml

@@ -0,0 +1,78 @@
+open Functoria
+open Cmdliner
+module Key = Key
+
+let docs = "APPLICATION OPTIONS"
+
+let warn_error =
+  let doc = "Enable -warn-error when compiling OCaml sources." in
+  let doc = Arg.info ~docv:"BOOL" ~doc ~docs [ "warn-error" ] in
+  let key = Key.Arg.opt Arg.bool false doc in
+  Key.create "warn_error" key
+
+let vote =
+  let doc = "Vote." in
+  let doc = Arg.info ~docv:"VOTE" ~doc ~docs [ "vote" ] in
+  let key = Key.Arg.opt Arg.string "cat" doc in
+  Key.create "vote" key
+
+let file_of_key k = Fpath.v Key.(name @@ v k)
+
+let write_key i k f =
+  let context = Info.context i in
+  let file = file_of_key k in
+  let contents = f (Key.get context k) in
+  Action.write_file file contents
+
+module C = struct
+  open Action.Syntax
+
+  let prelude _ =
+    "let (>>=) x f = f x\ntype 'a io = 'a\nlet return x = x\nlet run x = x"
+
+  let name = "test"
+  let version = "1.0~test"
+  let packages = [ package ~sublibs:[ "functoria" ] "mirage"; package "e2e" ]
+  let keys = Key.[ v vote; v warn_error ]
+  let connect _ _ _ = code ~pos:__POS__ "()"
+  let main i = Fpath.(basename @@ rem_ext @@ Info.main i)
+  let config i = Fpath.(basename @@ rem_ext @@ Info.config_file i)
+
+  let dune i =
+    let dune =
+      Dune.stanzaf
+        {|
+(executable
+  (name      %s)
+  (modules   (:standard \ %s))
+  (promote   (until-clean))
+  (libraries cmdliner fmt mirage-runtime.functoria))
+|}
+        (main i) (config i)
+    in
+    [ dune ]
+
+  let configure i =
+    let* () = write_key i vote (fun x -> x) in
+    write_key i warn_error string_of_bool
+
+  let create jobs =
+    let packages = [ package "fmt" ] in
+    let extra_deps = List.map dep jobs in
+    let install i = Install.v ~bin:[ Fpath.(v (main i) + "exe", v "e2e") ] () in
+    impl ~keys ~packages ~connect ~dune ~configure ~extra_deps ~install "E2e"
+      job
+
+  let name_of_target i = Info.name i
+  let target_filename = name_of_target
+  let dune_project = []
+  let dune_workspace = None
+  let context_name _ = "default"
+end
+
+include Lib.Make (C)
+include Tool.Make (C)
+
+let register ?(init = []) ?src name typ =
+  let init = runtime_args sys_argv :: init in
+  register ~init ?src name typ

unikernel/duniverse/mirage/test/functoria/e2e/lib/e2e.mli

@@ -0,0 +1,10 @@
+open Functoria.DSL
+
+val register :
+  ?init:job impl list ->
+  ?src:[ `Auto | `None | `Some of string ] ->
+  string ->
+  job impl list ->
+  unit
+
+val run : unit -> unit

unikernel/duniverse/mirage/test/functoria/e2e/query.t

@@ -0,0 +1,8 @@
+Help query --man-format=plain
+  $ ./test.exe help query --man-format=plain > d1
+
+Help query --help=plain
+  $ ./test.exe query --help=plain > d2
+
+No difference
+  $ diff d1 d2

unikernel/duniverse/mirage/test/functoria/e2e/run.t

@@ -0,0 +1,56 @@
+Run an application
+
+  $ ./test.exe configure --file app/config.ml
+  test.exe: [WARNING] Skipping version check, since our_version ("1.0~test") fails to parse: only digits and . allowed in version
+  $ dune exec -- ./app/main.exe --arg=yo --required=bar
+  Success: hello=Hello World! arg=yo
+  $ dune exec -- ./app/main.exe --help=plain
+  NAME
+         noop
+  
+  SYNOPSIS
+         noop [OPTION]…
+  
+  APPLICATION OPTIONS
+         --arg=VAL (absent=-)
+             A runtime argument.
+  
+  OPTIONS
+         --flag
+             A flag.
+  
+         --hello=VAL (absent=Hello World!)
+             How to say hello.
+  
+         --opt=VAL (absent=default)
+             An optional key.
+  
+         --opt-all=VAL
+             All the optional keys.
+  
+         --required=VAL (required)
+             A required key.
+  
+  COMMON OPTIONS
+         --help[=FMT] (default=auto)
+             Show this help in format FMT. The value FMT must be one of auto,
+             pager, groff or plain. With auto, the format is pager or plain
+             whenever the TERM env var is dumb or undefined.
+  
+  EXIT STATUS
+         noop exits with:
+  
+         0   on success.
+  
+         1   on Solo5 internal error.
+  
+         63  on showing this help.
+  
+         64  on any argument parsing error.
+  
+         125 on unexpected internal errors (bugs) while processing the boot
+             parameters.
+  
+         255 on OCaml uncaught exception.
+  
+  [63]

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

@@ -0,0 +1,18 @@
+(*
+ * Copyright (c) 2015 Jeremy Yallop
+ * Copyright (c) 2021 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let () = E2e.run ()

unikernel/duniverse/mirage/test/functoria/e2e/test.mli

@@ -0,0 +1 @@
+(* empty *)

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

@@ -0,0 +1,10 @@
+let () =
+  Alcotest.run "functoria"
+    [
+      ("cli", Test_cli.suite);
+      ("package", Test_package.suite);
+      ("graph", Test_graph.suite);
+      ("action", Test_action.suite);
+      ("key", Test_key.suite);
+      ("version", Test_version.suite);
+    ]

unikernel/duniverse/mirage/test/functoria/test.mli

@@ -0,0 +1 @@
+(* empty *)

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

@@ -0,0 +1,384 @@
+open Functoria
+open Action.Syntax
+
+let pp_unit ppf () = Fmt.string ppf "()"
+let domain pp = Alcotest.testable (Action.pp_domain pp) (Action.eq_domain ( = ))
+let file = "<file>"
+let dir = "<DIR>"
+let error e = Error (`Msg e)
+let ( ! ) files = Action.env ~files:(`Files files) ()
+let path = Fpath.v "path"
+let other_path = Fpath.v "other_path"
+let dom result env logs = { Action.result; env; logs }
+
+let test_bind () =
+  let got =
+    Action.dry_run
+      ~env:![ (path, file); (other_path, file) ]
+      (let* () = Action.rm path in
+       Action.rm other_path)
+  in
+  Alcotest.check (domain pp_unit) "sequence"
+    (dom (Ok ()) ![] [ "Rm path (removed)"; "Rm other_path (removed)" ])
+    got;
+
+  let got =
+    Action.dry_run
+      ~env:![ (other_path, dir) ]
+      (let* () = Action.rm path in
+       Action.rm other_path)
+  in
+  Alcotest.check (domain pp_unit) "sequence after error"
+    (dom
+       (error "other_path is a directory")
+       ![ (other_path, dir) ]
+       [ "Rm path (no-op)"; "Rm other_path (error)" ])
+    got;
+
+  let got =
+    let value = 5 in
+    Action.dry_run ~env:![]
+      (let* got_value = Action.ok value in
+       Alcotest.check Alcotest.int "value matches" value got_value;
+       Action.ok ())
+  in
+  Alcotest.check (domain pp_unit) "bind passes the correct value to caller code"
+    (dom (Ok ()) ![] []) got
+
+let mk_test ~env ~expected name a ty =
+  let got = Action.dry_run ~env a in
+  Alcotest.check (domain ty) name expected got
+
+let test_seq () =
+  let test msg seq = mk_test msg (Action.seq seq) pp_unit in
+  let test_file b x = Alcotest.(check bool) "file exists" b x in
+  test "simple sequence" ~env:![]
+    ~expected:
+      (dom (Ok ()) ![]
+         [
+           "Write to path (0 bytes)";
+           "Is_file? path -> true";
+           "Rm path (removed)";
+           "Is_file? path -> false";
+         ])
+    Action.
+      [
+        write_file path "";
+        (let+ is_file = is_file path in
+         test_file true is_file);
+        rm path;
+        (let+ is_file = is_file path in
+         test_file false is_file);
+      ]
+
+let test_rm () =
+  let test msg ~path = mk_test msg (Action.rm path) pp_unit in
+
+  test "delete (file)" ~path
+    ~env:![ (path, file); (other_path, file) ]
+    ~expected:(dom (Ok ()) ![ (other_path, file) ] [ "Rm path (removed)" ]);
+
+  let env = ![ (path, dir); (other_path, file) ] in
+  test "delete (dir)" ~path ~env
+    ~expected:(dom (error "path is a directory") env [ "Rm path (error)" ]);
+
+  let env = ![ (other_path, file) ] in
+  test "delete (file does not exist)" ~path ~env
+    ~expected:(dom (Ok ()) env [ "Rm path (no-op)" ])
+
+let test_mkdir () =
+  let test msg ~path = mk_test msg (Action.mkdir path) Fmt.bool in
+
+  test "mkdir (new dir)" ~path
+    ~env:![ (other_path, file) ]
+    ~expected:
+      (dom (Ok true)
+         ![ (other_path, file); (path, dir) ]
+         [ "Mkdir path (created)" ]);
+
+  let env = ![ (other_path, file); (path, dir) ] in
+  test "mdkir (existing dir)" ~path ~env
+    ~expected:(dom (Ok false) env [ "Mkdir path (already exists)" ]);
+
+  let env = ![ (path, file) ] in
+  test "mdkir (existing file)" ~path ~env
+    ~expected:
+      (dom
+         (error "a file named 'path' already exists")
+         env [ "Mkdir path (error)" ])
+
+let test_rmdir () =
+  let test msg ~path = mk_test msg (Action.rmdir path) pp_unit in
+
+  let env = ![ (other_path, dir) ] in
+  test "rmdir (non-existing dir)" ~path ~env
+    ~expected:(dom (Ok ()) env [ "Rmdir path (no-op)" ]);
+
+  test "rmdir (existing dir)" ~path
+    ~env:![ (path, file); (other_path, dir) ]
+    ~expected:(dom (Ok ()) ![ (other_path, dir) ] [ "Rmdir path (removed)" ]);
+
+  let env =
+    ![
+       (other_path, file); (Fpath.(path / "1"), dir); (Fpath.(path / "2"), file);
+     ]
+  in
+  test "rmdir (dir with contents)" ~path ~env
+    ~expected:(dom (Ok ()) ![ (other_path, file) ] [ "Rmdir path (removed)" ])
+
+let test_with_dir () =
+  let test msg ~path op = mk_test msg (Action.with_dir path op) pp_unit in
+
+  test "with_dir (create file)" ~path ~env:![]
+    ~expected:
+      (dom (Ok ())
+         ![ (Fpath.(path // other_path), file) ]
+         [ "With_dir path [Write to other_path (6 bytes)]" ])
+    (fun () -> Action.write_file other_path file)
+
+let test_pwd () =
+  let test msg = mk_test msg (Action.pwd ()) Fpath.pp in
+
+  test "pwd (root)" ~env:![]
+    ~expected:(dom (Ok (Fpath.v "/")) ![] [ "Pwd -> /" ]);
+
+  let env = Action.env ~pwd:(Fpath.v "/foo/bar") () in
+  test "pwd (env)" ~env
+    ~expected:(dom (Ok (Fpath.v "/foo/bar")) env [ "Pwd -> /foo/bar" ])
+
+let test_is_file () =
+  let test msg ~path = mk_test msg (Action.is_file path) Fmt.bool in
+
+  let env = ![ (path, file) ] in
+  test "file exists (true)" ~path ~env
+    ~expected:(dom (Ok true) env [ "Is_file? path -> true" ]);
+
+  let env = ![ (other_path, file) ] in
+  test "file exists (false)" ~path ~env
+    ~expected:(dom (Ok false) env [ "Is_file? path -> false" ])
+
+let test_is_dir () =
+  let test msg ~path = mk_test msg (Action.is_dir path) Fmt.bool in
+
+  let env = ![ (path, dir) ] in
+  test "dir exists (exact dir)" ~path ~env
+    ~expected:(dom (Ok true) env [ "Is_dir? path -> true" ]);
+
+  let env = ![ (path, file) ] in
+  test "dir exists (file)" ~path ~env
+    ~expected:(dom (Ok false) env [ "Is_dir? path -> false" ]);
+
+  let env = ![ (other_path, file) ] in
+  test "dir exists (false)" ~path ~env
+    ~expected:(dom (Ok false) env [ "Is_dir? path -> false" ]);
+
+  let env = ![ (Fpath.(path / "1"), file) ] in
+  test "dir exists (with a file in it)" ~path ~env
+    ~expected:(dom (Ok true) env [ "Is_dir? path -> true" ])
+
+let test_size_of () =
+  let test msg ~path =
+    mk_test msg (Action.size_of path) Fmt.(Dump.option int)
+  in
+
+  let env = ![ (path, "") ] in
+  test "size_of (empty)" ~path ~env
+    ~expected:(dom (Ok (Some 0)) env [ "Size_of path -> 0" ]);
+
+  let env = ![] in
+  test "size_of (error)" ~path ~env
+    ~expected:(dom (Ok None) env [ "Size_of path -> error" ]);
+
+  let env = ![ (path, String.make 10_000 'a') ] in
+  test "size_of (large)" ~path ~env
+    ~expected:(dom (Ok (Some 10_000)) env [ "Size_of path -> 10000" ])
+
+let test_set_var () =
+  let test msg ~key ~value = mk_test msg (Action.set_var key value) pp_unit in
+
+  let env = Action.env ~env:[ ("var", "v") ] () in
+  test "set_var (unset)" ~key:"var" ~value:None ~env
+    ~expected:(dom (Ok ()) ![] [ "Set_var var <unset>" ]);
+
+  let new_v = "new_v" in
+  let env = Action.env ~env:[ ("var", new_v) ] () in
+  test "set_var (new)" ~key:"var" ~value:(Some new_v) ~env:![]
+    ~expected:(dom (Ok ()) env [ "Set_var var new_v" ]);
+
+  let new_v = "new_v" in
+  let env v = Action.env ~env:[ ("var", v) ] () in
+  test "set_var (overwrite)" ~key:"var" ~value:(Some new_v) ~env:(env "v")
+    ~expected:(dom (Ok ()) (env new_v) [ "Set_var var new_v" ])
+
+let test_get_var () =
+  let test msg ~key =
+    mk_test msg (Action.get_var key) Fmt.(Dump.option string)
+  in
+
+  let v = "v" in
+  let env = Action.env ~env:[ ("var", v) ] () in
+  test "get_var (existing)" ~key:"var" ~env
+    ~expected:(dom (Ok (Some v)) env [ "Get_var var -> v" ]);
+
+  let env = ![] in
+  test "get_var (not set)" ~key:"var" ~env
+    ~expected:(dom (Ok None) env [ "Get_var var -> <not set>" ])
+
+let none _ = None
+let yay _ = Some ("yay", "")
+let yay_err _ = Some ("yay", "err")
+
+let test_run_cmd () =
+  let test msg ?err ?out ~exec ~cmd ~expected ~expected_log () =
+    let env = Action.env ~exec () in
+    let got = Action.dry_run ~env (Action.run_cmd ?err ?out cmd) in
+    Alcotest.check (domain pp_unit) msg (dom expected env expected_log) got
+  in
+  test "run_cmd fails if the command doesn't exist" ~exec:none
+    ~cmd:(Bos.Cmd.v "some-command")
+    ~expected:(error "'some-command' not found")
+    ~expected_log:[ "Run_cmd 'some-command' (error)" ]
+    ();
+
+  let cmd = Bos.Cmd.v "some-command" in
+  test "run_cmd succeeds if the command exists" ~exec:yay ~cmd ~expected:(Ok ())
+    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
+    ();
+
+  let err_b = Buffer.create 10 in
+  let err = `Fmt (Fmt.with_buffer err_b) in
+  let out_b = Buffer.create 10 in
+  let out = `Fmt (Fmt.with_buffer out_b) in
+  test "run_cmd succeeds if the command exists" ~exec:yay_err ~cmd ~out ~err
+    ~expected:(Ok ())
+    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
+    ();
+  Alcotest.(check string) "cmd out" "yay" (Buffer.contents out_b);
+  Alcotest.(check string) "cmd err" "err" (Buffer.contents err_b)
+
+let test_run_cmd_out () =
+  let test msg ?err ~exec ~cmd ~expected ~expected_log () =
+    let env = Action.env ~exec () in
+    let got = Action.dry_run ~env (Action.run_cmd_out ?err cmd) in
+    Alcotest.check (domain Fmt.string) msg (dom expected env expected_log) got
+  in
+  test "run_cmd_out fails if the command doesn't exist" ~exec:none
+    ~cmd:(Bos.Cmd.v "some-command")
+    ~expected:(error "'some-command' not found")
+    ~expected_log:[ "Run_cmd 'some-command' (error)" ]
+    ();
+
+  let cmd = Bos.Cmd.v "some-command" in
+  test "run_cmd_out succeeds if the command exists" ~exec:yay ~cmd
+    ~expected:(Ok "yay")
+    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
+    ();
+
+  let err_b = Buffer.create 10 in
+  let err = `Fmt (Fmt.with_buffer err_b) in
+  test "run_cmd_out succeeds if the command exists" ~exec:yay_err ~cmd ~err
+    ~expected:(Ok "yay")
+    ~expected_log:[ "Run_cmd 'some-command' (ok)" ]
+    ();
+  Alcotest.(check string) "cmd_out err" "err" (Buffer.contents err_b)
+
+let test_write_file () =
+  let test msg ~path ~contents =
+    mk_test msg (Action.write_file path contents) pp_unit
+  in
+
+  let contents = "contents" in
+  test "write to nonexisting file" ~path ~env:![] ~contents
+    ~expected:(dom (Ok ()) ![ (path, contents) ] [ "Write to path (8 bytes)" ]);
+
+  let contents = "new contents" in
+  test "write to existing file" ~path
+    ~env:![ (path, contents) ]
+    ~contents
+    ~expected:(dom (Ok ()) ![ (path, contents) ] [ "Write to path (12 bytes)" ])
+
+let test_tmp_file () =
+  let test msg ~pat = mk_test msg (Action.tmp_file pat) Fpath.pp in
+  let pat : Bos.OS.File.tmp_name_pat = "path-%s" in
+  let path0 = Fpath.(v "/tmp" / Fmt.str pat "0") in
+  let env = ![] in
+  test "create a temp file (no conflicts)" ~env ~pat
+    ~expected:(dom (Ok path0) env [ "Tmp_file -> /tmp/path-0" ]);
+
+  let pat : Bos.OS.File.tmp_name_pat = "path-%s" in
+  let pathn n = Fpath.(v "/tmp" / Fmt.str pat (string_of_int n)) in
+  let env = ![ (pathn 0, file); (pathn 1, file); (pathn 3, file) ] in
+  test "create a temp file (with conflicts)" ~env ~pat
+    ~expected:(dom (Ok (pathn 2)) env [ "Tmp_file -> /tmp/path-2" ])
+
+let test_ls () =
+  let all _ = true in
+  let test msg ~path =
+    mk_test msg (Action.ls path all) (Fmt.Dump.list Fpath.pp)
+  in
+
+  let env = ![] in
+  test "list a non-existig path (error)" ~env ~path
+    ~expected:
+      (dom (error "path: no such file or directory") env [ "Ls path (error)" ]);
+
+  let root = Fpath.v "root" in
+  let pathn n = Fpath.(root / string_of_int n) in
+  let env = ![ (pathn 0, file); (pathn 1, file); (pathn 2, file) ] in
+  test "list a directory" ~env ~path:root
+    ~expected:
+      (dom (Ok Fpath.[ v "0"; v "1"; v "2" ]) env [ "Ls root (3 entries)" ]);
+
+  let env = ![ (path, dir) ] in
+  test "list an empty directory" ~env ~path
+    ~expected:(dom (Ok []) env [ "Ls path (0 entry)" ]);
+
+  let env = ![ (path, file) ] in
+  test "list a file" ~env ~path
+    ~expected:(dom (Ok [ path ]) env [ "Ls path (1 entry)" ])
+
+let test_with_output () =
+  let test msg ~contents ~expected =
+    let env = ![] in
+    let mode = 0o755 in
+    let purpose = "PURPOSE" in
+    let called = ref false in
+    let got =
+      Action.dry_run ~env
+      @@ Action.with_output ~mode ~path ~purpose (fun fmt ->
+             called := true;
+             Fmt.pf fmt "%s" contents)
+    in
+    Alcotest.check (domain pp_unit) msg
+      (dom expected
+         ![ (path, contents) ]
+         [ "Write to path (mode: 0755, purpose: PURPOSE)" ])
+      got;
+    Alcotest.check Alcotest.bool "k was called" true called.contents
+  in
+  let contents = "contents" in
+  test "write" ~contents ~expected:(Ok ())
+
+let suite =
+  List.map
+    (fun (n, f) -> (n, `Quick, f))
+    [
+      ("bind", test_bind);
+      ("seq", test_seq);
+      ("rm", test_rm);
+      ("mkdir", test_mkdir);
+      ("rmdir", test_rmdir);
+      ("with_dir", test_with_dir);
+      ("pwd", test_pwd);
+      ("is_file", test_is_file);
+      ("is_dir", test_is_dir);
+      ("size_of", test_size_of);
+      ("set_var", test_set_var);
+      ("get_var", test_get_var);
+      ("run_cmd", test_run_cmd);
+      ("run_cmd_out", test_run_cmd_out);
+      ("write_file", test_write_file);
+      ("tmp_file", test_tmp_file);
+      ("ls", test_ls);
+      ("with_output", test_with_output);
+    ]

unikernel/duniverse/mirage/test/functoria/test_action.mli

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list

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

@@ -0,0 +1,182 @@
+open Functoria
+
+let result_t pp_a =
+  let pp ppf = function
+    | `Error `Exn -> Fmt.string ppf "error exn"
+    | `Error `Parse -> Fmt.string ppf "error parse"
+    | `Error `Term -> Fmt.string ppf "error term"
+    | `Help -> Fmt.string ppf "help"
+    | `Version -> Fmt.string ppf "version"
+    | `Ok action ->
+        let pp = Cli.pp_action pp_a in
+        Fmt.pf ppf "ok %a" pp action
+  in
+  Alcotest.testable pp ( = )
+
+let result_b = result_t Fmt.(Dump.pair bool bool)
+let eval = Cli.eval ~with_setup:false ~name:"name" ~version:"0.2"
+
+let test_configure () =
+  let extra_term =
+    Cmdliner.(
+      Term.(
+        const (fun xyz cde -> (xyz, cde))
+        $ Arg.(value (flag (info [ "x"; "xyz" ])))
+        $ Arg.(value (flag (info [ "c"; "cde" ])))))
+  in
+  let result =
+    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
+      ~clean:extra_term ~help:extra_term ~mname:"test"
+      [| "name"; "configure"; "--xyz"; "--verbose" |]
+  in
+  Alcotest.(check result_b)
+    "configure"
+    (`Ok
+       (Cli.Configure
+          {
+            depext = true;
+            extra_repo =
+              [
+                ( "opam-overlays",
+                  "https://github.com/dune-universe/opam-overlays.git" );
+                ( "mirage-overlays",
+                  "https://github.com/dune-universe/mirage-opam-overlays.git" );
+              ];
+            args =
+              {
+                context = (true, false);
+                output = None;
+                config_file = Fpath.v "config.ml";
+                context_file = None;
+                dry_run = false;
+              };
+          }))
+    result
+
+let test_describe () =
+  let extra_term =
+    Cmdliner.(
+      Term.(
+        const (fun xyz cde -> (xyz, cde))
+        $ Arg.(value (flag (info [ "x"; "xyz" ])))
+        $ Arg.(value (flag (info [ "c"; "cde" ])))))
+  in
+  let result =
+    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
+      ~clean:extra_term ~help:extra_term ~mname:"test"
+      [|
+        "name";
+        "describe";
+        "--context-file=config.json";
+        "--cde";
+        "--color=always";
+        "--dot-command=dot";
+        "--eval";
+      |]
+  in
+  Alcotest.(check result_b)
+    "describe"
+    (`Ok
+       (Cli.Describe
+          {
+            args =
+              {
+                context = (false, true);
+                output = None;
+                config_file = Fpath.v "config.ml";
+                context_file = Some (Fpath.v "config.json");
+                dry_run = false;
+              };
+            dotcmd = "dot";
+            dot = false;
+            eval = Some true;
+          }))
+    result
+
+let test_clean () =
+  let extra_term =
+    Cmdliner.(
+      Term.(
+        const (fun xyz cde -> (xyz, cde))
+        $ Arg.(value (flag (info [ "x"; "xyz" ])))
+        $ Arg.(value (flag (info [ "c"; "cde" ])))))
+  in
+  let result =
+    eval ~configure:extra_term ~query:extra_term ~describe:extra_term
+      ~clean:extra_term ~help:extra_term [| "name"; "clean" |] ~mname:"test"
+  in
+  Alcotest.(check result_b)
+    "clean"
+    (`Ok
+       (Cli.Clean
+          {
+            context = (false, false);
+            output = None;
+            config_file = Fpath.v "config.ml";
+            context_file = None;
+            dry_run = false;
+          }))
+    result
+
+let test_help () =
+  let extra_term =
+    Cmdliner.(
+      Term.(
+        const (fun xyz cde -> (xyz, cde))
+        $ Arg.(value (flag (info [ "x"; "xyz" ])))
+        $ Arg.(value (flag (info [ "c"; "cde" ])))))
+  in
+  let null = Fmt.with_buffer (Buffer.create 10) in
+  let result =
+    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
+      ~describe:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
+      [| "name"; "help"; "--help"; "plain" |]
+  in
+  Alcotest.(check result_b) "help" `Help result
+
+let test_default () =
+  let extra_term =
+    Cmdliner.(
+      Term.(
+        const (fun xyz cde -> (xyz, cde))
+        $ Arg.(value (flag (info [ "x"; "xyz" ])))
+        $ Arg.(value (flag (info [ "c"; "cde" ])))))
+  in
+  let null = Fmt.with_buffer (Buffer.create 10) in
+  let result =
+    eval ~help_ppf:null ~configure:extra_term ~query:extra_term
+      ~describe:extra_term ~clean:extra_term ~help:extra_term ~mname:"test"
+      [| "name" |]
+  in
+  Alcotest.(check result_b) "default" `Help result
+
+let test_read_full_eval () =
+  let check = Alcotest.(check @@ option bool) in
+  check "test" None (Cli.peek_full_eval [| "test" |]);
+
+  check "test --eval" (Some true) (Cli.peek_full_eval [| "test"; "--eval" |]);
+
+  check "test blah --eval blah" (Some true)
+    (Cli.peek_full_eval [| "test"; "blah"; "--eval"; "blah" |]);
+
+  check "test --no-eval" (Some false)
+    (Cli.peek_full_eval [| "test"; "--no-eval" |]);
+
+  check "test blah --no-eval blah" (Some false)
+    (Cli.peek_full_eval [| "test"; "blah"; "--no-eval"; "blah" |]);
+
+  check "--no-eval test --eval" (Some true)
+    (Cli.peek_full_eval [| "--no-eval"; "test"; "--eval" |]);
+
+  check "--eval test --no-eval" (Some false)
+    (Cli.peek_full_eval [| "--eval"; "test"; "--no-eval" |])
+
+let suite =
+  [
+    ("read_full_eval", `Quick, test_read_full_eval);
+    ("configure", `Quick, test_configure);
+    ("describe", `Quick, test_describe);
+    ("clean", `Quick, test_clean);
+    ("help", `Quick, test_help);
+    ("default", `Quick, test_default);
+  ]

unikernel/duniverse/mirage/test/functoria/test_cli.mli

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list

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

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

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list

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

@@ -0,0 +1,123 @@
+open Functoria
+open Cmdliner
+
+let key_a = Key.create "a" Key.Arg.(flag @@ Arg.info [ "a" ])
+let key_b = Key.create "b" Key.Arg.(opt Arg.int 0 @@ Arg.info [ "b" ])
+let key_c = Key.create "c" Key.Arg.(required Arg.string @@ Arg.info [ "c" ])
+let key_d = Key.create "d" Key.Arg.(opt_all Arg.int @@ Arg.info [ "d" ])
+let empty = Context.empty
+let ( & ) (k, v) c = Key.add_to_context k v c
+let ( && ) x y = x & y & empty
+
+let test_eval () =
+  let context = (key_a, true) & (key_b, 0) && (key_c, Some "foo") in
+
+  let if_ = Key.if_ Key.(value key_a) "hello" "world" in
+  let r = Key.eval context if_ in
+  Alcotest.(check string) "if" "hello" r;
+
+  let match_1 =
+    Key.match_ Key.(value key_b) (function 0 -> "hello" | _ -> "world")
+  in
+  let r = Key.eval context match_1 in
+  Alcotest.(check string) "match 1" "hello" r;
+
+  let match_2 =
+    Key.match_
+      Key.(value key_c)
+      (function Some "foo" -> "hello" | _ -> "world")
+  in
+  let r = Key.eval context match_2 in
+  Alcotest.(check string) "match 1" "hello" r
+
+let keys = Key.Set.of_list Key.[ v key_a; v key_b; v key_c; v key_d ]
+let keys_no_required = Key.Set.of_list Key.[ v key_a; v key_b; v key_d ]
+
+let eval f keys argv =
+  let argv = Array.of_list ("" :: argv) in
+  match
+    Cmdliner.Cmd.eval_value ~argv
+      (Cmdliner.Cmd.v (Cmdliner.Cmd.info "keys") (f keys))
+  with
+  | Error _ -> Alcotest.fail "Error"
+  | Ok (`Ok x) -> x
+  | Ok `Version -> Alcotest.fail "version"
+  | Ok `Help -> Alcotest.fail "help"
+
+exception Error
+
+let test_get () =
+  let context = eval Key.context keys [ "-a"; "-c"; "foo" ] in
+  Alcotest.(check bool) "get a" true (Key.get context key_a);
+  Alcotest.(check int) "get b" 0 (Key.get context key_b);
+  Alcotest.(check (option string)) "get c" (Some "foo") (Key.get context key_c);
+
+  let context = eval Key.context keys_no_required [ "-a" ] in
+  Alcotest.(check (option string))
+    "get c with_required:false" None (Key.get context key_c);
+
+  Alcotest.check_raises "get c with_required:true" Error (fun () ->
+      try ignore (eval Key.context keys [ "-a" ]) with _ -> raise Error)
+
+let test_find () =
+  let context = eval Key.context keys_no_required [] in
+  Alcotest.(check (option bool)) "find a" None (Key.find context key_a);
+  Alcotest.(check (option int)) "find b" None (Key.find context key_b);
+  Alcotest.(check (option (option string)))
+    "find c" None (Key.find context key_c)
+
+let test_merge () =
+  let cache = (key_a, true) && (key_c, Some "foo") in
+  let cli = (key_a, false) && (key_b, 2) in
+  let context = Context.merge ~default:cache cli in
+  Alcotest.(check bool) "merge a" false (Key.get context key_a);
+  Alcotest.(check int) "merge b" 2 (Key.get context key_b);
+  Alcotest.(check (option string))
+    "merge c" (Some "foo") (Key.get context key_c)
+
+let key = Alcotest.testable Key.pp Key.equal
+
+let test_equal () =
+  let module A = Arg in
+  let k1 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
+  let k2 = Key.(v @@ create "foo" Arg.(opt A.int 2 (A.info [ "foo" ]))) in
+  let k3 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
+  Alcotest.(check @@ neg key) "different defaults" k1 k2;
+  Alcotest.(check @@ key) "same defaults" k1 k3
+
+let test_cmdliner () =
+  let module A = Arg in
+  let k1 = Key.(v @@ create "foo" Arg.(opt A.int 1 (A.info [ "foo" ]))) in
+  let k2 = Key.(v @@ create "foo" Arg.(opt A.int 2 (A.info [ "foo" ]))) in
+  let keys = Key.Set.of_list [ k1; k2 ] in
+  let context = Key.context keys in
+  let _ = eval (fun x -> x) context [] in
+  ()
+
+let test_opt_all () =
+  let context =
+    eval Key.context keys_no_required [ "-d"; "1"; "-d"; "2"; "-d"; "3" ]
+  in
+  Alcotest.(check (list int)) "get d" [ 1; 2; 3 ] (Key.get context key_d);
+  let context = eval Key.context keys_no_required [] in
+  Alcotest.(check (list int)) "get d" [] (Key.get context key_d);
+  match
+    Cmdliner.Cmd.eval_value ~argv:[| ""; "-d" |]
+      Cmdliner.(Cmd.v (Cmd.info "keys") (Key.context keys_no_required))
+  with
+  | Ok (`Ok _ | `Help | `Version) ->
+      Alcotest.failf "Invalid given command-line, eval must fail."
+  | Error _ -> Alcotest.(check pass) "invalid opt-all argument" () ()
+
+let suite =
+  List.map
+    (fun (n, f) -> (n, `Quick, f))
+    [
+      ("equal", test_equal);
+      ("eval", test_eval);
+      ("get", test_get);
+      ("find", test_find);
+      ("merge", test_merge);
+      ("cmdliner", test_cmdliner);
+      ("opt-all", test_opt_all);
+    ]

unikernel/duniverse/mirage/test/functoria/test_key.mli

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list

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

@@ -0,0 +1,54 @@
+open Functoria
+
+let w = Package.v ~min:"1.0" ~max:"2.0" "foo" ~scope:`Switch
+let x = Package.v ~min:"1.0" ~max:"2.0" "foo"
+let y = Package.v ~min:"0.9" ~max:"1.9" ~sublibs:[ "bar" ] "foo"
+let z = Package.v "bar" ~sublibs:[ "foo" ] ~min:"42"
+
+let xy =
+  match Package.merge x y with
+  | Some x -> x
+  | None -> Alcotest.fail "xy should not be None"
+
+let test_package_merge () =
+  let () =
+    match Package.merge x z with
+    | Some _ -> Alcotest.fail "xz should be None"
+    | None -> ()
+  in
+  Alcotest.(check (list string))
+    "min" (Package.min_versions xy) [ "0.9"; "1.0" ];
+  Alcotest.(check (list string))
+    "max" (Package.max_versions xy) [ "1.9"; "2.0" ]
+
+let test_package_pp () =
+  let str = Fmt.to_to_string Package.pp in
+  let str' = Fmt.to_to_string (Package.pp ~surround:"x") in
+  Alcotest.(check string)
+    "pp(x)" (str x) {|foo { ?monorepo & >= "1.0" & < "2.0" }|};
+  Alcotest.(check string)
+    "pp(xy)" (str xy)
+    {|foo { ?monorepo & >= "0.9" & >= "1.0" & < "1.9" & < "2.0" }|};
+  Alcotest.(check string) "pp(z)" (str z) {|bar { ?monorepo & >= "42" }|};
+  Alcotest.(check string)
+    "pp'(x)" (str' x) {|xfoox { ?monorepo & >= "1.0" & < "2.0" }|};
+  Alcotest.(check string) "pp(w)" (str w) {|foo { >= "1.0" & < "2.0" }|};
+  Alcotest.(check string) "key(x)" (Package.key x) "monorepo-foo";
+  Alcotest.(check string) "key(w)" (Package.key w) "switch-foo"
+
+let test_invalid_package_names () =
+  let check_name_is_invalid name =
+    Alcotest.check_raises name
+      (Invalid_argument (Fmt.str "package name %S is invalid" name))
+      (fun () -> Package.v name |> ignore)
+  in
+  check_name_is_invalid "bar.subfoo";
+  check_name_is_invalid "000";
+  check_name_is_invalid "é"
+
+let suite =
+  [
+    ("merge", `Quick, test_package_merge);
+    ("pp", `Quick, test_package_pp);
+    ("invalid names", `Quick, test_invalid_package_names);
+  ]

unikernel/duniverse/mirage/test/functoria/test_package.mli

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list

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

@@ -0,0 +1,107 @@
+let failed_to_parse_comments =
+  [
+    "(* not a name *)";
+    "not a comment";
+    "(* missing closing thingy";
+    "(* name2 >= bad version *)";
+    "(* name3 >= 1.2.3 && < 2.3.4 *)";
+    "(* name2 \n >= 1.2.3 & < 2.3.4 *)";
+  ]
+
+let test_failed_to_parse_comments () =
+  List.iter
+    (fun data ->
+      match Functoria.Tool.check_version ~name:"name" ~version:"1.2.3" data with
+      | Ok _ -> ()
+      | Error msg ->
+          Alcotest.fail
+            ("expected comment parse failure (and an ok), but got error "
+            ^ msg
+            ^ " for "
+            ^ data))
+    failed_to_parse_comments
+
+let bad_comments =
+  [
+    "(* name >= 1.2.3";
+    "(* name >>= 1.2.3 *)";
+    "(* name > 1.2.3 *)";
+    "(* name >= 1.2.3 && < 2.3.4 *)";
+    "(* name >= 1.2.3 & >= 2.3.4 *)";
+    "(* name < 1.2.3 & < 2.3.4 *)";
+  ]
+
+let test_bad_comments () =
+  List.iter
+    (fun data ->
+      match Functoria.Tool.check_version ~name:"name" ~version:"1.2.3" data with
+      | Ok _ -> Alcotest.fail ("expected bad comment to be bad for " ^ data)
+      | Error _ -> ())
+    bad_comments
+
+let good_comments =
+  [
+    "(* name >= 1.2.3 *)";
+    "(* name < 2.0.0 *)";
+    "(* name >= 1.0.0 & < 2.0.0 *)";
+    "(* name >= 1.0.0 *)";
+    "(* name >= 1.2 *)";
+    "(* name >= 1.0 & < 2.0 *)";
+    "(* name >= 1 & < 2 *)";
+    "(* name < 2.0 *)";
+    "(* name < 2 *)";
+  ]
+
+let test_good_comments () =
+  List.iter
+    (fun data ->
+      match Functoria.Tool.check_version ~name:"name" ~version:"1.2.3" data with
+      | Ok _ -> ()
+      | Error _ ->
+          Alcotest.fail
+            ("expected good comment to be met for " ^ data ^ " at version 1.2.3"))
+    good_comments;
+  List.iter
+    (fun data ->
+      match Functoria.Tool.check_version ~name:"name" ~version:"1.3" data with
+      | Ok _ -> ()
+      | Error _ ->
+          Alcotest.fail
+            ("expected good comment to be met for " ^ data ^ " at version 1.3"))
+    good_comments;
+  List.iter
+    (fun data ->
+      match
+        Functoria.Tool.check_version ~name:"name" ~version:"1.2.3-23-g453412"
+          data
+      with
+      | Ok _ -> ()
+      | Error _ ->
+          Alcotest.fail
+            ("expected good comment to be met for " ^ data ^ " at version 1.3"))
+    good_comments
+
+let unmet_comments =
+  [
+    "(* name >= 1.2.3 *)";
+    "(* name < 0.1.2 *)";
+    "(* name >= 1.0.0 & < 2.0.0 *)";
+    "(* name >= 1.0.0 *)";
+  ]
+
+let test_unmet_comments () =
+  List.iter
+    (fun data ->
+      match Functoria.Tool.check_version ~name:"name" ~version:"0.1.2" data with
+      | Ok _ ->
+          Alcotest.fail ("expected unmet comment to not be met for " ^ data)
+      | Error _ -> ())
+    unmet_comments
+
+let suite =
+  [
+    ("failed_to_parse comments", `Quick, test_failed_to_parse_comments);
+    ("bad comment", `Quick, test_bad_comments);
+    ("good comment", `Quick, test_good_comments);
+    ("unmet comment", `Quick, test_unmet_comments);
+  ]

unikernel/duniverse/mirage/test/functoria/test_version.mli

@@ -0,0 +1 @@
+val suite : unit Alcotest.test_case list