diff options
author | Bernhard Schommer <bernhardschommer@gmail.com> | 2016-07-20 13:20:19 +0200 |
---|---|---|
committer | Bernhard Schommer <bernhardschommer@gmail.com> | 2016-07-20 13:20:19 +0200 |
commit | f22c32dcda0e8b546e85e8ad95d0ad655e365d38 (patch) | |
tree | 4a6c997c3a0692d10beed8d8b59488c962189148 /driver | |
parent | 2129fe8f2e19c4dd91955e5300e76d924e0a3e6d (diff) | |
download | compcert-f22c32dcda0e8b546e85e8ad95d0ad655e365d38.tar.gz compcert-f22c32dcda0e8b546e85e8ad95d0ad655e365d38.zip |
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
Diffstat (limited to 'driver')
-rw-r--r-- | driver/Commandline.ml | 2 | ||||
-rw-r--r-- | driver/Configuration.ml | 10 | ||||
-rw-r--r-- | driver/Configuration.mli | 7 | ||||
-rw-r--r-- | driver/Driveraux.ml | 21 |
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 |