Update tests and fix bug discovered

This commit is contained in:
Reynir Björnsson 2023-09-14 12:49:50 +02:00 committed by Robur
parent a56bd28e64
commit 5ec5cb66df
2 changed files with 24 additions and 10 deletions

View file

@ -177,7 +177,7 @@ module Build_artifact = struct
let add = let add =
Caqti_type.(tup2 file (id `build)) ->. Caqti_type.unit @@ Caqti_type.(tup2 file (id `build)) ->. Caqti_type.unit @@
"INSERT INTO build_artifact (filepath, sha256, size, build) \ "INSERT INTO build_artifact (filepath, sha256, size, build) \
VALUES (?, ?, ?, ?, ?)" VALUES (?, ?, ?, ?)"
let remove_by_build = let remove_by_build =
id `build ->. Caqti_type.unit @@ id `build ->. Caqti_type.unit @@

View file

@ -43,18 +43,15 @@ module Testable = struct
let file = let file =
let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) = let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) =
Fpath.equal x.filepath y.filepath && Fpath.equal x.filepath y.filepath &&
Fpath.equal x.localpath y.localpath &&
Cstruct.equal x.sha256 y.sha256 && Cstruct.equal x.sha256 y.sha256 &&
x.size = y.size x.size = y.size
in in
let pp ppf { Builder_db.Rep.filepath; localpath; sha256; size } = let pp ppf { Builder_db.Rep.filepath; sha256; size } =
Format.fprintf ppf "{@[<v 1>@;<1 0>Builder_db.Rep.filepath = %a;@;<1 0>\ Format.fprintf ppf "{@[<v 1>@;<1 0>Builder_db.Rep.filepath = %a;@;<1 0>\
localpath = %a;@;<1 0>\
sha256 = %a;@;<1 0>\ sha256 = %a;@;<1 0>\
size = %d;@;<1 0>\ size = %d;@;<1 0>\
@]@,}" @]@,}"
Fpath.pp filepath Fpath.pp localpath Fpath.pp filepath Cstruct.hexdump_pp sha256 size
Cstruct.hexdump_pp sha256 size
in in
Alcotest.testable pp equal Alcotest.testable pp equal
@ -133,11 +130,10 @@ let finish = Option.get (Ptime.of_float_s 1.)
let result = Builder.Exited 0 let result = Builder.Exited 0
let main_binary = let main_binary =
let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in
let localpath = Result.get_ok (Fpath.of_string "/dev/null") in
let data = "#!/bin/sh\necho Hello, World\n" in let data = "#!/bin/sh\necho Hello, World\n" in
let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
let size = String.length data in let size = String.length data in
{ Builder_db.Rep.filepath; localpath; sha256; size } { Builder_db.Rep.filepath; sha256; size }
let main_binary2 = let main_binary2 =
let data = "#!/bin/sh\necho Hello, World 2\n" in let data = "#!/bin/sh\necho Hello, World 2\n" in
let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in
@ -162,8 +158,16 @@ let add_test_build user_id (module Db : CONN) =
Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () -> Db.exec Build.set_main_binary (id, main_binary_id) >>= fun () ->
Db.commit () Db.commit ()
in in
Result.fold ~ok:Result.ok ~error:(fun _ -> Db.rollback ()) Result.fold r
r ~ok:Result.ok
~error:(fun e ->
let () =
match e with
| `Msg e -> Printf.eprintf "%s\n%!" e
| #Caqti_error.t as e ->
Fmt.epr "%a" Caqti_error.pp e
in
Db.rollback ())
let with_build_db f () = let with_build_db f () =
or_fail or_fail
@ -269,6 +273,14 @@ let test_artifact_get_by_build_uuid (module Db : CONN) =
get_opt "no build" >>| fun (_id, file) -> get_opt "no build" >>| fun (_id, file) ->
Alcotest.(check Testable.file) "same file" file main_binary Alcotest.(check Testable.file) "same file" file main_binary
let test_artifact_exists_true (module Db : CONN) =
Db.find Builder_db.Build_artifact.exists main_binary.sha256 >>| fun exists ->
Alcotest.(check bool) "main binary exists" true exists
let test_artifact_exists_false (module Db : CONN) =
Db.find Builder_db.Build_artifact.exists main_binary2.sha256 >>| fun exists ->
Alcotest.(check bool) "main binary2 doesn't exists" false exists
(* XXX: This test should fail because main_binary on the corresponding build (* XXX: This test should fail because main_binary on the corresponding build
* references its main_binary. This is not the case now due to foreign key. *) * references its main_binary. This is not the case now due to foreign key. *)
let test_artifact_remove_by_build (module Db : CONN) = let test_artifact_remove_by_build (module Db : CONN) =
@ -306,6 +318,8 @@ let () =
"build-artifact", [ "build-artifact", [
test_case "Get all by build" `Quick (with_build_db test_artifact_get_all_by_build); test_case "Get all by build" `Quick (with_build_db test_artifact_get_all_by_build);
test_case "Get by build uuid" `Quick (with_build_db test_artifact_get_by_build_uuid); test_case "Get by build uuid" `Quick (with_build_db test_artifact_get_by_build_uuid);
test_case "Artifact exists" `Quick (with_build_db test_artifact_exists_true);
test_case "Other artifact doesn't exists" `Quick (with_build_db test_artifact_exists_false);
test_case "Remove by build" `Quick (with_build_db test_artifact_remove_by_build); test_case "Remove by build" `Quick (with_build_db test_artifact_remove_by_build);
]; ];
] ]