(* *********************************************************************) (* *) (* 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 Lesser General Public License as *) (* published by the Free Software Foundation, either version 2.1 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. *) (* *) (* *********************************************************************) { (* 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 [])) (* 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 -> begin match c with | ' ' | '\t' | '\r' | '\n' | '\\' | '\'' | '"' -> Buffer.add_char buf '\\' | _ -> () end; Buffer.add_char buf c) arg; Buffer.contents buf let re_quote = Str.regexp ".*[ \t\n\r\"]" let diab_quote arg = let buf = Buffer.create ((String.length arg) + 8) in let doublequote = Str.string_match re_quote arg 0 in if doublequote then begin Buffer.add_char buf '"'; String.iter (fun c -> if c = '"' then Buffer.add_char buf '\\'; Buffer.add_char buf c) arg; if doublequote then Buffer.add_char buf '"'; Buffer.contents buf end else arg }