From 0c643cfbbbfd0be4e7a76b867c5bbb549c68ad35 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 26 Sep 2023 06:51:05 -0600 Subject: [PATCH] chore: update ocamlformat and switch to janestreet style Signed-off-by: Rudi Grinberg --- .ocamlformat | 23 +----- bench/bench.ml | 5 +- flake.nix | 2 +- src/spawn.ml | 138 +++++++++++++++++++----------------- src/spawn.mli | 8 +-- test/exe/list_files.ml | 4 +- test/exe/print_env.ml | 1 + test/pgid_test/checkpgid.ml | 6 +- test/tests.ml | 110 ++++++++++++++-------------- 9 files changed, 143 insertions(+), 154 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 61b0191..44a715f 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,20 +1,3 @@ -version=0.19.0 -profile=conventional -break-separators=before -dock-collection-brackets=false -break-sequences=true -doc-comments=before -field-space=loose -let-and=sparse -sequence-style=terminator -type-decl=sparse -wrap-comments=true -if-then-else=k-r -let-and=sparse -space-around-records -space-around-lists -space-around-arrays -cases-exp-indent=2 -break-cases=all -indicate-nested-or-patterns=unsafe-no -parse-docstrings=true +version=0.26.0 +profile=janestreet +ocaml-version=4.08.0 diff --git a/bench/bench.ml b/bench/bench.ml index d41ebac..032503e 100644 --- a/bench/bench.ml +++ b/bench/bench.ml @@ -1,7 +1,8 @@ let%bench "exec true with Spawn.spawn" = Spawn.spawn () ~prog:"/bin/true" ~argv:[ "true" ] |> Unix.waitpid [] +;; let%bench "exec true with Caml.Unix.create_process" = - Unix.create_process "/bin/true" [| "true" |] Unix.stdin Unix.stdout - Unix.stderr + Unix.create_process "/bin/true" [| "true" |] Unix.stdin Unix.stdout Unix.stderr |> Unix.waitpid [] +;; diff --git a/flake.nix b/flake.nix index 3807833..35ae2ce 100644 --- a/flake.nix +++ b/flake.nix @@ -26,7 +26,7 @@ }; devShells.default = pkgs.mkShell { inputsFrom = pkgs.lib.attrValues packages; - buildInputs = with pkgs.ocamlPackages; [ ocaml-lsp pkgs.ocamlformat_0_19_0 ]; + buildInputs = with pkgs.ocamlPackages; [ ocaml-lsp pkgs.ocamlformat_0_26_0 ]; }; }); } diff --git a/src/spawn.ml b/src/spawn.ml index c7dcee0..48a26e4 100644 --- a/src/spawn.ml +++ b/src/spawn.ml @@ -28,10 +28,8 @@ module Unix_backend = struct unsuccessful. In the end we decided not to default to [vfork] on OSX. *) - if is_osx then - Fork - else - Vfork + if is_osx then Fork else Vfork + ;; end module type Env = sig @@ -44,36 +42,36 @@ module Env_win32 : Env = struct type t = string let of_list env = - let len = - List.fold_left env ~init:1 ~f:(fun acc s -> acc + String.length s + 1) - in + let len = List.fold_left env ~init:1 ~f:(fun acc s -> acc + String.length s + 1) in let buf = Buffer.create len in List.iter env ~f:(fun s -> - Buffer.add_string buf s; - Buffer.add_char buf '\000'); + Buffer.add_string buf s; + Buffer.add_char buf '\000'); Buffer.add_char buf '\000'; Buffer.contents buf + ;; end module Env_unix : Env = struct type t = string list let no_null s = - if String.contains s '\000' then - Printf.ksprintf invalid_arg - "Spawn.Env.of_list: NUL bytes are not allowed in the environment but \ - found one in %S" + if String.contains s '\000' + then + Printf.ksprintf + invalid_arg + "Spawn.Env.of_list: NUL bytes are not allowed in the environment but found one \ + in %S" s + ;; let of_list l = List.iter l ~f:no_null; l + ;; end -module Env : Env = (val if Sys.win32 then - (module Env_win32) - else - (module Env_unix) : Env) +module Env : Env = (val if Sys.win32 then (module Env_win32) else (module Env_unix) : Env) module Pgid = struct type t = int @@ -81,17 +79,13 @@ module Pgid = struct let new_process_group = 0 let of_pid = function - | 0 -> - raise (Invalid_argument "bad pid: 0 (hint: use [Pgid.new_process_group])") - | t -> - if t < 0 then - raise (Invalid_argument ("bad pid: " ^ string_of_int t)) - else - t + | 0 -> raise (Invalid_argument "bad pid: 0 (hint: use [Pgid.new_process_group])") + | t -> if t < 0 then raise (Invalid_argument ("bad pid: " ^ string_of_int t)) else t + ;; end -external spawn_unix : - env:Env.t option +external spawn_unix + : env:Env.t option -> cwd:Working_dir.t -> prog:string -> argv:string list @@ -101,29 +95,38 @@ external spawn_unix : -> use_vfork:bool -> setpgid:int option -> sigprocmask:(Unix.sigprocmask_command * int list) option - -> int = "spawn_unix_byte" "spawn_unix" + -> int + = "spawn_unix_byte" "spawn_unix" -external spawn_windows : - env:Env.t option +external spawn_windows + : env:Env.t option -> cwd:string option -> prog:string -> cmdline:string -> stdin:Unix.file_descr -> stdout:Unix.file_descr -> stderr:Unix.file_descr - -> int = "spawn_windows_byte" "spawn_windows" + -> int + = "spawn_windows_byte" "spawn_windows" let maybe_quote f = - if - String.contains f ' ' || String.contains f '\"' || String.contains f '\t' - || f = "" - then - Filename.quote f - else - f - -let spawn_windows ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork:_ - ~setpgid:_ ~sigprocmask:_ = + if String.contains f ' ' || String.contains f '\"' || String.contains f '\t' || f = "" + then Filename.quote f + else f +;; + +let spawn_windows + ~env + ~cwd + ~prog + ~argv + ~stdin + ~stdout + ~stderr + ~use_vfork:_ + ~setpgid:_ + ~sigprocmask:_ + = let cwd = match (cwd : Working_dir.t) with | Path p -> Some p @@ -132,48 +135,49 @@ let spawn_windows ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork:_ in let cmdline = String.concat (List.map argv ~f:maybe_quote) ~sep:" " in let prog = - match (Filename.is_relative prog, cwd) with + match Filename.is_relative prog, cwd with | true, Some p -> Filename.concat p prog | _ -> prog in spawn_windows ~env ~cwd ~prog ~cmdline ~stdin ~stdout ~stderr +;; let no_null s = - if String.contains s '\000' then - Printf.ksprintf invalid_arg - "Spawn.spawn: NUL bytes are not allowed in any of the arguments but \ - found one in %S" + if String.contains s '\000' + then + Printf.ksprintf + invalid_arg + "Spawn.spawn: NUL bytes are not allowed in any of the arguments but found one in %S" s - -let spawn ?env ?(cwd = Working_dir.Inherit) ~prog ~argv ?(stdin = Unix.stdin) - ?(stdout = Unix.stdout) ?(stderr = Unix.stderr) - ?(unix_backend = Unix_backend.default) ?setpgid ?sigprocmask () = +;; + +let spawn + ?env + ?(cwd = Working_dir.Inherit) + ~prog + ~argv + ?(stdin = Unix.stdin) + ?(stdout = Unix.stdout) + ?(stderr = Unix.stderr) + ?(unix_backend = Unix_backend.default) + ?setpgid + ?sigprocmask + () + = (match cwd with - | Path s -> no_null s - | Fd _ - | Inherit -> - ()); + | Path s -> no_null s + | Fd _ | Inherit -> ()); no_null prog; List.iter argv ~f:no_null; - let backend = - if Sys.win32 then - spawn_windows - else - spawn_unix - in + let backend = if Sys.win32 then spawn_windows else spawn_unix in let use_vfork = match unix_backend with | Vfork -> true | Fork -> false in - backend ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork ~setpgid - ~sigprocmask + backend ~env ~cwd ~prog ~argv ~stdin ~stdout ~stderr ~use_vfork ~setpgid ~sigprocmask +;; external safe_pipe : unit -> Unix.file_descr * Unix.file_descr = "spawn_pipe" -let safe_pipe = - if Sys.win32 then - fun () -> - Unix.pipe ~cloexec:true () - else - safe_pipe +let safe_pipe = if Sys.win32 then fun () -> Unix.pipe ~cloexec:true () else safe_pipe diff --git a/src/spawn.mli b/src/spawn.mli index e4d2454..3cbab8a 100644 --- a/src/spawn.mli +++ b/src/spawn.mli @@ -6,10 +6,10 @@ module Working_dir : sig type t = - | Path of string (** Path in the filesystem *) + | Path of string (** Path in the filesystem *) | Fd of Unix.file_descr (** File descriptor pointing to a directory. Not supported on Windows. *) - | Inherit (** Inherit the working directory of the current process *) + | Inherit (** Inherit the working directory of the current process *) end module Unix_backend : sig @@ -110,8 +110,8 @@ end [unix_backend] describes what backend to use on Unix. If set to [Default], [vfork] is used unless the environment variable [SPAWN_USE_FORK] is set. On Windows, [CreateProcess] is used. *) -val spawn : - ?env:Env.t +val spawn + : ?env:Env.t -> ?cwd:Working_dir.t (* default: [Inherit] *) -> prog:string -> argv:string list diff --git a/test/exe/list_files.ml b/test/exe/list_files.ml index 5c37b00..2a09a48 100644 --- a/test/exe/list_files.ml +++ b/test/exe/list_files.ml @@ -1,3 +1,3 @@ let () = - Sys.readdir "." |> Array.to_list |> List.sort String.compare - |> List.iter print_endline + Sys.readdir "." |> Array.to_list |> List.sort String.compare |> List.iter print_endline +;; diff --git a/test/exe/print_env.ml b/test/exe/print_env.ml index 336c99d..e013128 100644 --- a/test/exe/print_env.ml +++ b/test/exe/print_env.ml @@ -2,3 +2,4 @@ let () = match Sys.getenv "FOO" with | exception _ -> print_endline "None" | str -> Printf.printf "Some %S\n" str +;; diff --git a/test/pgid_test/checkpgid.ml b/test/pgid_test/checkpgid.ml index 487cc6d..f5d312b 100644 --- a/test/pgid_test/checkpgid.ml +++ b/test/pgid_test/checkpgid.ml @@ -1,7 +1,9 @@ external getpgid : int -> int = "test_getpgid" let main = - if not Sys.win32 then + if not Sys.win32 + then ( let pid = Unix.getpid () in let pgid = getpgid pid in - if pid <> pgid then failwith "pgid and pid not equal" + if pid <> pgid then failwith "pgid and pid not equal") +;; diff --git a/test/tests.ml b/test/tests.ml index ac6a5a1..117cdff 100644 --- a/test/tests.ml +++ b/test/tests.ml @@ -9,20 +9,22 @@ let show_raise f = | exn -> Printexc.to_string exn in Printf.printf "raised %s" s +;; let%expect_test "non-existing program" = show_raise (fun () -> Spawn.spawn () ~prog:"/doesnt-exist" ~argv:[ "blah" ]); [%expect {| raised Unix.Unix_error _ |}] +;; let%expect_test "non-existing dir" = show_raise (fun () -> - Spawn.spawn () ~prog:"/bin/true" ~argv:[ "true" ] - ~cwd:(Path "/doesnt-exist")); + Spawn.spawn () ~prog:"/bin/true" ~argv:[ "true" ] ~cwd:(Path "/doesnt-exist")); [%expect {| raised Unix.Unix_error _ |}] +;; let wait pid = match snd (Unix.waitpid [] pid) with @@ -30,6 +32,7 @@ let wait pid = | WEXITED n -> Printf.ksprintf failwith "exited with code %d" n | WSIGNALED n -> Printf.ksprintf failwith "got signal %d" n | WSTOPPED _ -> assert false +;; let list_files = Filename.concat (Sys.getcwd ()) "exe/list_files.exe" @@ -37,106 +40,90 @@ let () = Unix.mkdir "sub" 0o777; close_out (open_out "sub/foo"); close_out (open_out "sub/bar") +;; let%expect_test "cwd:Path" = - wait - (Spawn.spawn () ~prog:list_files ~argv:[ "list_files.exe" ] - ~cwd:(Path "sub")); + wait (Spawn.spawn () ~prog:list_files ~argv:[ "list_files.exe" ] ~cwd:(Path "sub")); [%expect {| bar foo |}] +;; let%expect_test "cwd:Fd" = - (if Sys.win32 then - print_endline "bar\nfoo" - else + if Sys.win32 + then print_endline "bar\nfoo" + else ( let fd = Unix.openfile "sub" [ O_RDONLY ] 0 in - wait - (Spawn.spawn () ~prog:list_files ~argv:[ "list_files.exe" ] ~cwd:(Fd fd)); + wait (Spawn.spawn () ~prog:list_files ~argv:[ "list_files.exe" ] ~cwd:(Fd fd)); Unix.close fd); [%expect {| bar foo |}] +;; let%expect_test "cwd:Fd (invalid)" = show_raise (fun () -> - if Sys.win32 then - raise (Unix.Unix_error (ENOTDIR, "fchdir", "")) - else - Spawn.spawn () ~prog:"/bin/pwd" ~argv:[ "pwd" ] ~cwd:(Fd Unix.stdin)); + if Sys.win32 + then raise (Unix.Unix_error (ENOTDIR, "fchdir", "")) + else Spawn.spawn () ~prog:"/bin/pwd" ~argv:[ "pwd" ] ~cwd:(Fd Unix.stdin)); [%expect {| raised Unix.Unix_error _ |}] +;; module Program_lookup = struct - let path_sep = - if Sys.win32 then - ';' - else - ':' - - let exe_ext = - if Sys.win32 then - ".exe" - else - "" + let path_sep = if Sys.win32 then ';' else ':' + let exe_ext = if Sys.win32 then ".exe" else "" let split_path s = let rec loop i j = - if j = String.length s then - [ String.sub s i (j - i) ] - else if s.[j] = path_sep then - String.sub s i (j - i) :: loop (j + 1) (j + 1) - else - loop i (j + 1) + if j = String.length s + then [ String.sub s i (j - i) ] + else if s.[j] = path_sep + then String.sub s i (j - i) :: loop (j + 1) (j + 1) + else loop i (j + 1) in loop 0 0 + ;; let path = match Sys.getenv "PATH" with | exception Not_found -> [] | s -> split_path s + ;; let find_prog prog = let rec search = function | [] -> Printf.ksprintf failwith "Program %S not found in PATH!" prog | dir :: rest -> let fn = Filename.concat dir prog ^ exe_ext in - if Sys.file_exists fn then - fn - else - search rest + if Sys.file_exists fn then fn else search rest in search path + ;; end let%expect_test "inheriting stdout with close-on-exec set" = (* CR-soon jdimino for jdimino: the test itself seems to pass, however there seem to be another issue related to ppx_expect and Windows. *) - if Sys.win32 then - print_string "hello world" + if Sys.win32 + then print_string "hello world" else ( Unix.set_close_on_exec Unix.stdout; - let shell, arg = - if Sys.win32 then - ("cmd", "/c") - else - ("sh", "-c") - in + let shell, arg = if Sys.win32 then "cmd", "/c" else "sh", "-c" in let prog = Program_lookup.find_prog shell in - wait (Spawn.spawn () ~prog ~argv:[ shell; arg; {|echo "hello world"|} ]) - ); + wait (Spawn.spawn () ~prog ~argv:[ shell; arg; {|echo "hello world"|} ])); [%expect {| hello world |}] +;; let%expect_test "prog relative to cwd" = - if Sys.win32 then - print_string "Hello, world!" - else - wait - (Spawn.spawn () ~prog:"./hello.exe" ~argv:[ "hello" ] ~cwd:(Path "exe")); + if Sys.win32 + then print_string "Hello, world!" + else wait (Spawn.spawn () ~prog:"./hello.exe" ~argv:[ "hello" ] ~cwd:(Path "exe")); [%expect {| Hello, world! |}] +;; let%expect_test "env" = let tst v = @@ -146,7 +133,11 @@ let%expect_test "env" = | Some v -> Spawn.Env.of_list [ "FOO=" ^ v ] in wait - (Spawn.spawn () ~env ~prog:"./print_env.exe" ~argv:[ "print_env" ] + (Spawn.spawn + () + ~env + ~prog:"./print_env.exe" + ~argv:[ "print_env" ] ~cwd:(Path "exe")) in tst (Some "foo"); @@ -155,15 +146,21 @@ let%expect_test "env" = [%expect {| None |}]; tst (Some ""); [%expect {| Some "" |}] +;; let%expect_test "pgid tests" = wait - (Spawn.spawn ~setpgid:Spawn.Pgid.new_process_group () - ~prog:"pgid_test/checkpgid.exe" ~argv:[]); + (Spawn.spawn + ~setpgid:Spawn.Pgid.new_process_group + () + ~prog:"pgid_test/checkpgid.exe" + ~argv:[]); [%expect {||}] +;; let%test_unit "sigprocmask" = - if not Sys.win32 then ( + if not Sys.win32 + then ( let run ?sigprocmask expected_signal = let prog = Program_lookup.find_prog "sleep" in let pid = Spawn.spawn ?sigprocmask ~prog ~argv:[ "sleep"; "60" ] () in @@ -174,11 +171,12 @@ let%test_unit "sigprocmask" = | _ -> failwith "unexpected" in run Sys.sigusr1; - run ~sigprocmask:(SIG_BLOCK, [ Sys.sigusr1 ]) Sys.sigkill - ) + run ~sigprocmask:(SIG_BLOCK, [ Sys.sigusr1 ]) Sys.sigkill) +;; (* This should be at the end to clean up the test environment *) let () = Unix.unlink "sub/foo"; Unix.unlink "sub/bar"; Unix.rmdir "sub" +;;