Merge pull request #3756 from BuckleScript/fix_windows_quoting

quoting command line on windows properly

Author: bobzhang

jscomp/main/js_main.ml

@@ -78,10 +78,14 @@ let process_file ppf sourcefile =
   match input with 
   | Re ->     
     setup_reason_context ();
-    Js_implementation.implementation ppf (reason_pp ~sourcefile) opref   
+    let tmpfile = reason_pp ~sourcefile in 
+    Js_implementation.implementation ppf tmpfile opref ;  
+    Ast_reason_pp.clean tmpfile
   | Rei ->
     setup_reason_context ();
-    Js_implementation.interface ppf (reason_pp ~sourcefile) opref 
+    let tmpfile = (reason_pp ~sourcefile) in 
+    Js_implementation.interface ppf  tmpfile opref ;
+    Ast_reason_pp.clean tmpfile
   | Reiast 
     -> 
     setup_reason_context ();
@@ -142,9 +146,9 @@ let intf filename =
 let eval (s : string) ~suffix =
   let tmpfile = Filename.temp_file "eval" suffix in 
   Ext_io.write_file tmpfile s;   
-  Ext_pervasives.finally  tmpfile anonymous ~clean:(fun _ ->
-      try Sys.remove tmpfile with _ -> () 
-    )
+  anonymous  tmpfile;
+  Ast_reason_pp.clean tmpfile
+  
 
 let (//) = Filename.concat
 

jscomp/syntax/ast_reason_pp.ml

@@ -25,26 +25,44 @@
 
 
 exception Pp_error
+
+let cmd_nix_quote cmd sourcefile tmpfile : string = 
+  Ext_filename.maybe_quote cmd ^ " --print=binary " ^
+  Ext_filename.maybe_quote sourcefile ^
+  " > " ^ Ext_filename.maybe_quote tmpfile 
+
+let cmd_windows_quote cmd sourcefile tmpfile : string= 
+  "cmd /S/C \"" ^
+  cmd_nix_quote cmd sourcefile tmpfile
+  ^ "\""
+
+
+let clean tmpfile =   
+  (if not !Clflags.verbose then try Sys.remove tmpfile with _ -> () )
+
 (* Sync up with {!Pparse.preprocess} 
   The generated file should not sit 
   in the same directory as sourctree
 *)
-let pp (sourcefile : string) =
-  
-  
+let pp (sourcefile : string) =    
   let tmpfile = Filename.temp_file "bspp" "" in
   let pp = (*TODO: check to avoid double quoting *)
-    Ext_filename.maybe_quote 
       (match !Js_config.refmt with 
        | None ->
          Filename.concat (Filename.dirname Sys.executable_name) "refmt.exe" 
        | Some x -> x)
   in 
-  let comm = Printf.sprintf "%s --print=binary %s > %s"
-      pp (Ext_filename.maybe_quote sourcefile) tmpfile
+  let comm = 
+      if Sys.win32 then cmd_windows_quote pp sourcefile tmpfile 
+      else cmd_nix_quote pp sourcefile tmpfile
   in
+  if !Clflags.verbose then begin 
+    prerr_string "+ ";
+    prerr_endline comm;
+    prerr_newline ()
+  end ;
   if Sys.command comm <> 0 then begin
-    (try Sys.remove tmpfile with _ -> ());
+    clean tmpfile;
     raise Pp_error
   end;
   tmpfile  

jscomp/syntax/ast_reason_pp.mli

@@ -27,4 +27,8 @@ exception Pp_error
 
 val pp : 
   string -> 
-  string
+  string
+
+val clean:   
+  string -> 
+  unit

lib/4.02.3/unstable/js_compiler.ml

@@ -119194,6 +119194,10 @@ exception Pp_error
 val pp : 
   string -> 
   string
+
+val clean:   
+  string -> 
+  unit
 end = struct
 #1 "ast_reason_pp.ml"
 (* Copyright (C) 2019- Authors of BuckleScript
@@ -119223,26 +119227,44 @@ end = struct
 
 
 exception Pp_error
+
+let cmd_nix_quote cmd sourcefile tmpfile : string = 
+  Ext_filename.maybe_quote cmd ^ " --print=binary " ^
+  Ext_filename.maybe_quote sourcefile ^
+  " > " ^ Ext_filename.maybe_quote tmpfile 
+
+let cmd_windows_quote cmd sourcefile tmpfile : string= 
+  "cmd /S/C \"" ^
+  cmd_nix_quote cmd sourcefile tmpfile
+  ^ "\""
+
+
+let clean tmpfile =   
+  (if not !Clflags.verbose then try Sys.remove tmpfile with _ -> () )
+
 (* Sync up with {!Pparse.preprocess} 
   The generated file should not sit 
   in the same directory as sourctree
 *)
-let pp (sourcefile : string) =
-  
-  
+let pp (sourcefile : string) =    
   let tmpfile = Filename.temp_file "bspp" "" in
   let pp = (*TODO: check to avoid double quoting *)
-    Ext_filename.maybe_quote 
       (match !Js_config.refmt with 
        | None ->
          Filename.concat (Filename.dirname Sys.executable_name) "refmt.exe" 
        | Some x -> x)
   in 
-  let comm = Printf.sprintf "%s --print=binary %s > %s"
-      pp (Ext_filename.maybe_quote sourcefile) tmpfile
+  let comm = 
+      if Sys.win32 then cmd_windows_quote pp sourcefile tmpfile 
+      else cmd_nix_quote pp sourcefile tmpfile
   in
+  if !Clflags.verbose then begin 
+    prerr_string "+ ";
+    prerr_endline comm;
+    prerr_newline ()
+  end ;
   if Sys.command comm <> 0 then begin
-    (try Sys.remove tmpfile with _ -> ());
+    clean tmpfile;
     raise Pp_error
   end;
   tmpfile