Core.Std.Sys

Reviewed By: cristianoc

Differential Revision: D4232434

fbshipit-source-id: 3b183c6

infer/src/IR/AttributesTable.re

@@ -61,7 +61,7 @@ let write_and_delete proc_name (proc_attributes: ProcAttributes.t) => {
   Serialization.to_file serializer (attributes_file proc_attributes.is_defined) proc_attributes;
   if proc_attributes.is_defined {
     let fname_declared = DB.filename_to_string (attributes_file false);
-    if (Sys.file_exists fname_declared) {
+    if (Sys.file_exists fname_declared == `Yes) {
       try (Unix.unlink fname_declared) {
       | Unix.Unix_error _ => ()
       }
@@ -220,7 +220,7 @@ let find_file_capturing_procedure pname =>
       SourceFile.compare source_file proc_attributes.ProcAttributes.loc.file != 0 ?
         `Include : `Source;
     let cfg_fname = DB.source_dir_get_internal_file source_dir ".cfg";
-    let cfg_fname_exists = Sys.file_exists (DB.filename_to_string cfg_fname);
+    let cfg_fname_exists = Sys.file_exists (DB.filename_to_string cfg_fname) == `Yes;
     if cfg_fname_exists {
       Some (source_file, origin)
     } else {

infer/src/backend/InferAnalyzeExe.re

@@ -38,7 +38,7 @@ let () = {
   if Config.print_builtins {
     Builtin.print_and_exit ()
   };
-  if (not (Sys.file_exists Config.results_dir)) {
+  if (Sys.file_exists Config.results_dir != `Yes) {
     L.err "ERROR: results directory %s does not exist@.@." Config.results_dir;
     Config.print_usage_exit ()
   };

infer/src/backend/InferPrint.re

@@ -23,7 +23,7 @@ let print_usage_exit err_s => {
 let load_specfiles () => {
   let specs_files_in_dir dir => {
     let is_specs_file fname =>
-      not (Sys.is_directory fname) && Filename.check_suffix fname Config.specs_files_suffix;
+      Sys.is_directory fname != `Yes && Filename.check_suffix fname Config.specs_files_suffix;
     let all_filenames =
       try (Array.to_list (Sys.readdir dir)) {
       | Sys_error _ => []

infer/src/backend/StatsAggregator.re

@@ -18,10 +18,7 @@ let json_files_to_ignore_regex = Str.regexp (
   "\\|" ^ Str.quote aggregated_stats_by_target_filename ^ "\\)$"
 );
 
-let dir_exists dir =>
-  try (Sys.is_directory dir) {
-  | Sys_error _ => false
-  };
+let dir_exists dir => Sys.is_directory dir == `Yes;
 
 let find_json_files_in_dir dir => {
   let is_valid_json_file path => {

infer/src/backend/crashcontext.ml

@@ -73,7 +73,7 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
     Utils.directory_fold
       (fun summaries path ->
          (* check if the file is a JSON file under the crashcontext dir *)
-         if not (Sys.is_directory path) && Filename.check_suffix path "json" &&
+         if (Sys.is_directory path) != `Yes && Filename.check_suffix path "json" &&
             String.is_suffix ~suffix:"crashcontext" (Filename.dirname path)
          then path :: summaries
          else summaries)

infer/src/backend/exe_env.ml

@@ -26,7 +26,7 @@ type file_data =
 (** get the path to the tenv file, which either one tenv file per source file or a global tenv file *)
 let tenv_filename file_base =
   let per_source_tenv_filename = DB.filename_add_suffix file_base ".tenv" in
-  if Sys.file_exists (DB.filename_to_string per_source_tenv_filename) then
+  if Sys.file_exists (DB.filename_to_string per_source_tenv_filename) = `Yes then
     per_source_tenv_filename
   else
     DB.global_tenv_fname

infer/src/backend/infer.ml

@@ -283,8 +283,8 @@ let analyze = function
   | Java | Javac ->
       (* In Java and Javac modes, analysis is invoked from capture. *)
       ()
-  | Analyze | Ant | Buck | ClangCompilationDatabase | Genrule | Gradle | Make | Mvn | Ndk | Xcode ->
-      if not (Sys.file_exists Config.(results_dir // captured_dir_name)) then (
+  | Analyze | Ant | Buck | ClangCompilationDatabase | Gradle | Genrule | Make | Mvn | Ndk | Xcode ->
+      if (Sys.file_exists Config.(results_dir // captured_dir_name)) != `Yes then (
         L.stderr "There was nothing to analyze, exiting" ;
         Config.print_usage_exit ()
       );

infer/src/backend/mergeCapture.ml

@@ -106,10 +106,10 @@ let create_multilinks () =
 let rec slink ~stats ~skiplevels src dst =
   if debug >=3
   then L.stderr "slink src:%s dst:%s skiplevels:%d@." src dst skiplevels;
-  if Sys.is_directory src
+  if Sys.is_directory src = `Yes
   then
     begin
-      if not (Sys.file_exists dst)
+      if (Sys.file_exists dst) != `Yes
       then Unix.mkdir dst ~perm:0o700;
       let items = Sys.readdir src in
       Array.iter
@@ -139,22 +139,22 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst =
         file time_orig time_link;
     time_link > time_orig in
   let symlinks_up_to_date captured_file =
-    if Sys.is_directory captured_file then
+    if Sys.is_directory captured_file = `Yes then
       let contents = Array.to_list (Sys.readdir captured_file) in
       IList.for_all
         (fun file ->
            let file_path = Filename.concat captured_file file in
-           Sys.file_exists file_path &&
+           Sys.file_exists file_path = `Yes &&
            (not check_timestamp_of_symlinks || symlink_up_to_date file_path))
         contents
     else true in
   let check_file captured_file =
-    Sys.file_exists captured_file &&
+    Sys.file_exists captured_file = `Yes &&
     symlinks_up_to_date captured_file in
   let was_copied () =
     let captured_src = Filename.concat infer_out_src Config.captured_dir_name in
     let captured_dst = Filename.concat infer_out_dst Config.captured_dir_name in
-    if Sys.file_exists captured_src && Sys.is_directory captured_src
+    if Sys.file_exists captured_src = `Yes && Sys.is_directory captured_src = `Yes
     then
       begin
         let captured_files = Array.to_list (Sys.readdir captured_src) in

infer/src/backend/specs.ml

@@ -548,7 +548,7 @@ let specs_models_filename pname =
   DB.filename_from_string (Filename.concat Config.models_dir (specs_filename pname))
 
 let summary_exists_in_models pname =
-  Sys.file_exists (DB.filename_to_string (specs_models_filename pname))
+  Sys.file_exists (DB.filename_to_string (specs_models_filename pname)) = `Yes
 
 let summary_serializer : summary Serialization.serializer =
   Serialization.create_serializer Serialization.summary_key

infer/src/backend/timeout.ml

@@ -83,7 +83,9 @@ let timeout_action _ =
   unset_alarm ();
   raise (SymOp.Analysis_failure_exe (FKtimeout))
 
-let () = begin
+let () =
+  (* Can't use Core since it wraps signal handlers with a catch-all exception handler that exits *)
+  let module Sys = Caml.Sys in
   match Config.os_type with
   | Config.Unix | Config.Cygwin ->
       Sys.set_signal Sys.sigvtalrm (Sys.Signal_handle timeout_action);
@@ -92,7 +94,6 @@ let () = begin
       SymOp.set_wallclock_timeout_handler timeout_action;
       (* use the Gc alarm for periodic timeout checks *)
       ignore (Gc.create_alarm SymOp.check_wallclock_alarm)
-end
 
 let unwind () =
   unset_alarm ();

infer/src/base/CommandLineOption.ml

@@ -596,11 +596,11 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
   ;
   full_speclist := add_or_suppress_help (normalize !full_desc_list)
   ;
-  let env_args = decode_env_to_argv (try Sys.getenv args_env_var with Not_found -> "") in
+  let env_args = decode_env_to_argv (Core.Std.Option.value (Sys.getenv args_env_var) ~default:"") in
   (* begin transitional support for INFERCLANG_ARGS *)
   let c_args =
     Str.split (Str.regexp_string (String.make 1 ':'))
-      (try Sys.getenv "INFERCLANG_ARGS" with Not_found -> "") in
+      (Core.Std.Option.value (Sys.getenv "INFERCLANG_ARGS") ~default:"") in
   let env_args = c_args @ env_args in
   (* end transitional support for INFERCLANG_ARGS *)
   let exe_name = Sys.executable_name in

infer/src/base/Config.ml

@@ -392,26 +392,27 @@ let patterns_of_json_with_key json_key json =
 (** The working directory of the initial invocation of infer, to which paths passed as command line
     options are relative. *)
 let init_work_dir, is_originator =
-  try
-    (Sys.getenv "INFER_CWD", false)
-  with Not_found ->
-    let cwd =
-      (* Use PWD if it denotes the same inode as ., to try to avoid paths with symlinks resolved *)
-      (* Approach is borrowed from llvm implementation of *)
-      (* llvm::sys::fs::current_path (implemented in Path.inc file) *)
-      try
-        let pwd = Sys.getenv "PWD" in
-        let pwd_stat = Unix.stat pwd in
-        let dot_stat = Unix.stat "." in
-        if pwd_stat.st_dev = dot_stat.st_dev && pwd_stat.st_ino = dot_stat.st_ino then
-          pwd
-        else
-          Sys.getcwd ()
-      with _ ->
-        Sys.getcwd () in
-    let real_cwd = realpath cwd in
-    Unix.putenv ~key:"INFER_CWD" ~data:real_cwd;
-    (real_cwd, true)
+  match Sys.getenv "INFER_CWD" with
+  | Some dir ->
+      (dir, false)
+  | None ->
+      let cwd =
+        (* Use PWD if it denotes the same inode as ., to try to avoid paths with symlinks resolved *)
+        (* Approach is borrowed from llvm implementation of *)
+        (* llvm::sys::fs::current_path (implemented in Path.inc file) *)
+        match Sys.getenv "PWD" with
+        | Some pwd ->
+            let pwd_stat = Unix.stat pwd in
+            let dot_stat = Unix.stat "." in
+            if pwd_stat.st_dev = dot_stat.st_dev && pwd_stat.st_ino = dot_stat.st_ino then
+              pwd
+            else
+              Sys.getcwd ()
+        | None ->
+            Sys.getcwd () in
+      let real_cwd = realpath cwd in
+      Unix.putenv ~key:"INFER_CWD" ~data:real_cwd;
+      (real_cwd, true)
 
 (** Resolve relative paths passed as command line options, i.e., with respect to the working
     directory of the initial invocation of infer. *)

infer/src/base/DB.ml

@@ -49,7 +49,7 @@ let find_source_dirs () =
       files in
   IList.iter (fun fname ->
       let dir = Filename.concat captured_dir fname in
-      if Sys.is_directory dir then add_cg_files_from_dir dir)
+      if Sys.is_directory dir = `Yes then add_cg_files_from_dir dir)
     files_in_results_dir;
   IList.rev !source_dirs
 
@@ -67,7 +67,7 @@ let filename_add_suffix fn s = fn ^ s
 
 let chop_extension = Filename.chop_extension
 
-let file_exists = Sys.file_exists
+let file_exists path = Sys.file_exists path = `Yes
 
 let file_remove = Sys.remove
 
@@ -92,7 +92,7 @@ let file_modified_time ?(symlink=false) fname =
 
 let filename_create_dir fname =
   let dirname = Filename.dirname fname in
-  if not (Sys.file_exists dirname)
+  if (Sys.file_exists dirname) != `Yes
   then create_dir dirname
 
 let read_whole_file fd =
@@ -248,7 +248,7 @@ let fold_paths_matching ~dir ~p ~init ~f =
     Array.fold_left
       (fun acc file ->
          let path = dir // file in
-         if Sys.is_directory path then (paths acc path)
+         if Sys.is_directory path = `Yes then (paths acc path)
          else if p path then f path acc
          else acc)
       path_list

infer/src/base/Multilinks.re

@@ -52,7 +52,7 @@ let lookup dir::dir =>
 
 let resolve fname => {
   let fname_s = DB.filename_to_string fname;
-  if (Sys.file_exists fname_s) {
+  if (Sys.file_exists fname_s == `Yes) {
     fname
   } else {
     let base = Filename.basename fname_s;

infer/src/base/SourceFile.ml

@@ -124,7 +124,7 @@ let exists_cache = String.Table.create ~size:256 ()
 let path_exists abs_path =
   try String.Table.find_exn exists_cache abs_path
   with Not_found ->
-    let result = Sys.file_exists abs_path in
+    let result = Sys.file_exists abs_path = `Yes in
     String.Table.set exists_cache ~key:abs_path ~data:result;
     result
 

infer/src/base/Utils.ml

@@ -11,12 +11,32 @@
 (** General utility functions and definition with global scope *)
 
 module Bool = Core.Std.Bool
+module Caml = Core.Std.Caml
 module Filename = Core.Std.Filename
 module In_channel = Core.Std.In_channel
 module Int = Core.Std.Int
 module Pid = Core.Std.Pid
 module String = Core.Std.String
 module Unix = Core.Std.Unix
+module Signal = Core.Std.Signal
+
+module Sys = struct
+  include Core.Std.Sys
+
+  (* Core_sys does not catch Unix_error ENAMETOOLONG, see
+     https://github.com/janestreet/core/issues/76 *)
+  let file_exists ?follow_symlinks path =
+    try file_exists ?follow_symlinks path
+    with Unix.Unix_error _ -> `Unknown
+
+  let is_directory ?follow_symlinks path =
+    try is_directory ?follow_symlinks path
+    with Unix.Unix_error _ -> `Unknown
+
+  let is_file ?follow_symlinks path =
+    try is_file ?follow_symlinks path
+    with Unix.Unix_error _ -> `Unknown
+end
 
 module F = Format
 
@@ -440,7 +460,7 @@ let directory_fold f init path =
   let collect current_dir (accu, dirs) path =
     let full_path = current_dir // path in
     try
-      if Sys.is_directory full_path then
+      if Sys.is_directory full_path = `Yes then
         (accu, full_path:: dirs)
       else
         (f accu full_path, dirs)
@@ -452,7 +472,7 @@ let directory_fold f init path =
     | d:: tl ->
         let (new_accu, new_dirs) = Array.fold_left (collect d) (accu, tl) (Sys.readdir d) in
         loop new_accu new_dirs in
-  if Sys.is_directory path then
+  if Sys.is_directory path = `Yes then
     loop init [path]
   else
     f init path
@@ -462,7 +482,7 @@ let directory_iter f path =
   let apply current_dir dirs path =
     let full_path = current_dir // path in
     try
-      if Sys.is_directory full_path then
+      if Sys.is_directory full_path = `Yes then
         full_path:: dirs
       else
         let () = f full_path in
@@ -475,7 +495,7 @@ let directory_iter f path =
     | d:: tl ->
         let new_dirs = Array.fold_left (apply d) tl (Sys.readdir d) in
         loop new_dirs in
-  if Sys.is_directory path then
+  if Sys.is_directory path = `Yes then
     loop [path]
   else
     f path
@@ -503,7 +523,7 @@ let string_append_crc_cutoff ?(cutoff=100) ?(key="") name =
   name_up_to_cutoff ^ "." ^ crc_str
 
 let read_optional_json_file path =
-  if Sys.file_exists path then
+  if Sys.file_exists path = `Yes then
     try
       Ok (Yojson.Basic.from_file path)
     with Sys_error msg | Yojson.Json_error msg ->

infer/src/base/Utils.mli

@@ -11,12 +11,15 @@
 (** General utility functions *)
 
 module Bool = Core.Std.Bool
+module Caml = Core.Std.Caml
 module Filename = Core.Std.Filename
 module In_channel = Core.Std.In_channel
 module Int = Core.Std.Int
 module Pid = Core.Std.Pid
 module String = Core.Std.String
 module Unix = Core.Std.Unix
+module Signal = Core.Std.Signal
+module Sys : module type of Core.Std.Sys
 
 (** {2 Generic Utility Functions} *)
 

infer/src/base/ZipLib.ml

@@ -28,7 +28,7 @@ let load_from_cache serializer zip_path cache_dir zip_library =
   let absolute_path = Filename.concat cache_dir zip_path in
   let deserialize = Serialization.from_file serializer in
   let extract to_path =
-    if not (Sys.file_exists to_path) then
+    if (Sys.file_exists to_path) != `Yes then
       begin
         Unix.mkdir_p (Filename.dirname to_path);
         let lazy zip_channel = zip_library.zip_channel in
@@ -82,7 +82,7 @@ let zip_libraries =
         IList.fold_left add_zip [] Config.specs_library in
     if Config.checkers then
       zip_libs
-    else if Sys.file_exists Config.models_jar then
+    else if Sys.file_exists Config.models_jar = `Yes then
       (mk_zip_lib true Config.models_jar) :: zip_libs
     else
       zip_libs

infer/src/clang/Capture.re

@@ -143,7 +143,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
       String.concat
         sep::"^"
         (
-          Core.Std.Option.to_list (Core.Std.Sys.getenv CLOpt.args_env_var) @ [
+          Core.Std.Option.to_list (Sys.getenv CLOpt.args_env_var) @ [
             "--clang-biniou-file",
             biniou_fname
           ]

infer/src/java/jClasspath.ml

@@ -59,7 +59,7 @@ let collect_specs_filenames jar_filename =
 
 let add_models jar_filename =
   models_jar := jar_filename;
-  if Sys.file_exists !models_jar then
+  if Sys.file_exists !models_jar = `Yes then
     collect_specs_filenames jar_filename
   else
     failwith "Java model file not found"
@@ -73,7 +73,7 @@ let split_classpath cp = Str.split (Str.regexp JFile.sep) cp
 
 
 let append_path classpath path =
-  if Sys.file_exists path then
+  if Sys.file_exists path = `Yes then
     let full_path = filename_to_absolute path in
     if String.length classpath = 0 then
       full_path

infer/src/java/jFrontend.ml

@@ -111,7 +111,7 @@ let cache_classname cn =
     split [] (Filename.dirname path) in
   let rec mkdir l p =
     let () =
-      if not (Sys.file_exists p) then
+      if (Sys.file_exists p) != `Yes then
         Unix.mkdir p ~perm:493 in
     match l with
     | [] -> ()
@@ -122,7 +122,7 @@ let cache_classname cn =
   close_out file_out
 
 let is_classname_cached cn =
-  Sys.file_exists (path_of_cached_classname cn)
+  Sys.file_exists (path_of_cached_classname cn) = `Yes
 
 
 (* Given a source file and a class, translates the code of this class.

infer/src/java/jMain.ml

@@ -15,7 +15,7 @@ open Javalib_pack
 module L = Logging
 
 let () =
-  match Config.models_mode, Sys.file_exists Config.models_jar with
+  match Config.models_mode, Sys.file_exists Config.models_jar == `Yes with
   | true, false ->
       ()
   | false, false ->