Port tests to Windows

.github/workflows/main.yml

@@ -116,4 +116,4 @@ jobs:
 
       - run: opam install . --deps-only --with-test
 
-      - run: opam exec -- dune build
+      - run: opam exec -- dune runtest

test/mock_exec.ml

@@ -6,11 +6,21 @@ let ( / ) = Filename.concat
 
 let strf = Printf.sprintf
 
+let unix_path path =
+  if Sys.win32 then
+    Lwt_process.pread ("", [| "cygpath"; "-u"; path|]) >|= fun str -> String.trim str
+  else
+    Lwt.return path
+
 let next_container_id = ref 0
 
 let base_tar =
   let mydir = Sys.getcwd () in
-  Lwt_main.run (Lwt_io.(with_file ~mode:input) (mydir / "base.tar") Lwt_io.read)
+  Lwt_main.run begin
+    let base_tar = mydir / "base.tar" in
+    (* unix_path (mydir / "base.tar") >>= fun base_tar -> *)
+    Lwt_io.(with_file ~mode:input) base_tar Lwt_io.read
+  end
   |> Bytes.of_string
 
 let with_fd x f =
@@ -80,9 +90,14 @@ let exec ?cwd ?stdin ?stdout ?stderr ~pp cmd =
     Fmt.pr "exec: %a@." Fmt.(Dump.array string) argv;
     begin match Array.to_list argv with
       | "docker" :: args -> exec_docker ?stdout args
-      | "sudo" :: "--" :: ("tar" :: _ as tar) -> Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar)
-      | "sudo" :: "--" :: "mkdir" :: args
-      | "mkdir" :: args -> mkdir args
+      | "sudo" :: "--" :: ("tar" :: _ as tar) when not Os.running_as_root ->
+        Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar)
+      | "tar" :: "-C" :: path :: opts when Os.running_as_root ->
+        unix_path path >>= fun path ->
+        let tar = (if Sys.win32 then "C:\\cygwin64\\bin\\tar.exe" else "tar") :: "-C" :: path :: opts in
+        Os.default_exec ?cwd ?stdin ?stdout ~pp ("", Array.of_list tar)
+      | "mkdir" :: args when Os.running_as_root -> mkdir args
+      | "sudo" :: "--" :: "mkdir" :: args when not Os.running_as_root -> mkdir args
       | x -> Fmt.failwith "Unknown mock command %a" Fmt.(Dump.list string) x
     end
   | (x, _) -> Fmt.failwith "Unexpected absolute path: %S" x

test/mock_store.ml

@@ -10,6 +10,12 @@ type t = {
   mutable builds : int;
 }
 
+let unix_path path =
+  if Sys.win32 then
+    Lwt_process.pread ("", [| "cygpath"; "-u"; path|]) >|= fun str -> String.trim str
+  else
+    Lwt.return path
+
 let delay_store = ref Lwt.return_unit
 
 let rec waitpid_non_intr pid =
@@ -34,7 +40,8 @@ let build t ?base ~id fn =
        begin match base with
          | None -> Os.ensure_dir tmp_dir; Lwt.return_unit
          | Some base ->
-           Lwt_process.exec ("", [| "cp"; "-r"; t.dir / base; tmp_dir |]) >>= function
+           Lwt.both (unix_path (t.dir / base)) (unix_path tmp_dir) >>= fun (src, dst) ->
+           Lwt_process.exec ("", [| "cp"; "-r"; src; dst |]) >>= function
            | Unix.WEXITED 0 -> Lwt.return_unit
            | _ -> failwith "cp failed!"
        end >>= fun () ->
@@ -45,6 +52,7 @@ let build t ?base ~id fn =
          Unix.rename tmp_dir dir;
          Lwt_result.return ()
        | Error _ as e ->
+         unix_path tmp_dir >>= fun tmp_dir ->
          rm_r tmp_dir;
          Lwt.return e
     )