Merge pull request #1042 from fdopen/create_process_quoting

Fix Unix.create_process command-line escaping under Windows

Changes

@@ -388,6 +388,11 @@ Next version (4.05.0):
 - GPR#1019: Fix fatal error in Flambda mode "[functions] does not map set of
   closures ID" (Pierre Chambart, code review by Mark Shinwell and Leo White)
 
+- GPR#1042: Fix escaping of command-line arguments in
+  Unix.create_process{,_env} under Windows.  Arguments with tabs should now
+  be received verbatim by the child process.
+  (Nicolas Ojeda Bar, Andreas Hauptmann review by Xavier Leroy)
+
 ### Toplevel and debugger:
 
 - PR#7060, GPR#1035: Print exceptions in installed custom printers

otherlibs/win32unix/unix.ml

@@ -848,7 +848,10 @@ external win_create_process : string -> string -> string option ->
 
 let make_cmdline args =
   let maybe_quote f =
-    if String.contains f ' ' || String.contains f '\"' || f = ""
+    if String.contains f ' ' ||
+       String.contains f '\"' ||
+       String.contains f '\t' ||
+       f = ""
     then Filename.quote f
     else f in
   String.concat " " (List.map maybe_quote (Array.to_list args))

testsuite/makefiles/Makefile.several

@@ -28,7 +28,7 @@ FORTRAN_LIB=`if [ -n "$(F_FILES)" ]; then echo $(FORTRAN_LIBRARY); fi`
 ADD_CFLAGS+=$(FORTRAN_LIB)
 ADD_OPTFLAGS+=$(FORTRAN_LIB)
 
-C_INCLUDES+=-I $(CTOPDIR)/byterun -I$(CTOPDIR)/otherlibs/bigarray
+C_INCLUDES+=-I $(CTOPDIR)/byterun -I $(CTOPDIR)/otherlibs/bigarray
 
 GENERATED_SOURCES=
 

testsuite/tests/lib-unix/Makefile

@@ -22,12 +22,12 @@ ifeq ($(OS),Windows_NT)
 ADD_BYTERUN_FLAGS="-I $(OTOPDIR)/otherlibs/win32unix"
 endif
 
-default: reflector.exe fdstatus.exe
+default: reflector.exe fdstatus.exe cmdline_prog.exe
 	$(MAKE) check
 
 include $(BASEDIR)/makefiles/Makefile.several
 include $(BASEDIR)/makefiles/Makefile.common
 
 %.exe: %.c
-	@$(BYTECC) -o $*.exe $*.c > /dev/null
+	@$(BYTECC) $(if $(filter msvc,$(CCOMPTYPE)),/Fe$*.exe,-o $*.exe) $*.c
 

testsuite/tests/lib-unix/cmdline_prog.c

@@ -0,0 +1,10 @@
+#include <stdio.h>
+
+int main (int argc, char *argv[])
+{
+  int i;
+  for (i = 1; i < argc; i ++) {
+    printf ("%s\n", argv[i]);
+  }
+  return 0;
+}

testsuite/tests/lib-unix/test_unix_cmdline.ml

@@ -0,0 +1,28 @@
+open Unix
+
+let prog_name = "cmdline_prog.exe"
+
+let run args =
+  let out, inp = pipe () in
+  let in_chan = in_channel_of_descr out in
+  set_binary_mode_in in_chan false;
+  let pid = create_process ("./" ^ prog_name) (Array.of_list (prog_name :: args)) Unix.stdin inp Unix.stderr in
+  List.iter (fun arg ->
+      let s = input_line in_chan in
+      Printf.printf "%S -> %S [%s]\n" arg s (if s = arg then "OK" else "FAIL")
+    ) args;
+  close_in in_chan;
+  let _, exit = waitpid [] pid in
+  assert (exit = WEXITED 0)
+
+let () =
+  List.iter run
+    [
+      [""; ""; "\t \011"];
+      ["a"; "b"; "c.txt@!"];
+      ["\""];
+      [" "; " a "; "  \" \\\" "];
+      [" \\ \\ \\\\\\"];
+      [" \"hola \""];
+      ["a\tb"];
+    ]

testsuite/tests/lib-unix/test_unix_cmdline.reference

@@ -0,0 +1,13 @@
+"" -> "" [OK]
+"" -> "" [OK]
+"\t \011" -> "\t \011" [OK]
+"a" -> "a" [OK]
+"b" -> "b" [OK]
+"c.txt@!" -> "c.txt@!" [OK]
+"\"" -> "\"" [OK]
+" " -> " " [OK]
+" a " -> " a " [OK]
+"  \" \\\" " -> "  \" \\\" " [OK]
+" \\ \\ \\\\\\" -> " \\ \\ \\\\\\" [OK]
+" \"hola \"" -> " \"hola \"" [OK]
+"a\tb" -> "a\tb" [OK]