Added simplified reader and printer for gnu @files

The functions expandargv and writeargv resemble the functions from
the libiberity that are used by the gnu tools. Additionaly a new
configuration is added in order to determine which kind of response
files are supported for calls to other tools.
Bug 18308

4 files changed, 31 insertions, 9 deletions

diff --git a/driver/Commandline.ml b/driver/Commandline.ml
index 1981776e..7e683680 100644
--- a/driver/Commandline.ml
+++ b/driver/Commandline.ml
@@ -101,7 +101,7 @@ let parse_array spec argv first last =
 
 let parse_cmdline spec =
   try
-    let argv = expand_responsefiles Sys.argv in
+    let argv = expandargv Sys.argv in
     parse_array spec argv 1 (Array.length argv - 1)
   with Arg.Bad s ->
     eprintf "%s" s;
diff --git a/driver/Configuration.ml b/driver/Configuration.ml
index e1a02573..be581e14 100644
--- a/driver/Configuration.ml
+++ b/driver/Configuration.ml
@@ -171,3 +171,13 @@ let struct_return_style =
   | "int1-8"   -> SR_int1to8
   | "ref"      -> SR_ref
   | v -> bad_config "struct_return_style" [v]
+
+type response_file_style =
+  | Gnu         (* responsefiles in gnu compatible syntax *)
+  | Unsupported (* responsefiles are not supported *)
+
+let response_file_style =
+  match get_config_string "response_file_style" with
+  | "unsupported" -> Unsupported
+  | "gnu" -> Gnu
+  | v -> bad_config "response_file_style" [v]
diff --git a/driver/Configuration.mli b/driver/Configuration.mli
index dde9d6fd..1092bf6d 100644
--- a/driver/Configuration.mli
+++ b/driver/Configuration.mli
@@ -63,3 +63,10 @@ val struct_passing_style: struct_passing_style
 val struct_return_style: struct_return_style
   (** Calling conventions to use for returning structs and unions as
       first-class values *)
+
+type response_file_style =
+  | Gnu         (* responsefiles in gnu compatible syntax *)
+  | Unsupported (* responsefiles are not supported *)
+
+val response_file_style: response_file_style
+  (** Style of supported responsefiles *)
diff --git a/driver/Driveraux.ml b/driver/Driveraux.ml
index 2c03c65c..6bd48344 100644
--- a/driver/Driveraux.ml
+++ b/driver/Driveraux.ml
@@ -58,20 +58,25 @@ let command stdout args =
             argv.(0) fn (Unix.error_message err) param;
     -1
 
-let quote arg =
-  let whitespace = Str.regexp "[ \t\r\n]" in
-  if Str.string_match whitespace arg 0 then
-    Filename.quote arg (* We need to quote arguments containing whitespaces *)
-  else
-    arg
+(* This function reimplements quoting of writeargv from libiberty *)
+let gnu_quote arg =
+  let len = String.length arg in
+  let buf = Buffer.create len in
+  String.iter (fun c -> match c with
+    | ' ' | '\t' | '\r' | '\n' | '\\' | '\'' | '"' ->
+        Buffer.add_char buf '\\'
+    | _ -> ();
+    Buffer.add_char buf c) arg;
+  Buffer.contents buf
 
 let command ?stdout args =
-  if Sys.win32 && List.fold_left (fun len arg -> len + String.length arg + 1) 0 args > 7000 then
+  let resp = Sys.win32 && Configuration.response_file_style <> Configuration.Unsupported in
+  if resp && List.fold_left (fun len arg -> len + String.length arg + 1) 0 args > 7000 then
     let file,oc = Filename.open_temp_file "compcert" "" in
     let cmd,args = match args with
     | cmd::args -> cmd,args
     | [] -> assert false (* Should never happen *) in
-    List.iter (fun a -> Printf.fprintf oc "%s " (quote a)) args;
+    List.iter (fun a -> Printf.fprintf oc "%s " (gnu_quote a)) args;
     close_out oc;
     let arg = if gnu_system then "@"^file else "-@"^file in
     let ret = command stdout [cmd;arg] in