From f22c32dcda0e8b546e85e8ad95d0ad655e365d38 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Wed, 20 Jul 2016 13:20:19 +0200 Subject: 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 --- lib/Responsefile.ml | 133 --------------------------------------------------- lib/Responsefile.mli | 2 +- lib/Responsefile.mll | 97 +++++++++++++++++++++++++++++++++++++ 3 files changed, 98 insertions(+), 134 deletions(-) delete mode 100644 lib/Responsefile.ml create mode 100644 lib/Responsefile.mll (limited to 'lib') diff --git a/lib/Responsefile.ml b/lib/Responsefile.ml deleted file mode 100644 index c10fe302..00000000 --- a/lib/Responsefile.ml +++ /dev/null @@ -1,133 +0,0 @@ -(* *********************************************************************) -(* *) -(* The Compcert verified compiler *) -(* *) -(* Xavier Leroy, INRIA Paris-Rocquencourt *) -(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *) -(* *) -(* Copyright Institut National de Recherche en Informatique et en *) -(* Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU General Public License as published by *) -(* the Free Software Foundation, either version 2 of the License, or *) -(* (at your option) any later version. This file is also distributed *) -(* under the terms of the INRIA Non-Commercial License Agreement. *) -(* *) -(* *********************************************************************) - - -let rec singlequote ic buf = - match input_char ic with - | exception End_of_file -> () - | '\'' -> () - | c -> Buffer.add_char buf c; singlequote ic buf - -let doublequote ic buf = - let rec aux buf = - match input_char ic with - | exception End_of_file -> (* Backslash-newline is ignored. *) - () - | '\"' -> - () - | '\\' -> - begin match input_char ic with - | exception End_of_file -> (* tolerance *) - Buffer.add_char buf '\\' - | '\n' -> - aux buf - | ('\\' | '\"') as c -> - Buffer.add_char buf c; aux buf - | c -> - Buffer.add_char buf '\\'; Buffer.add_char buf c; aux buf - end - | c -> - Buffer.add_char buf c; aux buf in - aux buf - -let doublequote_win ic buf = - let rec aux_win buf n = - match input_char ic with - | exception End_of_file -> (* tolerance *) - add_backslashes n - | '\\' -> - aux_win buf (n+1) - | '\"' -> - if n land 1 = 1 then begin - add_backslashes (n/2); Buffer.add_char buf '\"'; - aux_win buf 0 - end else begin - add_backslashes n - end - | '\n' -> - if n >= 1 then add_backslashes (n-1) else Buffer.add_char buf '\n'; - aux_win buf 0 - | c -> - add_backslashes n; Buffer.add_char buf c; aux_win buf 0 - and add_backslashes n = - for _i = 1 to n do Buffer.add_char buf '\\' done in - aux_win buf 0 - -let doublequote = if Sys.win32 then doublequote_win else doublequote - -let is_add_file file = - String.length file > 1 && String.get file 0 = '@' - -let cut_add file = - String.sub file 1 (String.length file - 1) - -let readwords file = - let visited = ref [] in - let rec aux file = - if Sys.file_exists file then begin - if List.mem file !visited then - raise (Arg.Bad "Circular includes in response files"); - visited := file :: !visited; - let ic = open_in_bin file in - let buf = Buffer.create 32 in - let words = ref [] in - let stash inw = - if inw then begin - let word = Buffer.contents buf in - if is_add_file word then - words := (aux (cut_add word))@ !words - else - words := Buffer.contents buf :: !words; - Buffer.clear buf - end in - let rec unquoted inw = - match input_char ic with - | exception End_of_file -> - stash inw - | ' ' | '\t' | '\r' | '\n' -> - stash inw; unquoted false - | '\\' -> - begin match input_char ic with - | exception End_of_file -> (* tolerance; treat like \newline *) - unquoted inw - | '\n' -> - unquoted inw - | c -> - Buffer.add_char buf c; unquoted true - end - | '\'' -> - singlequote ic buf; unquoted true - | '\"' -> - doublequote ic buf; - unquoted true - | c -> - Buffer.add_char buf c; unquoted true in - unquoted false; - close_in ic; - !words - end else [file] in - List.rev (aux file) - -let expand_responsefiles args = - let acc = ref [] in - for i = (Array.length args - 1) downto 0 do - let file = args.(i) in - if is_add_file file then - acc := readwords (cut_add file) @ !acc - else - acc := file::!acc - done; - Array.of_list !acc diff --git a/lib/Responsefile.mli b/lib/Responsefile.mli index b55dac16..ec82c32e 100644 --- a/lib/Responsefile.mli +++ b/lib/Responsefile.mli @@ -15,6 +15,6 @@ (* *********************************************************************) -val expand_responsefiles: string array -> string array +val expandargv: string array -> string array (** Expand responsefile arguments contained in the array and return the full set of arguments. *) diff --git a/lib/Responsefile.mll b/lib/Responsefile.mll new file mode 100644 index 00000000..bb29fd75 --- /dev/null +++ b/lib/Responsefile.mll @@ -0,0 +1,97 @@ +(* *********************************************************************) +(* *) +(* The Compcert verified compiler *) +(* *) +(* Xavier Leroy, INRIA Paris-Rocquencourt *) +(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *) +(* *) +(* Copyright Institut National de Recherche en Informatique et en *) +(* Automatique. All rights reserved. This file is distributed *) +(* under the terms of the GNU General Public License as published by *) +(* the Free Software Foundation, either version 2 of the License, or *) +(* (at your option) any later version. This file is also distributed *) +(* under the terms of the INRIA Non-Commercial License Agreement. *) +(* *) +(* *********************************************************************) + + +(* Parsing response files with various quoting styles *) + +{ +(* To accumulate the characters in a word or quoted string *) +let buf = Buffer.create 32 + +(* Add the current contents of buf to the list of words seen so far, + taking care not to add empty strings unless warranted (e.g. quoted) *) +let stash inword words = + if inword then begin + let w = Buffer.contents buf in + Buffer.clear buf; + w :: words + end else + words + +} + +let whitespace = [' ' '\t' '\012' '\r' '\n'] + +let backslashes_even = "\\\\"* (* an even number of backslashes *) +let backslashes_odd = "\\\\"* '\\' (* an odd number of backslashes *) + +(* GNU-style quoting *) +(* "Options in file are separated by whitespace. A whitespace + character may be included in an option by surrounding the entire + option in either single or double quotes. Any character (including + a backslash) may be included by prefixing the character to be + included with a backslash. The file may itself contain additional + @file options; any such options will be processed recursively." *) + +rule gnu_unquoted inword words = parse + | eof { List.rev (stash inword words) } + | whitespace+ { gnu_unquoted false (stash inword words) lexbuf } + | '\'' { gnu_single_quote lexbuf; gnu_unquoted true words lexbuf } + | '\"' { gnu_double_quote lexbuf; gnu_unquoted true words lexbuf } + | "" { gnu_one_char lexbuf; gnu_unquoted true words lexbuf } + +and gnu_one_char = parse + | '\\' (_ as c) { Buffer.add_char buf c } + | _ as c { Buffer.add_char buf c } + +and gnu_single_quote = parse + | eof { () (* tolerance *) } + | '\'' { () } + | "" { gnu_one_char lexbuf; gnu_single_quote lexbuf } + +and gnu_double_quote = parse + | eof { () (* tolerance *) } + | '\"' { () } + | "" { gnu_one_char lexbuf; gnu_double_quote lexbuf } + +{ + +let re_responsefile = Str.regexp "@\\(.*\\)$" + +exception Error of string + +let expandargv argv = + let rec expand_arg seen arg k = + if not (Str.string_match re_responsefile arg 0) then + arg :: k + else begin + let filename = Str.matched_group 1 arg in + if List.mem filename seen then + raise (Error ("cycle in response files: " ^ filename)); + let ic = open_in filename in + let words = gnu_unquoted false [] (Lexing.from_channel ic) in + close_in ic; + expand_args (filename :: seen) words k + end + and expand_args seen args k = + match args with + | [] -> k + | a1 :: al -> expand_args seen al (expand_arg seen a1 k) + in + let args = Array.to_list argv in + Array.of_list (List.rev (expand_args [] args [])) + +} -- cgit