[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

@@ -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)

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 *)

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 "@[<hov2>  " ;
+    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 "@[<hov2>  " ;
+                 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

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 )

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 =

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

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 ;