richer CCUnix.call API, with tests

Makefile

@@ -65,6 +65,8 @@ QTESTABLE=$(filter-out $(DONTTEST), \
 	$(wildcard src/string/*.mli) \
 	$(wildcard src/io/*.ml) \
 	$(wildcard src/io/*.mli) \
+	$(wildcard src/unix/*.ml) \
+	$(wildcard src/unix/*.mli) \
 	$(wildcard src/sexp/*.ml) \
 	$(wildcard src/sexp/*.mli) \
 	$(wildcard src/advanced/*.ml) \

_oasis

@@ -203,8 +203,8 @@ Executable run_qtest
   Build$:           flag(tests) && flag(bigarray)
   BuildDepends:     containers, containers.misc, containers.string, containers.iter,
                     containers.io, containers.advanced, containers.sexp,
-                    containers.bigarray,
-                    sequence, gen, oUnit, QTest2Lib
+                    containers.bigarray, containers.unix,
+                    sequence, gen, unix, oUnit, QTest2Lib
 
 Executable run_qtest_lwt
   Path:             qtest/lwt/

src/data/CCIntMap.ml

@@ -134,7 +134,7 @@ let rec insert_ c k v t = match t with
 
 let add k v t = insert_ (fun ~old:_ v -> v) k v t
 
-(*$Q
+(*$Q & ~count:20
   Q.(list (pair int int)) (fun l -> \
     let l = CCList.Set.uniq l in let m = of_list l in \
     List.for_all (fun (k,v) -> find_exn k m = v) l)

src/unix/CCUnix.ml

@@ -27,19 +27,40 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (** {1 High-level Functions on top of Unix} *)
 
 type 'a or_error = [`Ok of 'a | `Error of string]
+type 'a gen = unit -> 'a option
 
 (** {2 Calling Commands} *)
 
-type cmd = string * string array
-(** A command: program + arguments *)
-
-let cmd_of_sh s = "/bin/sh", [| "/bin/sh"; "-c"; s |]
-
 let int_of_process_status = function
   | Unix.WEXITED i
   | Unix.WSIGNALED i
   | Unix.WSTOPPED i -> i
 
+let str_exists s p =
+  let rec f s p i =
+    if i = String.length s then false
+    else p s.[i] || f s p (i+1)
+  in
+  f s p 0
+
+let rec iter_gen f g = match g() with
+  | None -> ()
+  | Some x -> f x; iter_gen f g
+
+(* print a string, but escaped if required *)
+let escape_str buf s =
+  if str_exists s
+      (function ' ' | '"' | '\'' -> true | _ -> false)
+  then (
+    Buffer.add_char buf '\'';
+    String.iter
+      (function
+        | '\'' -> Buffer.add_string buf "''"
+        | c -> Buffer.add_char buf c
+      ) s;
+    Buffer.add_char buf '\'';
+  ) else Buffer.add_string buf s
+
 let read_all ?(size=1024) ic =
   let buf = ref (Bytes.create size) in
   let len = ref 0 in
@@ -58,24 +79,37 @@ let read_all ?(size=1024) ic =
   with Exit ->
     Bytes.sub_string !buf 0 !len
 
-let call ?(stdin="") cmd =
-  let cmd, args = match cmd with
-    | `Sh s -> cmd_of_sh s
-    | `Cmd (c, args) -> c, args
-  in
-  let oc, ic, errc = Unix.open_process_full cmd args in
-  (* send stdin *)
-  output_string ic stdin;
-  close_out ic;
-  (* read out and err *)
-  let out = read_all oc in
-  let err = read_all errc in
-  let status = Unix.close_process_full (oc, ic, errc) in
-  object
-    method stdout = out
-    method stderr = err
-    method status = status
-    method errcode = int_of_process_status status
-  end
+type call_result = 
+  < stdout:string;
+    stderr:string;
+    status:Unix.process_status;
+    errcode:int; (** extracted from status *)
+  >
 
+let kbprintf' buf fmt k = Printf.kbprintf k buf fmt
+
+let call ?(bufsize=2048) ?(stdin=`Str "") ?(env=[||]) cmd =
+  (* render the command *)
+  let buf = Buffer.create 256 in
+  kbprintf' buf cmd
+    (fun buf ->
+       let cmd = Buffer.contents buf in
+        let oc, ic, errc = Unix.open_process_full cmd env in
+        (* send stdin *)
+        begin match stdin with
+          | `Str s -> output_string ic s
+          | `Gen g -> iter_gen (output_string ic) g
+        end;
+        close_out ic;
+        (* read out and err *)
+        let out = read_all ~size:bufsize oc in
+        let err = read_all ~size:bufsize errc in
+        let status = Unix.close_process_full (oc, ic, errc) in
+        object
+          method stdout = out
+          method stderr = err
+          method status = status
+          method errcode = int_of_process_status status
+        end
+    )
 

src/unix/CCUnix.mli

@@ -31,21 +31,46 @@ Some useful functions built on top of Unix.
 @since NEXT_RELEASE *)
 
 type 'a or_error = [`Ok of 'a | `Error of string]
+type 'a gen = unit -> 'a option
 
 (** {2 Calling Commands} *)
 
-type cmd = string * string array
-(** A command: program + arguments *)
+val escape_str : Buffer.t -> string -> unit
+(** Escape a string so it can be a shell argument.
+*)
 
-val call :
-  ?stdin:string ->
-  [`Sh of string | `Cmd of cmd] ->
+(*$T
+  CCPrint.sprintf "%a" escape_str "foo" = "foo"
+  CCPrint.sprintf "%a" escape_str "foo bar" = "'foo bar'"
+  CCPrint.sprintf "%a" escape_str "fo'o b'ar" = "'fo''o b''ar'"
+*)
+
+type call_result = 
   < stdout:string;
     stderr:string;
     status:Unix.process_status;
     errcode:int; (** extracted from status *)
   >
 
+val call : ?bufsize:int ->
+           ?stdin:[`Gen of string gen | `Str of string] ->
+           ?env:string array ->
+           ('a, Buffer.t, unit, call_result) format4 ->
+           'a
+(** [call cmd] wraps the result of [Unix.open_process_full cmd] into an
+    object. It reads the full stdout and stderr of the subprocess before
+    returning.
+    @param stdin if provided, the generator or string is consumed and fed to
+      the subprocess input channel, which is then closed.
+    @param bufsize buffer size used to read stdout and stderr
+    @param env environment to run the command in
+*)
+
+(*$T
+  (call ~stdin:(`Str "abc") "cat")#stdout = "abc"
+  (call "echo %a" escape_str "a'b'c")#stdout = "abc\n"
+  (call "echo %s" "a'b'c")#stdout = "abc\n"
+*)