System calls to filesystem are expensive, call them with care

Summary:
Fix potential performance problems in `CLocation` module
1. Don't call `Unix.stat` to compare files if it's enough to compare paths
2. Use C implementation of `realpath` and call it only when it's really necessary

This diff breaks `Location.nLOC` information for whole clang frontend, but it's going away soon anyway

Reviewed By: jvillard, jberdine

Differential Revision: D4132526

fbshipit-source-id: f01afe8

infer/src/base/Config.ml

@@ -238,7 +238,7 @@ let initial_analysis_time = Unix.time ()
 (* Resolve symlinks to get to the real executable. The real executable is located in [bin_dir]
    below, which allows us to find [lib_dir], [models_dir], etc., relative to it. *)
 let real_exe_name =
-  real_path Sys.executable_name
+  Core.Std.Filename.realpath Sys.executable_name
 
 let current_exe =
   if !Sys.interactive then CLOpt.Interactive
@@ -404,7 +404,7 @@ let init_work_dir, is_originator =
           Sys.getcwd ()
       with _ ->
         Sys.getcwd () in
-    let real_cwd = real_path cwd in
+    let real_cwd = Core.Std.Filename.realpath cwd in
     Unix.putenv "INFER_CWD" real_cwd;
     (real_cwd, true)
 
@@ -1469,6 +1469,7 @@ and print_types = !print_types
 and print_using_diff = !print_using_diff
 and procs_csv = !procs_csv
 and procs_xml = !procs_xml
+and project_root_realpath = Core.Std.Filename.realpath project_root
 and quandary = !quandary
 and quiet = !quiet
 and reactive_mode = !reactive

infer/src/base/Config.mli

@@ -229,6 +229,7 @@ val print_using_diff : bool
 val procs_csv : string option
 val procs_xml : string option
 val project_root : string
+val project_root_realpath : string
 val quandary : bool
 val quiet : bool
 val reactive_mode : bool

infer/src/base/Utils.ml

@@ -677,27 +677,3 @@ let rec create_path path =
   | Unix.Unix_error (Unix.ENOENT, _, _) ->
       create_path (Filename.dirname path);
       create_dir path
-
-let real_path path =
-  (* Splits a path into its parts. For example:
-     - (split "path/to/file") is [".", "path"; "to"; "file"]
-     - (split "/path/to/file") is ["/", "path"; "to"; "file"] *)
-  let split path =
-    let rec loop accu p =
-      match Filename.dirname p with
-      | d when d = p -> d :: accu
-      | d -> loop ((Filename.basename p) :: accu) d in
-    loop [] path in
-  let rec resolve p =
-    match Unix.readlink p with
-    | link when Filename.is_relative link ->
-        (* [p] is a relative symbolic link *)
-        resolve ((Filename.dirname p) // link)
-    | link ->
-        (* [p] is an absolute symbolic link *)
-        resolve link
-    | exception Unix.Unix_error(Unix.EINVAL, _, _) ->
-        (* [p] is not a symbolic link *)
-        p in
-  IList.fold_left
-    (fun resolved_path p -> resolve (resolved_path // p)) "" (split path)

infer/src/base/Utils.mli

@@ -305,8 +305,3 @@ val create_dir : string -> unit
 (** [create_path path] will create a directory at [path], creating all the parent directories if
     non-existing *)
 val create_path : string -> unit
-
-(** Recursively resolve symlinks until we get something that is not a link. Executables may be
-    (multiple levels of) symbolic links to the real binary directory, eg after `make install` or
-    packaging. *)
-val real_path : string -> string

infer/src/clang/cLocation.ml

@@ -31,13 +31,21 @@ let clang_to_sil_location trans_unit_ctx clang_loc =
   Location.{line; col; file; nLOC}
 
 let file_in_project file =
-  let real_root = real_path Config.project_root in
+  (* Look at file paths before resolving them to real paths. Do it to
-  let real_file = real_path file in
+     improve performance of most likely case when calling realpath is not needed *)
-  let file_in_project = string_is_prefix real_root real_file in
+  let file_in_project, used_project_root, used_file =
+    if string_is_prefix Config.project_root file then
+      true, Config.project_root, file
+    else if string_is_prefix Config.project_root_realpath file then
+      true, Config.project_root_realpath, file
+    else
+      let real_root = Config.project_root_realpath in
+      let real_file = Core.Std.Filename.realpath file in
+      string_is_prefix real_root real_file, real_root, real_file in
   let paths = Config.skip_translation_headers in
   let file_should_be_skipped =
     IList.exists
-      (fun path -> string_is_prefix (Filename.concat real_root path) real_file)
+      (fun path -> string_is_prefix (Filename.concat used_project_root path) used_file)
       paths in
   file_in_project && not (file_should_be_skipped)
 
@@ -65,7 +73,10 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra
     let path_pred path = pred (source_file_from_path path) in
     map_path_of path_pred loc
   in
-  let equal_current_source = DB.inode_equal trans_unit_ctx.CFrontend_config.source_file
+  (* it's not necessary to compare inodes here because both files come from
+     the same context - they are produced by the same invocation of ASTExporter
+     which uses same logic to produce both files *)
+  let equal_current_source = DB.source_file_equal trans_unit_ctx.CFrontend_config.source_file
   in
   let file_in_project = map_path_of file_in_project loc_end
                         || map_path_of file_in_project loc_start in