From 1d80ce37abf5a123526063997a6c7b47846be42c Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Thu, 8 Feb 2018 07:28:34 -0800 Subject: [PATCH] [pp] print contents of argfiles, recursively, on error Summary: Useful to debug without having to rerun commands. Looks like this: ``` Usage Error: Failed to execute compilation command: '/home/jul/infer.fb/infer/bin/../../facebook-clang-plugins/clang/install/bin/clang' 'args.txt' ++Contents of 'args.txt': 'arg1.txt' 'arghorashy_hello_c.txt' 'args.txt' ++Contents of 'arg1.txt': 'arghorashy_c.txt' ++Contents of 'arg_c.txt': '-c' ++Contents of 'arg_hello_c.txt': 'examples/hello.c' Error message: clang-5.0: error: no such file or directory: 'examples/hello.c' *** Infer needs a working compilation command to run. ``` Reviewed By: mbouaziz Differential Revision: D6872550 fbshipit-source-id: 65cd026 --- infer/src/base/Escape.ml | 3 ++ infer/src/base/Escape.mli | 3 ++ infer/src/base/Pp.ml | 42 ++++++++++++++++++------ infer/src/clang/Capture.ml | 26 ++++++++------- infer/src/clang/ClangCommand.ml | 48 +++++++++++++++++----------- infer/src/clang/ClangCommand.mli | 2 ++ infer/src/integration/ClangQuotes.ml | 5 ++- 7 files changed, 85 insertions(+), 44 deletions(-) diff --git a/infer/src/base/Escape.ml b/infer/src/base/Escape.ml index 512fa7c7f..f9ef7a988 100644 --- a/infer/src/base/Escape.ml +++ b/infer/src/base/Escape.ml @@ -131,3 +131,6 @@ let escape_filename s = let escape_double_quotes s = escape_map (function '"' -> Some "\\\"" | _ -> None) s + +let escape_in_single_quotes s = + Printf.sprintf "'%s'" (escape_map (function '\'' -> Some "'\\''" | _ -> None) s) diff --git a/infer/src/base/Escape.mli b/infer/src/base/Escape.mli index 79e362ea9..0d13f5c40 100644 --- a/infer/src/base/Escape.mli +++ b/infer/src/base/Escape.mli @@ -34,3 +34,6 @@ val escape_filename : string -> string val escape_double_quotes : string -> string (** replaces double-quote with backslash double-quote *) + +val escape_in_single_quotes : string -> string +(** put the string inside single quotes and escape the single quotes within that string *) diff --git a/infer/src/base/Pp.ml b/infer/src/base/Pp.ml index fc680af6a..79896341e 100644 --- a/infer/src/base/Pp.ml +++ b/infer/src/base/Pp.ml @@ -134,14 +134,36 @@ let option pp fmt = function None -> string fmt "None" | Some x -> F.fprintf fmt let to_string ~f fmt x = string fmt (f x) -let pp_argfile fmt fname = - try - F.fprintf fmt " Contents of '%s'@\n" fname ; - In_channel.iter_lines ~f:(F.fprintf fmt " %s@\n") (In_channel.create fname) ; - F.fprintf fmt " /Contents of '%s'@\n" fname - with exn -> F.fprintf fmt " Error reading file '%s':@\n %a@\n" fname Exn.pp exn - - let cli_args fmt args = - F.fprintf fmt "'%a'@\n%a" (seq ~sep:"' '" string) args (seq ~sep:"\n" pp_argfile) - (List.filter_map ~f:(String.chop_prefix ~prefix:"@") args) + let pp_args fmt args = + F.fprintf fmt "@[ " ; + seq ~sep:"" ~print_env:{text with break_lines= true} string fmt + (List.map args ~f:Escape.escape_in_single_quotes) ; + F.fprintf fmt "@]@\n" + in + let rec pp_argfile_args in_argfiles fmt args = + let at_least_one = ref false in + List.iter args ~f:(fun arg -> + String.chop_prefix ~prefix:"@" arg + |> Option.iter ~f:(fun argfile -> + if not !at_least_one then ( + F.fprintf fmt "@[ " ; + at_least_one := true ) ; + pp_argfile in_argfiles fmt argfile ) ) ; + if !at_least_one then F.fprintf fmt "@]@\n" + and pp_argfile in_argfiles fmt fname = + if not (String.Set.mem in_argfiles fname) then + let in_argfiles' = String.Set.add in_argfiles fname in + match In_channel.read_lines fname with + | args -> + F.fprintf fmt "++Contents of %s:@\n" (Escape.escape_in_single_quotes fname) ; + pp_args fmt args ; + pp_argfile_args in_argfiles' fmt args ; + () + | exception exn -> + F.fprintf fmt "@\n++Error reading file %s:@\n %a@\n" + (Escape.escape_in_single_quotes fname) + Exn.pp exn + in + pp_args fmt args ; + pp_argfile_args String.Set.empty fmt args diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index 8697e2961..49266cb74 100644 --- a/infer/src/clang/Capture.ml +++ b/infer/src/clang/Capture.ml @@ -101,12 +101,12 @@ let run_and_validate_clang_frontend ast_source = let run_clang clang_command read = let exit_with_error exit_code = - L.external_error "Error: the following clang command did not run successfully:@\n %s@\n%!" - clang_command ; + L.external_error "Error: the following clang command did not run successfully:@\n %a@." + ClangCommand.pp clang_command ; L.exit exit_code in (* NOTE: exceptions will propagate through without exiting here *) - match Utils.with_process_in clang_command read with + match Utils.with_process_in (ClangCommand.command_to_run clang_command) read with | res, Ok () -> res | _, Error `Exit_non_zero n -> @@ -116,8 +116,8 @@ let run_clang clang_command read = exit_with_error 1 -let run_plugin_and_frontend source_path frontend clang_args = - let clang_command = ClangCommand.command_to_run (ClangCommand.with_plugin_args clang_args) in +let run_plugin_and_frontend source_path frontend clang_cmd = + let clang_plugin_cmd = ClangCommand.with_plugin_args clang_cmd in ( if debug_mode then (* -cc1 clang commands always set -o explicitly *) let basename = source_path ^ ".ast" in @@ -126,12 +126,14 @@ let run_plugin_and_frontend source_path frontend clang_args = let debug_script_out = Out_channel.create frontend_script_fname in let debug_script_fmt = Format.formatter_of_out_channel debug_script_out in let biniou_fname = Printf.sprintf "%s.biniou" basename in - Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" clang_command biniou_fname ; + Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" + (ClangCommand.command_to_run clang_plugin_cmd) + biniou_fname ; Format.fprintf debug_script_fmt "bdump -x -d \"%s/clang_ast.dict\" -w '!!DUMMY!!' %s \\@\n > %s.bdump" Config.etc_dir biniou_fname basename ; Out_channel.close debug_script_out ) ; - run_clang clang_command frontend + run_clang clang_plugin_cmd frontend let cc1_capture clang_cmd = @@ -148,7 +150,7 @@ let cc1_capture clang_cmd = then ( L.(debug Capture Quiet) "@\n Skip the analysis of source file %s@\n@\n" source_path ; (* We still need to run clang, but we don't have to attach the plugin. *) - run_clang (ClangCommand.command_to_run clang_cmd) Utils.consume_in ) + run_clang clang_cmd Utils.consume_in ) else if Config.skip_analysis_in_path_skips_compilation && CLocation.is_file_blacklisted source_path then ( @@ -173,10 +175,10 @@ let capture clang_cmd = (* when running with buck's compilation-database, skip commands where frontend cannot be attached, as they may cause unnecessary compilation errors *) () - else + else ( (* Non-compilation (eg, linking) command. Run the command as-is. It will not get captured further since `clang -### ...` will only output commands that invoke binaries using their absolute paths. *) - let command_to_run = ClangCommand.command_to_run clang_cmd in - L.(debug Capture Quiet) "Running non-cc command without capture: %s@\n" command_to_run ; - run_clang command_to_run Utils.echo_in + L.(debug Capture Medium) + "Running non-cc command without capture: %a@\n" ClangCommand.pp clang_cmd ; + run_clang clang_cmd Utils.echo_in ) diff --git a/infer/src/clang/ClangCommand.ml b/infer/src/clang/ClangCommand.ml index cf71dce43..5e9eb7337 100644 --- a/infer/src/clang/ClangCommand.ml +++ b/infer/src/clang/ClangCommand.ml @@ -78,16 +78,18 @@ let filter_and_replace_unsupported_args ?(replace_options_arg= fun _ s -> s) ?(blacklisted_flags= []) ?(blacklisted_flags_with_arg= []) ?(post_args= []) args = (* [prev] is the previously seen argument, [res_rev] is the reversed result, [changed] is true if some change has been performed *) - let rec aux (prev_is_blacklisted_with_arg, res_rev, changed) args = + let rec aux in_argfiles (prev_is_blacklisted_with_arg, res_rev, changed) args = match args with | [] -> (prev_is_blacklisted_with_arg, res_rev, changed) | _ :: tl when prev_is_blacklisted_with_arg -> (* in the unlikely event that a blacklisted flag with arg sits as the last option in some arg file, we need to remove its argument now *) - aux (false, res_rev, true) tl - | at_argfile :: tl when String.is_prefix at_argfile ~prefix:"@" + aux in_argfiles (false, res_rev, true) tl + | at_argfile :: tl + when String.is_prefix at_argfile ~prefix:"@" && not (String.Set.mem in_argfiles at_argfile) -> ( + let in_argfiles' = String.Set.add in_argfiles at_argfile in let argfile = String.slice at_argfile 1 (String.length at_argfile) in match In_channel.read_lines argfile with | lines -> @@ -98,26 +100,28 @@ let filter_and_replace_unsupported_args ?(replace_options_arg= fun _ s -> s) |> Utils.strip_balanced_once ~drop:(function '"' | '\'' -> true | _ -> false) in let last_in_file_is_blacklisted, rev_res_with_file_args, changed_file = - List.map ~f:strip lines |> aux (prev_is_blacklisted_with_arg, res_rev, false) + List.map ~f:strip lines + |> aux in_argfiles' (prev_is_blacklisted_with_arg, res_rev, false) in - if changed_file then aux (last_in_file_is_blacklisted, rev_res_with_file_args, true) tl + if changed_file then + aux in_argfiles' (last_in_file_is_blacklisted, rev_res_with_file_args, true) tl else (* keep the same argfile if we haven't needed to change anything in it *) - aux (last_in_file_is_blacklisted, at_argfile :: res_rev, changed) tl + aux in_argfiles' (last_in_file_is_blacklisted, at_argfile :: res_rev, changed) tl | exception e -> L.external_warning "Error reading argument file '%s': %s@\n" at_argfile (Exn.to_string e) ; - aux (false, at_argfile :: res_rev, changed) tl ) + aux in_argfiles' (false, at_argfile :: res_rev, changed) tl ) | flag :: tl when List.mem ~equal:String.equal blacklisted_flags flag -> - aux (false, res_rev, true) tl + aux in_argfiles (false, res_rev, true) tl | flag :: tl when List.mem ~equal:String.equal blacklisted_flags_with_arg flag -> (* remove the flag and its arg separately in case we are at the end of an argfile *) - aux (true, res_rev, true) tl + aux in_argfiles (true, res_rev, true) tl | arg :: tl -> let arg' = replace_options_arg res_rev arg in - aux (false, arg' :: res_rev, changed || not (phys_equal arg arg')) tl + aux in_argfiles (false, arg' :: res_rev, changed || not (phys_equal arg arg')) tl in - match aux (false, [], false) args with _, res_rev, _ -> + match aux String.Set.empty (false, [], false) args with _, res_rev, _ -> (* return non-reversed list *) List.rev_append res_rev post_args @@ -180,19 +184,25 @@ let mk quoting_style ~prog ~args = {exec= prog; orig_argv= sanitized_args; argv= sanitized_args; quoting_style} -let command_to_run cmd = - let mk_cmd normalizer = - let {exec; argv; quoting_style} = normalizer cmd in - Printf.sprintf "'%s' %s" exec - (List.map ~f:(ClangQuotes.quote quoting_style) argv |> String.concat ~sep:" ") +let to_unescaped_args cmd = + let mk_exec_argv normalizer = + let {exec; argv} = normalizer cmd in + exec :: argv in - if can_attach_ast_exporter cmd then mk_cmd clang_cc1_cmd_sanitizer + if can_attach_ast_exporter cmd then mk_exec_argv clang_cc1_cmd_sanitizer else if String.is_prefix ~prefix:"clang" (Filename.basename cmd.exec) then (* `clang` supports argument files and the commands can be longer than the maximum length of the command line, so put arguments in a file *) - mk_cmd file_arg_cmd_sanitizer + mk_exec_argv file_arg_cmd_sanitizer else (* other commands such as `ld` do not support argument files *) - mk_cmd (fun x -> x) + mk_exec_argv (fun x -> x) + + +let pp f cmd = to_unescaped_args cmd |> Pp.cli_args f + +let command_to_run cmd = + to_unescaped_args cmd |> List.map ~f:(ClangQuotes.quote cmd.quoting_style) + |> String.concat ~sep:" " let with_plugin_args args = diff --git a/infer/src/clang/ClangCommand.mli b/infer/src/clang/ClangCommand.mli index 08e8746a4..f366f0187 100644 --- a/infer/src/clang/ClangCommand.mli +++ b/infer/src/clang/ClangCommand.mli @@ -33,3 +33,5 @@ val prepend_arg : string -> t -> t val append_args : string list -> t -> t val get_orig_argv : t -> string list + +val pp : Format.formatter -> t -> unit diff --git a/infer/src/integration/ClangQuotes.ml b/infer/src/integration/ClangQuotes.ml index 5e0cb667a..60d05147f 100644 --- a/infer/src/integration/ClangQuotes.ml +++ b/infer/src/integration/ClangQuotes.ml @@ -26,14 +26,13 @@ let quote style = | EscapedDoubleQuotes -> fun s -> "\"" ^ s ^ "\"" | SingleQuotes -> - let map = function '\'' -> Some "\\'" | '\\' -> Some "\\\\" | _ -> None in - fun s -> "'" ^ Escape.escape_map map s ^ "'" + fun s -> Escape.escape_in_single_quotes s let mk_arg_file prefix style args = let file = Filename.temp_file prefix ".txt" in let write_args outc = - Out_channel.output_string outc (List.map ~f:(quote style) args |> String.concat ~sep:" ") + List.map ~f:(quote style) args |> String.concat ~sep:" " |> Out_channel.output_string outc in Utils.with_file_out file ~f:write_args |> ignore ; L.(debug Capture Medium) "Clang options stored in file %s@\n" file ;