diff --git a/infer/src/IR/AttributesTable.re b/infer/src/IR/AttributesTable.re index 35a7e7027..43678cc30 100644 --- a/infer/src/IR/AttributesTable.re +++ b/infer/src/IR/AttributesTable.re @@ -77,7 +77,7 @@ let store_attributes (proc_attributes: ProcAttributes.t) => { | Some proc_attributes_on_disk => let higher_rank_than_on_disk () => proc_attributes.is_defined && - DB.source_file_compare proc_attributes.loc.file proc_attributes_on_disk.loc.file > 0; + DB.compare_source_file proc_attributes.loc.file proc_attributes_on_disk.loc.file > 0; let becomes_defined = proc_attributes.is_defined && not proc_attributes_on_disk.is_defined; /* Only overwrite the attribute file if the procedure becomes defined or its associated file has higher rank (alphabetically) than on disk. */ @@ -217,7 +217,7 @@ let find_file_capturing_procedure pname => let origin = /* Procedure coming from include files if it has different location than the file where it was captured. */ - DB.source_file_compare source_file proc_attributes.ProcAttributes.loc.file != 0 ? + DB.compare_source_file 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); diff --git a/infer/src/IR/Location.re b/infer/src/IR/Location.re index c08118d48..a5da5b0ef 100644 --- a/infer/src/IR/Location.re +++ b/infer/src/IR/Location.re @@ -25,7 +25,7 @@ let compare loc1 loc2 => { if (n != 0) { n } else { - DB.source_file_compare loc1.file loc2.file + DB.compare_source_file loc1.file loc2.file } }; diff --git a/infer/src/IR/Pvar.re b/infer/src/IR/Pvar.re index 2c500b7cc..1ac54f32a 100644 --- a/infer/src/IR/Pvar.re +++ b/infer/src/IR/Pvar.re @@ -63,7 +63,7 @@ let rec pvar_kind_compare k1 k2 => | (Abduced_ref_param _, _) => (-1) | (_, Abduced_ref_param _) => 1 | (Global_var (f1, const1, pod1), Global_var (f2, const2, pod2)) => - let n = DB.source_file_compare f1 f2; + let n = DB.compare_source_file f1 f2; if (n != 0) { n } else { diff --git a/infer/src/backend/InferPrint.re b/infer/src/backend/InferPrint.re index 8c3899f5f..dc2ce776d 100644 --- a/infer/src/backend/InferPrint.re +++ b/infer/src/backend/InferPrint.re @@ -1287,7 +1287,7 @@ let module AnalysisResults = { apply_without_gc (IList.iter load_file) (spec_files_from_cmdline ()); let summ_cmp (_, summ1) (_, summ2) => { let n = - DB.source_file_compare + DB.compare_source_file summ1.Specs.attributes.ProcAttributes.loc.Location.file summ2.Specs.attributes.ProcAttributes.loc.Location.file; if (n != 0) { diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 1c8d58807..20957407c 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -1017,7 +1017,7 @@ let pp_cfgnode pdesc fmt (n: Procdesc.Node.t) = let print_icfg source fmt cfg = let print_node pdesc node = let loc = Procdesc.Node.get_loc node in - if (Config.dotty_cfg_libs || DB.source_file_equal loc.Location.file source) then + if (Config.dotty_cfg_libs || DB.equal_source_file loc.Location.file source) then F.fprintf fmt "%a\n" (pp_cfgnode pdesc) node in Cfg.iter_all_nodes print_node cfg diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 61276d30b..688603265 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -34,7 +34,7 @@ let tenv_filename file_base = module FilenameHash = Hashtbl.Make( struct type t = DB.filename - let equal file1 file2 = DB.filename_compare file1 file2 = 0 + let equal file1 file2 = DB.compare_filename file1 file2 = 0 let hash = Hashtbl.hash end) @@ -99,7 +99,7 @@ let add_cg (exe_env: t) (source_dir : DB.source_dir) = | None -> () | Some (source_captured, origin) -> - let multiply_defined = DB.source_file_compare source source_captured <> 0 in + let multiply_defined = DB.compare_source_file source source_captured <> 0 in if multiply_defined then Cg.remove_node_defined cg pname; if Config.check_duplicate_symbols && multiply_defined && diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index b4d837e31..2310c8f59 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -478,11 +478,11 @@ let write_html_proc source proof_cover table_nodes_at_linenum global_err_log pro let proc_loc = Procdesc.get_loc proc_desc in let process_proc = Procdesc.is_defined proc_desc && - DB.source_file_equal proc_loc.Location.file source && + DB.equal_source_file proc_loc.Location.file source && match AttributesTable.find_file_capturing_procedure proc_name with | None -> true | Some (source_captured, _) -> - DB.source_file_equal source_captured (Procdesc.get_loc proc_desc).file in + DB.equal_source_file source_captured (Procdesc.get_loc proc_desc).file in if process_proc then begin IList.iter process_node (Procdesc.get_nodes proc_desc); diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index 093d79b14..4aa0ad291 100644 --- a/infer/src/base/DB.ml +++ b/infer/src/base/DB.ml @@ -26,24 +26,14 @@ type source_file = | Absolute of string | RelativeProjectRoot of string (* relative to project root *) | RelativeInferModel of string (* relative to infer models *) +[@@deriving compare] -let source_file_compare sf1 sf2 = - match sf1, sf2 with - | Absolute p1, Absolute p2 -> string_compare p1 p2 - | Absolute _, _ -> -1 - | _, Absolute _ -> 1 - | RelativeProjectRoot p1, RelativeProjectRoot p2 -> string_compare p1 p2 - | RelativeProjectRoot _, _ -> -1 - | _, RelativeProjectRoot _ -> 1 - | RelativeInferModel p1, RelativeInferModel p2 -> string_compare p1 p2 - -let source_file_equal sf1 sf2 = - (source_file_compare sf1 sf2) = 0 +let equal_source_file sf1 sf2 = + compare_source_file sf1 sf2 = 0 module OrderedSourceFile = struct - type t = source_file - let compare = source_file_compare + type t = source_file [@@deriving compare] end module SourceFileMap = Map.Make(OrderedSourceFile) @@ -165,9 +155,7 @@ let source_file_of_header header_file = (** {2 Source Dirs} *) (** source directory: the directory inside the results dir corresponding to a source file *) -type source_dir = string - -let source_dir_compare = string_compare +type source_dir = string [@@deriving compare] (** expose the source dir as a string *) let source_dir_to_string source_dir = source_dir @@ -204,7 +192,7 @@ let find_source_dirs () = (** {2 Filename} *) -type filename = string +type filename = string [@@deriving compare] let filename_concat = Filename.concat @@ -212,8 +200,6 @@ let filename_to_string s = s let filename_from_string s = s -let filename_compare = Pervasives.compare - let filename_add_suffix fn s = fn ^ s let chop_extension = Filename.chop_extension @@ -224,14 +210,12 @@ let file_remove = Sys.remove module FilenameSet = Set.Make( struct - type t = filename - let compare = filename_compare + type t = filename [@@deriving compare] end) module FilenameMap = Map.Make( struct - type t = filename - let compare = filename_compare + type t = filename [@@deriving compare] end) (** Return the time when a file was last modified. The file must exist. *) @@ -342,7 +326,7 @@ module Results_dir = struct create_dir specs_dir; create_dir (path_to_filename Abs_root [Config.attributes_dir_name]); create_dir (path_to_filename Abs_root [Config.captured_dir_name]); - if not (source_file_equal source source_file_empty) then + if not (equal_source_file source source_file_empty) then create_dir (path_to_filename (Abs_source_dir source) []) let clean_specs_dir () = diff --git a/infer/src/base/DB.mli b/infer/src/base/DB.mli index 60198a501..d4f81b1d4 100644 --- a/infer/src/base/DB.mli +++ b/infer/src/base/DB.mli @@ -15,14 +15,13 @@ open! Utils (** {2 Filename} *) (** generic file name *) -type filename +type filename [@@deriving compare] module FilenameSet : Set.S with type elt = filename module FilenameMap : Map.S with type key = filename val filename_from_string : string -> filename val filename_to_string : filename -> string -val filename_compare : filename -> filename -> int val chop_extension : filename -> filename val filename_concat : filename -> string -> filename val filename_add_suffix : filename -> string -> filename @@ -39,7 +38,10 @@ val mark_file_updated : string -> unit (** Return whether filename was updated after analysis started. File doesn't have to exist *) val file_was_updated_after_start : filename -> bool -type source_file +type source_file [@@deriving compare] + +(** equality of source files *) +val equal_source_file : source_file -> source_file -> bool (** {2 Results Directory} *) @@ -86,15 +88,9 @@ module SourceFileMap : Map.S with type key = source_file (** Set of source files *) module SourceFileSet : Set.S with type elt = source_file -(** comparison of source files *) -val source_file_compare : source_file -> source_file -> int - (** compute line count of a source file *) val source_file_line_count : source_file -> int -(** equality of source files *) -val source_file_equal : source_file -> source_file -> bool - (** empty source file *) val source_file_empty : source_file @@ -130,9 +126,7 @@ val source_file_of_header : source_file -> source_file option (** {2 Source Dirs} *) (** source directory: the directory inside the results dir corresponding to a source file *) -type source_dir - -val source_dir_compare : source_dir -> source_dir -> int +type source_dir [@@deriving compare] (** expose the source dir as a string *) val source_dir_to_string : source_dir -> string diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 3b9fa8ff4..6a9fb6a2b 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -109,7 +109,7 @@ let report_siof tenv 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.source_file_equal DB.source_file_empty source_file) -> + | 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) | _ -> () in diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index a423d2b8e..38c13afa3 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -25,7 +25,7 @@ let is_in_main_file translation_unit_context an = | None -> false | Some file -> - DB.source_file_equal + DB.equal_source_file (DB.source_file_from_abs_path file) translation_unit_context.CFrontend_config.source_file diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index 1aab36e41..2d247db17 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -31,8 +31,8 @@ let should_do_frontend_check trans_unit_ctx (loc_start, _) = match loc_start.Clang_ast_t.sl_file with | Some file -> let source_file = (DB.source_file_from_abs_path file) in - DB.source_file_equal source_file trans_unit_ctx.CFrontend_config.source_file || - (source_file_in_project source_file && not Config.testing_mode) + DB.equal_source_file source_file trans_unit_ctx.CFrontend_config.source_file || + (source_file_in_project source_file && not Config.testing_mode) | None -> false (** We translate by default the instructions in the current file. In C++ development, we also @@ -52,7 +52,7 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra (* 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 + let equal_current_source = DB.equal_source_file trans_unit_ctx.CFrontend_config.source_file in let equal_header_of_current_source maybe_header = (* DB.source_file_of_header will cache calls to filesystem *)