[DB] Remove many callsites of DB.source_file_to_string

Summary:
`DB.source_file_to_string` is very easy to misuse and it shouldn't even exist.
In preparation for that day, replace most of `source_file_to_string` with `source_file_pp`

Reviewed By: jvillard

Differential Revision: D4258390

fbshipit-source-id: 447cf5a

infer/src/IR/Exceptions.ml

@@ -343,8 +343,8 @@ let print_key = false
 let pp_err (_, node_key) loc ekind ex_name desc ml_loc_opt fmt () =
   let kind = err_kind_string (if ekind = Kinfo then Kwarning else ekind) (* eclipse does not know about infos: treat as warning *) in
   let pp_key fmt k = if print_key then F.fprintf fmt " key: %d " k else () in
-  F.fprintf fmt "%s:%d: %s: %a %a%a%a@\n"
-    (DB.source_file_to_string loc.Location.file)
+  F.fprintf fmt "%a:%d: %s: %a %a%a%a@\n"
+    DB.source_file_pp loc.Location.file
     loc.Location.line
     kind
     Localise.pp ex_name

infer/src/IR/Pvar.re

@@ -67,8 +67,8 @@ let rec _pp f pv => {
   | Global_var (fname, is_const, is_pod) =>
     F.fprintf
       f
-      "#GB<%s%s%s>$%a"
-      (DB.source_file_to_string fname)
+      "#GB<%a%s%s>$%a"
+      DB.source_file_pp fname
       (if is_const {"|const"} else {""})
       (
         if (not is_pod) {

infer/src/backend/InferPrint.re

@@ -839,7 +839,7 @@ let module Stats = {
             let pp1 fmt () => F.fprintf fmt "%d: %s" stats.nerrors type_str;
             let pp2 fmt () =>
               F.fprintf
-                fmt "  %s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line;
+                fmt "  %a:%d" DB.source_file_pp loc.Location.file loc.Location.line;
             let pp3 fmt () => F.fprintf fmt "  (%a)" Localise.pp_error_desc error_desc;
             [pp_to_string pp1 (), pp_to_string pp2 (), pp_to_string pp3 ()]
           };

infer/src/backend/clusterMakefile.ml

@@ -15,14 +15,6 @@ module CLOpt = CommandLineOption
 
 (** Module to create a makefile with dependencies between clusters *)
 
-(* this relies on the assumption that a source_file
-   can be converted to a string, then pname, then back *)
-let source_file_from_pname pname =
-  DB.source_file_from_string (Procname.to_string pname)
-
-let source_file_to_pname fname =
-  Procname.from_string_c_fun (DB.source_file_to_string fname)
-
 let cluster_should_be_analyzed cluster =
   let fname = DB.source_dir_to_string cluster in
   let in_ondemand_config = Option.map (StringSet.mem fname) Ondemand.dirs_to_analyze in

infer/src/backend/exe_env.ml

@@ -104,9 +104,9 @@ let add_cg (exe_env: t) (source_dir : DB.source_dir) =
                 if Config.check_duplicate_symbols &&
                    multiply_defined &&
                    origin <> `Include then
-                  L.stderr "@.DUPLICATE_SYMBOLS source: %s source_captured:%s pname:%a@."
-                    (DB.source_file_to_string source)
-                    (DB.source_file_to_string source_captured)
+                  L.stderr "@.DUPLICATE_SYMBOLS source: %a source_captured:%a pname:%a@."
+                    DB.source_file_pp source
+                    DB.source_file_pp source_captured
                     Procname.pp pname
            ))
         defined_procs;

infer/src/backend/interproc.ml

@@ -1575,8 +1575,8 @@ let print_stats_cfg proc_shadowed source cfg =
     (* F.fprintf fmt "VISITED: %a@\n" (pp_seq pp_node) nodes_visited;
        F.fprintf fmt "TOTAL: %a@\n" (pp_seq pp_node) nodes_total; *)
     F.fprintf fmt "@\n++++++++++++++++++++++++++++++++++++++++++++++++++@\n";
-    F.fprintf fmt "+ FILE: %s  VISITED: %d/%d SYMOPS: %d@\n"
-      (DB.source_file_to_string source)
+    F.fprintf fmt "+ FILE: %a  VISITED: %d/%d SYMOPS: %d@\n"
+      DB.source_file_pp source
       (IList.length nodes_visited)
       (IList.length nodes_total)
       !tot_symops;

infer/src/backend/printer.ml

@@ -505,12 +505,8 @@ let write_html_file linereader filename procs =
       (DB.Results_dir.Abs_source_dir filename)
       [".."; fname_encoding] in
   let pp_prelude () =
-    let s =
-      "<center><h1>File " ^
-      (DB.source_file_to_string filename) ^
-      "</h1></center>\n" ^
-      "<table class=\"code\">\n" in
-    F.fprintf fmt "%s" s in
+    F.fprintf fmt "<center><h1>File %a </h1></center>\n<table class=\"code\">\n"
+      DB.source_file_pp filename in
   let print_one_line proof_cover table_nodes_at_linenum table_err_per_line line_number =
     let line_html =
       match LineReader.from_file_linenum linereader filename line_number with

infer/src/base/DB.ml

@@ -79,6 +79,9 @@ let source_file_to_string fname =
   | RelativeInferModel path
   | Absolute path -> path
 
+let source_file_pp fmt fname =
+  Format.fprintf fmt "%s" (source_file_to_string fname)
+
 (* Checking if the path exists may be needed only in some cases, hence the flag check_exists *)
 let source_file_to_abs_path fname =
   match fname with

infer/src/base/DB.mli

@@ -105,6 +105,9 @@ val source_file_to_string : source_file -> string
 (** convert a string obtained by source_file_to_string to a source file *)
 val source_file_from_string : string -> source_file
 
+(** pretty print source_file *)
+val source_file_pp : Format.formatter -> source_file -> unit
+
 (** get the full path of a source file, raise No_project_root exception when used with a relative source file and no project root specified *)
 val source_file_to_abs_path : source_file -> string
 

infer/src/base/Process.ml

@@ -19,11 +19,14 @@ let print_unix_error cmd e =
 
 (** Prints an error message to a log file, prints a message saying that the error can be
     found in that file, and exits, with default code 1 or a given code. *)
-let print_error_and_exit ?(exit_code=1) f el =
-  Logging.do_err f el;
+let print_error_and_exit ?(exit_code=1) fmt =
+  Format.kfprintf (fun _ ->
+      Logging.do_err "%s" (Format.flush_str_formatter ());
       let log_file = snd (Logging.log_file_names ()) in
       Logging.stderr "@\nAn error occured. Please find details in %s@\n@\n%!" log_file;
       exit exit_code
+    )
+    Format.str_formatter fmt
 
 (** Executes a command and catches a potential exception and prints it. *)
 let exec_command cmd args env =

infer/src/base/Process.mli

@@ -22,7 +22,7 @@ val exec_command : string -> string array -> string array -> unit
 (** Prints an error message to a log file, prints a message saying that the error can be
     found in that file, and exist, with default code 1 or a given code. *)
 val print_error_and_exit :
-  ?exit_code:int -> ('a -> unit, Format.formatter, unit) format -> 'a -> 'b
+  ?exit_code:int -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 (** Prints information about a unix error *)
 val print_unix_error : string -> exn -> unit

infer/src/checkers/Siof.ml

@@ -110,7 +110,7 @@ let report_siof trace pdesc gname loc =
   let pp_sink f sink =
     let pp_source f v = match Pvar.get_source_file v with
       | Some source_file when not (DB.equal_source_file DB.source_file_empty source_file) ->
-          F.fprintf f " from file %s" (DB.source_file_to_string source_file)
+          F.fprintf f " from file %a" DB.source_file_pp source_file
       | _ ->
           () in
     let v = SiofTrace.Sink.kind sink in

infer/src/checkers/checkers.ml

@@ -25,7 +25,7 @@ module PP = struct
       match Printer.LineReader.from_loc linereader { loc with Location.line = n } with
       | Some s -> F.fprintf fmt "%s%s@\n" (if n = loc.Location.line then "-->" else "   ") s
       | _ -> () in
-    F.fprintf fmt "%s:%d@\n" (DB.source_file_to_string loc.Location.file) loc.Location.line;
+    F.fprintf fmt "%a:%d@\n" DB.source_file_pp loc.Location.file loc.Location.line;
     for n = loc.Location.line - nbefore to loc.Location.line + nafter do printline n done
 end (* PP *)
 
@@ -142,10 +142,9 @@ module ST = struct
       begin
         if !verbose then
           begin
-            let file = DB.source_file_to_string loc.Location.file in
-            L.stdout "%s: %s: %s@."
+            L.stdout "%s: %a: %s@."
               kind
-              file
+              DB.source_file_pp loc.Location.file
               (Procname.to_string proc_name);
             L.stdout "%s@." description
           end;
@@ -371,7 +370,7 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } =
         let missing = IList.filter was_not_found formal_names in
         let loc = Procdesc.get_loc proc_desc in
         let pp_file_loc fmt () =
-          F.fprintf fmt "%s:%d" (DB.source_file_to_string loc.Location.file) loc.Location.line in
+          F.fprintf fmt "%a:%d" DB.source_file_pp loc.Location.file loc.Location.line in
         L.stdout "Null Checks of Formal Parameters: ";
         L.stdout "%d out of %d parameters checked (missing checks on: %a)[%a]@."
           nchecks nformals (pp_seq Mangled.pp) missing pp_file_loc ();

infer/src/checkers/repeatedCallsChecker.ml

@@ -129,10 +129,10 @@ struct
                 match proc_performs_allocation tenv proc_desc AllPaths with
                 | Some alloc_loc ->
                     let description =
-                      Printf.sprintf "call to %s seen before on line %d (may allocate at %s:%n)"
+                      Format.asprintf "call to %s seen before on line %d (may allocate at %a:%d)"
                         (Procname.to_simplified_string callee_pname)
                         loc_old.Location.line
-                        (DB.source_file_to_string alloc_loc.Location.file)
+                        DB.source_file_pp alloc_loc.Location.file
                         alloc_loc.Location.line in
                     Checkers.ST.report_error tenv
                       curr_pname curr_pdesc checkers_repeated_calls_name loc description

infer/src/clang/Capture.re

@@ -44,7 +44,7 @@ let register_perf_stats_report source_file => {
 
 let init_global_state_for_capture_and_linters source_file => {
   Logging.set_log_file_identifier
-    CommandLineOption.Clang (Some (Filename.basename (DB.source_file_to_string source_file)));
+    CommandLineOption.Clang (Some (Filename.basename (DB.source_file_to_abs_path source_file)));
   register_perf_stats_report source_file;
   Config.curr_language := Config.Clang;
   DB.Results_dir.init source_file;
@@ -80,10 +80,12 @@ let run_clang_frontend ast_source => {
       {CFrontend_config.source_file: source_file, lang}
     | _ => assert false
     };
-  let ast_filename =
+  let pp_ast_filename fmt ast_source =>
     switch ast_source {
-    | `File path => path
-    | `Pipe _ => "stdin of " ^ DB.source_file_to_string trans_unit_ctx.CFrontend_config.source_file
+    | `File path => Format.fprintf fmt "%s" path
+    | `Pipe _ =>
+      Format.fprintf
+        fmt "stdin of %a" DB.source_file_pp trans_unit_ctx.CFrontend_config.source_file
     };
   let (decl_index, stmt_index, type_index, ivar_to_property_index) = Clang_ast_main.index_node_pointers ast_decl;
   CFrontend_config.pointer_decl_index := decl_index;
@@ -91,14 +93,15 @@ let run_clang_frontend ast_source => {
   CFrontend_config.pointer_type_index := type_index;
   CFrontend_config.ivar_to_property_index := ivar_to_property_index;
   Logging.out "Clang frontend action is  %s@\n" Config.clang_frontend_action_string;
-  Logging.out "Start %s of AST from %s@\n" Config.clang_frontend_action_string ast_filename;
+  Logging.out
+    "Start %s of AST from %a@\n" Config.clang_frontend_action_string pp_ast_filename ast_source;
   if Config.clang_frontend_do_lint {
     CFrontend_checkers_main.do_frontend_checks trans_unit_ctx ast_decl
   };
   if Config.clang_frontend_do_capture {
     CFrontend.do_source_file trans_unit_ctx ast_decl
   };
-  Logging.out "End translation AST file %s... OK!@\n" ast_filename;
+  Logging.out "End translation AST file %a... OK!@\n" pp_ast_filename ast_source;
   print_elapsed ()
 };
 

infer/src/clang/cFrontend.ml

@@ -44,11 +44,11 @@ let do_source_file translation_unit_context ast =
   CType_decl.add_predefined_types tenv;
   init_global_state_capture ();
   let source_file = translation_unit_context.CFrontend_config.source_file in
-  Logging.out_debug "@\n Start building call/cfg graph for '%s'....@\n"
-    (DB.source_file_to_string source_file);
+  Logging.out_debug "@\n Start building call/cfg graph for '%a'....@\n"
+    DB.source_file_pp source_file;
   let call_graph, cfg = compute_icfg translation_unit_context tenv ast in
-  Logging.out_debug "@\n End building call/cfg graph for '%s'.@\n"
-    (DB.source_file_to_string source_file);
+  Logging.out_debug "@\n End building call/cfg graph for '%a'.@\n"
+    DB.source_file_pp source_file;
   (* This part below is a boilerplate in every frontends. *)
   (* This could be moved in the cfg_infer module *)
   let source_dir = DB.source_dir_from_source_file source_file in

infer/src/clang/cFrontend_checkers_main.ml

@@ -118,7 +118,7 @@ let do_frontend_checks trans_unit_ctx ast =
   try
     parse_ctl_file Config.linters_def_file;
     let source_file = trans_unit_ctx.CFrontend_config.source_file in
-    Logging.out "Start linting file %s@\n" (DB.source_file_to_string source_file);
+    Logging.out "Start linting file %a@\n" DB.source_file_pp source_file;
     match ast with
     | Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) ->
         let context =
@@ -132,7 +132,7 @@ let do_frontend_checks trans_unit_ctx ast =
         IList.iter (do_frontend_checks_decl context) allowed_decls;
         if (LintIssues.exists_issues ()) then
           store_issues source_file;
-        Logging.out "End linting file %s@\n" (DB.source_file_to_string source_file);
+        Logging.out "End linting file %a@\n" DB.source_file_pp source_file;
         CTL.save_dotty_when_in_debug_mode trans_unit_ctx.CFrontend_config.source_file;
     | _ -> assert false (* NOTE: Assumes that an AST alsways starts with a TranslationUnitDecl *)
   with

infer/src/clang/cTL.ml

@@ -252,7 +252,7 @@ let save_dotty_when_in_debug_mode source_file =
   | Some tracker ->
       let dotty_dir = Config.results_dir // Config.lint_dotty_dir_name in
       create_dir dotty_dir;
-      let source_file_basename = Filename.basename (DB.source_file_to_string source_file) in
+      let source_file_basename = Filename.basename (DB.source_file_to_abs_path source_file) in
       let file = dotty_dir // (source_file_basename ^ ".dot") in
       let dotty = Debug.EvaluationTracker.DottyPrinter.dotty_of_ctl_evaluation !tracker in
       with_file file ~f:(fun oc -> output_string oc dotty)

infer/src/eradicate/typeErr.ml

@@ -240,24 +240,14 @@ type st_report_error =
 let report_error_now tenv
     (st_report_error : st_report_error) err_instance loc pdesc : unit =
   let pname = Procdesc.get_proc_name pdesc in
-  let demo_mode = true in
-  let do_print_base ew_string kind_s s =
+  let do_print ew_string kind_s s =
+    L.stdout "%a:%d " DB.source_file_pp loc.Location.file loc.Location.line;
     let mname = match pname with
       | Procname.Java pname_java ->
           Procname.java_get_method pname_java
       | _ ->
           Procname.to_simplified_string pname in
     L.stdout "%s %s in %s %s@." ew_string kind_s mname s in
-  let do_print ew_string kind_s s =
-    L.stdout "%s:%d " (DB.source_file_to_string loc.Location.file) loc.Location.line;
-    do_print_base ew_string kind_s s in
-  let do_print_demo ew_string kind_s s = (* demo mode print for Eclipse and ocaml plugin *)
-    let process_path s = filename_to_relative (Sys.getcwd ()) s in
-    L.stdout
-      "File %s, line %d, characters 0-10:\n"
-      (process_path (DB.source_file_to_string loc.Location.file))
-      loc.Location.line;
-    do_print_base ew_string kind_s s in
 
   let is_err, kind_s, description, advice, field_name, origin_loc = match err_instance with
     | Condition_redundant (b, s_opt, nonnull) ->
@@ -458,7 +448,7 @@ let report_error_now tenv
         None,
         None in
   let ew_string = if is_err then "Error" else "Warning" in
-  (if demo_mode then do_print_demo else do_print) ew_string kind_s description;
+  do_print ew_string kind_s description;
   let always_report = Strict.err_instance_get_strict tenv err_instance <> None in
   st_report_error
     pname

infer/src/integration/CaptureCompilationDatabase.ml

@@ -95,8 +95,8 @@ let run_compilation_file compilation_database file =
         Array.append env0 [|CLOpt.args_env_var ^ "=--fcp-syntax-only"|] in
     (Some compilation_data.dir, wrapper_cmd, args, env)
   with Not_found ->
-    Process.print_error_and_exit "Failed to find compilation data for %s \n%!"
-      (DB.source_file_to_string file)
+    Process.print_error_and_exit "Failed to find compilation data for %a \n%!"
+      DB.source_file_pp file
 
 let run_compilation_database compilation_database should_capture_file =
   let number_of_files = CompilationDatabase.get_size compilation_database in
@@ -104,7 +104,8 @@ let run_compilation_database compilation_database should_capture_file =
   Logging.stdout "Starting %s %d files \n%!" capture_text number_of_files;
   let jobs_stack = create_files_stack compilation_database should_capture_file in
   let capture_text_upper = String.capitalize capture_text in
-  let job_to_string = fun file -> capture_text_upper ^ " " ^ (DB.source_file_to_string file) in
+  let job_to_string =
+    fun file -> Format.asprintf "%s %a" capture_text_upper DB.source_file_pp file in
   Process.run_jobs_in_parallel jobs_stack (run_compilation_file compilation_database) job_to_string
 
 (** Computes the compilation database files. *)

infer/src/java/jMain.ml

@@ -64,8 +64,8 @@ let store_icfg source_file tenv cg cfg =
 let do_source_file
     linereader classes program tenv
     source_basename package_opt source_file =
-  L.out_debug "\nfilename: %s (%s)@."
-    (DB.source_file_to_string source_file) source_basename;
+  L.out_debug "\nfilename: %a (%s)@."
+    DB.source_file_pp source_file source_basename;
   let call_graph, cfg =
     JFrontend.compute_source_icfg
       linereader classes program tenv