diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index 657c6c06a..90f4feb7a 100644 --- a/infer/src/IR/AttributesTable.re +++ b/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 { diff --git a/infer/src/backend/InferAnalyzeExe.re b/infer/src/backend/InferAnalyzeExe.re index 826acca4b..04f969238 100644 --- a/infer/src/backend/InferAnalyzeExe.re +++ b/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 () }; diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 0470bdfd4..8e6473501 100644 --- a/infer/src/backend/InferPrint.re +++ b/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 _ => [] diff --git a/infer/src/backend/StatsAggregator.re b/infer/src/backend/StatsAggregator.re index c94c50170..cfe54c393 100644 --- a/infer/src/backend/StatsAggregator.re +++ b/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 => { diff --git a/infer/src/backend/crashcontext.ml b/infer/src/backend/crashcontext.ml index 80c5a0331..0a331be84 100644 --- a/infer/src/backend/crashcontext.ml +++ b/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) diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 7fc88d361..457b9ff7a 100644 --- a/infer/src/backend/exe_env.ml +++ b/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 diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 013009ae4..c1c550aa5 100644 --- a/infer/src/backend/infer.ml +++ b/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 () ); diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index 00118246d..aed8c1b73 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/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 diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 5ab934bca..21726d6a4 100644 --- a/infer/src/backend/specs.ml +++ b/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 diff --git a/infer/src/backend/timeout.ml b/infer/src/backend/timeout.ml index 573dc11d3..0eaab44f8 100644 --- a/infer/src/backend/timeout.ml +++ b/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 (); diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 93737cd4c..54285942a 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/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 diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 84a261942..e4e3b4d8e 100644 --- a/infer/src/base/Config.ml +++ b/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. *) diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index bdac34a84..fde62dd6d 100644 --- a/infer/src/base/DB.ml +++ b/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 diff --git a/infer/src/base/Multilinks.re b/infer/src/base/Multilinks.re index 0d813f572..eb426216a 100644 --- a/infer/src/base/Multilinks.re +++ b/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; diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index bd2e2f717..1c60583e0 100644 --- a/infer/src/base/SourceFile.ml +++ b/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 diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 7e26f62f6..a893242a3 100644 --- a/infer/src/base/Utils.ml +++ b/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 -> diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index dd8d6abb8..97ca9a5a9 100644 --- a/infer/src/base/Utils.mli +++ b/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} *) diff --git a/infer/src/base/ZipLib.ml b/infer/src/base/ZipLib.ml index 7ec36eb9c..291863949 100644 --- a/infer/src/base/ZipLib.ml +++ b/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 diff --git a/infer/src/clang/Capture.re b/infer/src/clang/Capture.re index 096a589e7..9b5c5bb61 100644 --- a/infer/src/clang/Capture.re +++ b/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 ] diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 81c8a37b5..2ed9964d3 100644 --- a/infer/src/java/jClasspath.ml +++ b/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 diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index 0facad7c5..ebdd52c2c 100644 --- a/infer/src/java/jFrontend.ml +++ b/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. diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 2048d0e96..680e924eb 100644 --- a/infer/src/java/jMain.ml +++ b/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 ->