diff --git a/.ocamlformat b/.ocamlformat index becb9919c..306c771ab 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,3 +1,3 @@ margin 100 sparse true -version v0.2 +version 0.3 diff --git a/Makefile b/Makefile index 0176ea773..e69e53f18 100644 --- a/Makefile +++ b/Makefile @@ -600,7 +600,6 @@ endif devsetup: Makefile.autoconf $(QUIET)[ $(OPAM) != "no" ] || (echo 'No `opam` found, aborting setup.' >&2; exit 1) $(QUIET)$(call silent_on_success,installing $(OPAM_DEV_DEPS),\ - OPAMSWITCH=$(OPAMSWITCH); $(OPAM) pin remove --yes ocamlformat; \ OPAMSWITCH=$(OPAMSWITCH); $(OPAM) install --yes --no-checksum user-setup $(OPAM_DEV_DEPS)) $(QUIET)echo '$(TERM_INFO)*** Running `opam config setup -a`$(TERM_RESET)' >&2 $(QUIET)OPAMSWITCH=$(OPAMSWITCH); $(OPAM) config --yes setup -a diff --git a/infer/src/IR/AccessPath.ml b/infer/src/IR/AccessPath.ml index 19e94f5cb..0e7f2063a 100644 --- a/infer/src/IR/AccessPath.ml +++ b/infer/src/IR/AccessPath.ml @@ -202,7 +202,6 @@ module Raw = struct let is_prefix ((base1, path1) as ap1) ((base2, path2) as ap2) = if phys_equal ap1 ap2 then true else equal_base base1 base2 && is_prefix_path path1 path2 - end module Abs = struct @@ -256,7 +255,6 @@ module Abs = struct Raw.pp fmt access_path | Abstracted access_path -> F.fprintf fmt "%a*" Raw.pp access_path - end include Raw diff --git a/infer/src/IR/Attributes.ml b/infer/src/IR/Attributes.ml index 04a31befc..9ea45340b 100644 --- a/infer/src/IR/Attributes.ml +++ b/infer/src/IR/Attributes.ml @@ -132,4 +132,3 @@ let find_file_capturing_procedure pname = `Source in (source_file, origin) ) - diff --git a/infer/src/IR/CallFlags.ml b/infer/src/IR/CallFlags.ml index 34852948d..c9a789907 100644 --- a/infer/src/IR/CallFlags.ml +++ b/infer/src/IR/CallFlags.ml @@ -37,4 +37,3 @@ let default = ; cf_is_objc_block= false ; cf_with_block_parameters= false ; cf_targets= [] } - diff --git a/infer/src/IR/Cfg.ml b/infer/src/IR/Cfg.ml index 2b522829e..f0f0ba3da 100644 --- a/infer/src/IR/Cfg.ml +++ b/infer/src/IR/Cfg.ml @@ -46,7 +46,7 @@ let iter_all_nodes ?(sorted= false) f cfg = (fun _ pdesc desc_nodes -> List.fold ~f:(fun desc_nodes node -> (pdesc, node) :: desc_nodes) - ~init:desc_nodes (Procdesc.get_nodes pdesc)) + ~init:desc_nodes (Procdesc.get_nodes pdesc) ) cfg [] |> List.sort ~cmp:[%compare : Procdesc.t * Procdesc.Node.t] |> List.iter ~f:(fun (d, n) -> f d n) @@ -248,7 +248,7 @@ let mark_unchanged_pdescs cfg_new cfg_old = ~equal:(fun i1 i2 -> let n, exp_map' = Sil.compare_structural_instr i1 i2 !exp_map in exp_map := exp_map' ; - Int.equal n 0) + Int.equal n 0 ) instrs1 instrs2 in Int.equal (compare_id n1 n2) 0 @@ -443,7 +443,7 @@ let specialize_types callee_pdesc resolved_pname args = (* Replace the type of the parameter by the type of the argument *) ((param_name, arg_typ) :: params, Mangled.Map.add param_name typename subts) | _ -> - ((param_name, param_typ) :: params, subts)) + ((param_name, param_typ) :: params, subts) ) ~init:([], Mangled.Map.empty) callee_attributes.formals args in let resolved_attributes = @@ -561,7 +561,7 @@ let specialize_with_block_args callee_pdesc pname_with_block_args block_args = ~f:(fun (_, var, typ) -> (* Here we create fresh names for the new formals, based on the names of the captured variables annotated with the name of the caller method *) - (Pvar.get_name_of_local_with_procname var, typ)) + (Pvar.get_name_of_local_with_procname var, typ) ) cl.captured_vars in Mangled.Map.add param_name (cl.name, formals_from_captured) subts @@ -631,4 +631,3 @@ let pp_proc_signatures fmt cfg = let exists_for_source_file source = (* simplistic implementation that allocates the cfg as this is only used for reactive capture for now *) load source |> Option.is_some - diff --git a/infer/src/IR/Cg.ml b/infer/src/IR/Cg.ml index 517e74679..24c628409 100644 --- a/infer/src/IR/Cg.ml +++ b/infer/src/IR/Cg.ml @@ -323,7 +323,7 @@ let pp_graph_dotty (g: t) fmt = List.iter ~f:(fun nc -> F.fprintf fmt "%a [shape=box,label=%a,color=%s,shape=%s]@\n" pp_node nc pp_node_label nc - "red" (get_shape nc)) + "red" (get_shape nc) ) nodes_with_calls ; List.iter ~f:(fun (s, d) -> F.fprintf fmt "%a -> %a@\n" pp_node s pp_node d) (get_edges g) ; F.fprintf fmt "}@." @@ -337,4 +337,3 @@ let save_call_graph_dotty source (g: t) = let outc = Out_channel.create (DB.filename_to_string fname_dot) in let fmt = F.formatter_of_out_channel outc in pp_graph_dotty g fmt ; Out_channel.close outc - diff --git a/infer/src/IR/Const.ml b/infer/src/IR/Const.ml index b14d9f6eb..9b8f162a6 100644 --- a/infer/src/IR/Const.ml +++ b/infer/src/IR/Const.ml @@ -70,4 +70,3 @@ let isminusone_int_float = function true | _ -> false - diff --git a/infer/src/IR/DecompiledExp.ml b/infer/src/IR/DecompiledExp.ml index 78dc68c7b..fb2c7953d 100644 --- a/infer/src/IR/DecompiledExp.ml +++ b/infer/src/IR/DecompiledExp.ml @@ -137,4 +137,3 @@ let rec has_tmp_var = function has_tmp_var dexp || List.exists ~f:has_tmp_var dexp_list | Dconst _ | Dunknown | Dsizeof (_, None, _) -> false - diff --git a/infer/src/IR/Errlog.ml b/infer/src/IR/Errlog.ml index 449d997bf..267966b3d 100644 --- a/infer/src/IR/Errlog.ml +++ b/infer/src/IR/Errlog.ml @@ -65,7 +65,7 @@ let compute_local_exception_line loc_trace = snd (List_.fold_until ~init:(`Continue (None, None)) ~f:compute_local_exception_line loc_trace) -type node_id_key = {node_id: int; node_key: Digest.t} +type node_id_key = {node_id: int; node_key: Caml.Digest.t} type err_key = { err_kind: Exceptions.err_kind @@ -113,7 +113,6 @@ module ErrLogHash = struct (key1.err_kind, key1.in_footprint, key1.err_name) (key2.err_kind, key2.in_footprint, key2.err_name) && Localise.error_desc_equal key1.err_desc key2.err_desc - end include Hashtbl.Make (Key) @@ -147,12 +146,14 @@ let fold (f: err_key -> err_data -> 'a -> 'a) t acc = (fun err_key set acc -> ErrDataSet.fold (fun err_data acc -> f err_key err_data acc) set acc) t acc + (** Return the number of elements in the error log which satisfy [filter] *) let size filter (err_log: t) = let count = ref 0 in ErrLogHash.iter (fun key err_datas -> - if filter key.err_kind key.in_footprint then count := !count + ErrDataSet.cardinal err_datas) + if filter key.err_kind key.in_footprint then count := !count + ErrDataSet.cardinal err_datas + ) err_log ; !count @@ -324,7 +325,7 @@ module Err_table = struct let count_err (err_name: IssueType.t) n = let err_string = err_name.IssueType.unique_id in let count = try String.Map.find_exn !err_name_map err_string with Not_found -> 0 in - err_name_map := String.Map.add ~key:err_string ~data:(count + n) !err_name_map + err_name_map := String.Map.set ~key:err_string ~data:(count + n) !err_name_map in let count key err_datas = if Exceptions.equal_err_kind ekind key.err_kind && key.in_footprint then @@ -378,7 +379,7 @@ module Err_table = struct List.iter ~f:(fun (err_name, desc) -> Exceptions.pp_err ~node_key:err_data.node_id_key.node_key err_data.loc ekind err_name - desc err_data.loc_in_ml_source fmt ()) + desc err_data.loc_in_ml_source fmt () ) err_names in F.fprintf fmt "@.Detailed errors during footprint phase:@." ; @@ -397,7 +398,6 @@ module Err_table = struct LocMap.iter (fun nslm err_names -> F.fprintf fmt "%a" (pp Exceptions.Kwarning nslm) err_names) !map_warn_re - end type err_table = Err_table.t diff --git a/infer/src/IR/Errlog.mli b/infer/src/IR/Errlog.mli index 47185e8cb..663ca75ef 100644 --- a/infer/src/IR/Errlog.mli +++ b/infer/src/IR/Errlog.mli @@ -36,7 +36,7 @@ val compute_local_exception_line : loc_trace -> int option This extra information adds value to the report itself, and may avoid digging into the trace to understand the cause of the report. *) -type node_id_key = private {node_id: int; node_key: Digest.t} +type node_id_key = private {node_id: int; node_key: Caml.Digest.t} type err_key = private { err_kind: Exceptions.err_kind @@ -93,7 +93,7 @@ val update : t -> t -> unit (** Update an old error log with a new one *) val log_issue : - Exceptions.err_kind -> t -> Location.t -> int * Digest.t -> int -> loc_trace + Exceptions.err_kind -> t -> Location.t -> int * Caml.Digest.t -> int -> loc_trace -> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit (** {2 Functions for manipulating per-file error tables} *) diff --git a/infer/src/IR/Exceptions.ml b/infer/src/IR/Exceptions.ml index adcaf4755..69860b6fa 100644 --- a/infer/src/IR/Exceptions.ml +++ b/infer/src/IR/Exceptions.ml @@ -686,7 +686,7 @@ let print_key = false (** pretty print an error *) let pp_err ~node_key loc ekind ex_name desc ml_loc_opt fmt () = let kind = err_kind_string (if equal_err_kind ekind Kinfo then Kwarning else ekind) in - let pp_key fmt k = if print_key then F.fprintf fmt " key: %s " (Digest.to_hex k) else () in + let pp_key fmt k = if print_key then F.fprintf fmt " key: %s " (Caml.Digest.to_hex k) else () in F.fprintf fmt "%a:%d: %s: %a %a%a%a@\n" SourceFile.pp loc.Location.file loc.Location.line kind IssueType.pp ex_name Localise.pp_error_desc desc pp_key node_key L.pp_ml_loc_opt ml_loc_opt diff --git a/infer/src/IR/Exceptions.mli b/infer/src/IR/Exceptions.mli index 06ed4c146..7100ff0b1 100644 --- a/infer/src/IR/Exceptions.mli +++ b/infer/src/IR/Exceptions.mli @@ -158,7 +158,7 @@ val print_exception_html : string -> exn -> unit (** print a description of the exception to the html output *) val pp_err : - node_key:Digest.t -> Location.t -> err_kind -> IssueType.t -> Localise.error_desc + node_key:Caml.Digest.t -> Location.t -> err_kind -> IssueType.t -> Localise.error_desc -> Logging.ml_loc option -> Format.formatter -> unit -> unit (** pretty print an error *) diff --git a/infer/src/IR/HilExp.ml b/infer/src/IR/HilExp.ml index 5eb2352ed..950c0d378 100644 --- a/infer/src/IR/HilExp.ml +++ b/infer/src/IR/HilExp.ml @@ -179,7 +179,6 @@ let rec eval_arithmetic_binop op e1 e2 = | _ -> None - and eval = function | Constant c -> Some c @@ -196,4 +195,3 @@ and eval = function | _ -> (* TODO: handle bitshifting cases, port eval_binop from RacerD.ml *) None - diff --git a/infer/src/IR/HilInstr.ml b/infer/src/IR/HilInstr.ml index 4e0c7ced1..82e5146c6 100644 --- a/infer/src/IR/HilInstr.ml +++ b/infer/src/IR/HilInstr.ml @@ -127,4 +127,3 @@ let of_sil ~include_array_indexes ~f_resolve_id (instr: Sil.instr) = | Declare_locals _ -> (* these don't seem useful for most analyses. can translate them later if we want to *) Ignore - diff --git a/infer/src/IR/Ident.ml b/infer/src/IR/Ident.ml index 7ea309380..d12663a3f 100644 --- a/infer/src/IR/Ident.ml +++ b/infer/src/IR/Ident.ml @@ -39,7 +39,6 @@ module Name = struct spec | FromString s -> s - end type name = Name.t [@@deriving compare] @@ -159,7 +158,6 @@ module NameGenerator = struct let new_stamp = max curr_stamp stamp in NameHash.replace !name_map name new_stamp with Not_found -> NameHash.add !name_map name stamp - end (** Name used for the return variable *) diff --git a/infer/src/IR/Io_infer.ml b/infer/src/IR/Io_infer.ml index f5787f912..0288bec31 100644 --- a/infer/src/IR/Io_infer.ml +++ b/infer/src/IR/Io_infer.ml @@ -203,7 +203,6 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e ~pos:(Some pos) ~path:path_to_node fmt (node_name ^ "#" ^ pos) ; F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum - end (* =============== END of module Html =============== *) @@ -341,7 +340,6 @@ module Xml = struct if on_several_lines then pp_prelude fmt ; pp_node newline "" fmt node ; if on_several_lines then pp fmt "@." - end (* =============== END of module Xml =============== *) diff --git a/infer/src/IR/LintIssues.ml b/infer/src/IR/LintIssues.ml index 75deff39b..8d91e56ad 100644 --- a/infer/src/IR/LintIssues.ml +++ b/infer/src/IR/LintIssues.ml @@ -53,10 +53,9 @@ let load_issues_to_errlog_map dir = | None, Some issues2 -> Some issues2 | None, None -> - None) + None ) !errLogMap map | None -> () in match children_opt with Some children -> Array.iter ~f:load_issues_to_map children | None -> () - diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index 8c8dd3ca8..9352988d8 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -114,9 +114,8 @@ module Tags = struct in List.filter_map ~f:(fun (tag, value) -> - if String.Set.mem line_tags tag then Some (int_of_string value) else None) + if String.Set.mem line_tags tag then Some (int_of_string value) else None ) tags - end type error_desc = @@ -607,14 +606,16 @@ let dereference_string proc_name deref_str value_str access_opt loc = let annotation_name = nullable_annotation_name proc_name in match (Tags.get !tags Tags.nullable_src, Tags.get !tags Tags.weak_captured_var_src) with | Some nullable_src, _ -> - if String.equal nullable_src value_str then "is annotated with " ^ annotation_name - ^ " and is dereferenced without a null check" - else "is indirectly marked " ^ annotation_name ^ " (source: " + if String.equal nullable_src value_str then + "is annotated with " ^ annotation_name ^ " and is dereferenced without a null check" + else + "is indirectly marked " ^ annotation_name ^ " (source: " ^ MF.monospaced_to_string nullable_src ^ ") and is dereferenced without a null check" | None, Some weak_var_str -> if String.equal weak_var_str value_str then "is a weak pointer captured in the block and is dereferenced without a null check" - else "is equal to the variable " ^ MF.monospaced_to_string weak_var_str + else + "is equal to the variable " ^ MF.monospaced_to_string weak_var_str ^ ", a weak pointer captured in the block, and is dereferenced without a null check" | None, None -> deref_str.problem_str @@ -690,8 +691,8 @@ let desc_allocation_mismatch alloc dealloc = Tags.update tags tag_line (string_of_int loc.Location.line) ; let by_call = if Typ.Procname.equal primitive_pname called_pname then "" - else " by call to " - ^ MF.monospaced_to_string (Typ.Procname.to_simplified_string called_pname) + else + " by call to " ^ MF.monospaced_to_string (Typ.Procname.to_simplified_string called_pname) in "using " ^ MF.monospaced_to_string (Typ.Procname.to_simplified_string primitive_pname) ^ by_call ^ " " ^ at_line (Tags.create ()) (* ignore the tag *) loc diff --git a/infer/src/IR/Location.ml b/infer/src/IR/Location.ml index 05d084ede..ed9c99262 100644 --- a/infer/src/IR/Location.ml +++ b/infer/src/IR/Location.ml @@ -42,4 +42,3 @@ let pp_file_pos f (loc: t) = let fname = SourceFile.to_string loc.file in let pos = to_string loc in F.fprintf f "%s:%s" fname pos - diff --git a/infer/src/IR/Objc_models.ml b/infer/src/IR/Objc_models.ml index af719630c..9abd65449 100644 --- a/infer/src/IR/Objc_models.ml +++ b/infer/src/IR/Objc_models.ml @@ -201,11 +201,9 @@ module Core_foundation_model = struct let is_core_lib_create typ funct = is_core_lib_type typ && (String.is_substring ~substring:create funct || String.is_substring ~substring:copy funct) - end let is_core_lib_type typ = Core_foundation_model.is_core_lib_type typ let is_malloc_model return_type pname = Core_foundation_model.is_core_lib_create return_type (Typ.Procname.to_string pname) - diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index e70bc3587..2e05fcc21 100644 --- a/infer/src/IR/Procdesc.ml +++ b/infer/src/IR/Procdesc.ml @@ -251,7 +251,6 @@ module Node = struct in let pp fmt = F.fprintf fmt "%s@\n%a@?" str (pp_instrs pe None ~sub_instrs:true) node in F.asprintf "%t" pp - end (* =============== END of module Node =============== *) @@ -593,4 +592,3 @@ let has_modify_in_block_attr procdesc pvar = ProcAttributes.var_attribute_equal attr ProcAttributes.Modify_in_block ) in List.exists ~f:pvar_local_matches (get_locals procdesc) - diff --git a/infer/src/IR/ProcnameDispatcher.ml b/infer/src/IR/ProcnameDispatcher.ml index 5e25710e7..e70066943 100644 --- a/infer/src/IR/ProcnameDispatcher.ml +++ b/infer/src/IR/ProcnameDispatcher.ml @@ -754,7 +754,6 @@ module Procname = struct let ( $!--> ) args_matcher f = args_matcher $* exact_args_or_retry wrong_args_internal_error $*--> f - end module TypName = struct diff --git a/infer/src/IR/Pvar.ml b/infer/src/IR/Pvar.ml index 0ef0867aa..0bd883675 100644 --- a/infer/src/IR/Pvar.ml +++ b/infer/src/IR/Pvar.ml @@ -52,6 +52,7 @@ let compare_modulo_this x y = else if String.equal "this" (Mangled.to_string x.pv_name) then 0 else compare_pvar_kind x.pv_kind y.pv_kind + let equal = [%compare.equal : t] let pp_translation_unit fmt = function diff --git a/infer/src/IR/QualifiedCppName.ml b/infer/src/IR/QualifiedCppName.ml index d8f7883ce..2399776b3 100644 --- a/infer/src/IR/QualifiedCppName.ml +++ b/infer/src/IR/QualifiedCppName.ml @@ -73,8 +73,9 @@ module Match = struct let qualifiers_list_matcher ?prefix quals_list = ( if List.is_empty quals_list then "a^" (* regexp that does not match anything *) - else List.rev_map ~f:(regexp_string_of_qualifiers ?prefix) quals_list - |> String.concat ~sep:"\\|" ) + else + List.rev_map ~f:(regexp_string_of_qualifiers ?prefix) quals_list |> String.concat ~sep:"\\|" + ) |> Str.regexp @@ -100,5 +101,4 @@ module Match = struct instantiations *) let normalized_qualifiers = strip_template_args quals in Str.string_match matcher (to_separated_string ~sep:matching_separator normalized_qualifiers) 0 - end diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml index 7fda7dbaa..2e3765ef5 100644 --- a/infer/src/IR/Sil.ml +++ b/infer/src/IR/Sil.ml @@ -619,7 +619,6 @@ end = struct | [] -> () done - end let pp_texp_simple pe = @@ -1402,7 +1401,7 @@ let sub_no_duplicated_ids sub = not (List.contains_dup ~compare:compare_ident_ex For all (id1, e1), (id2, e2) in the input list, if id1 = id2, then e1 = e2. *) let exp_subst_of_list sub = - let sub' = List.dedup ~compare:compare_ident_exp sub in + let sub' = List.dedup_and_sort ~compare:compare_ident_exp sub in assert (sub_no_duplicated_ids sub') ; sub' @@ -1410,7 +1409,7 @@ let exp_subst_of_list sub = let subst_of_list sub = `Exp (exp_subst_of_list sub) (** like exp_subst_of_list, but allow duplicate ids and only keep the first occurrence *) -let exp_subst_of_list_duplicates sub = List.dedup ~compare:compare_ident_exp_ids sub +let exp_subst_of_list_duplicates sub = List.dedup_and_sort ~compare:compare_ident_exp_ids sub (** Convert a subst to a list of pairs. *) let sub_to_list sub = sub @@ -1535,7 +1534,7 @@ let rec exp_sub_ids (f: subst_fun) exp = (fun ((e, pvar, typ) as captured) -> let e' = exp_sub_ids f e in let typ' = f_typ typ in - if phys_equal e' e && phys_equal typ typ' then captured else (e', pvar, typ')) + if phys_equal e' e && phys_equal typ typ' then captured else (e', pvar, typ') ) c.captured_vars in if phys_equal captured_vars c.captured_vars then exp else Exp.Closure {c with captured_vars} @@ -1588,7 +1587,7 @@ let apply_sub subst : subst_fun = | `Exp l -> `Exp (fun id -> - match List.Assoc.find l ~equal:Ident.equal id with Some x -> x | None -> Exp.Var id) + match List.Assoc.find l ~equal:Ident.equal id with Some x -> x | None -> Exp.Var id ) | `Typ typ_subst -> `Typ (Typ.sub_type typ_subst, Typ.sub_tname typ_subst) @@ -1634,7 +1633,7 @@ let instr_sub_ids ~sub_id_binders f instr = let actual' = exp_sub_ids f actual in let typ' = sub_typ typ in if phys_equal actual' actual && phys_equal typ typ' then actual_pair - else (actual', typ')) + else (actual', typ') ) actuals in if phys_equal ret_id' ret_id && phys_equal fun_exp' fun_exp && phys_equal actuals' actuals @@ -1651,7 +1650,7 @@ let instr_sub_ids ~sub_id_binders f instr = IList.map_changed (fun ((name, typ) as local_var) -> let typ' = sub_typ typ in - if phys_equal typ typ' then local_var else (name, typ')) + if phys_equal typ typ' then local_var else (name, typ') ) locals in if phys_equal locals locals' then instr else Declare_locals (locals', loc) @@ -1738,7 +1737,7 @@ let compare_structural_instr instr1 instr2 exp_map = else List.fold2_exn ~f:(fun (n, exp_map) id1 id2 -> - if n <> 0 then (n, exp_map) else exp_compare_structural (Var id1) (Var id2) exp_map) + if n <> 0 then (n, exp_map) else exp_compare_structural (Var id1) (Var id2) exp_map ) ~init:(0, exp_map) ids1 ids2 in match (instr1, instr2) with @@ -1768,7 +1767,7 @@ let compare_structural_instr instr1 instr2 exp_map = else List.fold2_exn ~f:(fun (n, exp_map) arg1 arg2 -> - if n <> 0 then (n, exp_map) else exp_typ_compare_structural arg1 arg2 exp_map) + if n <> 0 then (n, exp_map) else exp_typ_compare_structural arg1 arg2 exp_map ) ~init:(0, exp_map) args1 args2 in let n, exp_map = id_typ_opt_compare_structural ret_id1 ret_id2 exp_map in @@ -1794,7 +1793,7 @@ let compare_structural_instr instr1 instr2 exp_map = if n <> 0 then (n, exp_map) else let n, exp_map = exp_compare_structural (Lvar pv1) (Lvar pv2) exp_map in - if n <> 0 then (n, exp_map) else (Typ.compare t1 t2, exp_map)) + if n <> 0 then (n, exp_map) else (Typ.compare t1 t2, exp_map) ) ~init:(0, exp_map) ptl1 ptl2 | _ -> (compare_instr instr1 instr2, exp_map) diff --git a/infer/src/IR/Subtype.ml b/infer/src/IR/Subtype.ml index f18a7e440..e162a0eb5 100644 --- a/infer/src/IR/Subtype.ml +++ b/infer/src/IR/Subtype.ml @@ -298,4 +298,3 @@ let case_analysis_basic tenv (c1, st) (c2, (_, flag2)) = let case_analysis tenv (c1, st1) (c2, st2) = if Config.subtype_multirange then get_subtypes tenv (c1, st1) (c2, st2) else case_analysis_basic tenv (c1, st1) (c2, st2) - diff --git a/infer/src/IR/Tenv.ml b/infer/src/IR/Tenv.ml index 252f0b3e8..205267546 100644 --- a/infer/src/IR/Tenv.ml +++ b/infer/src/IR/Tenv.ml @@ -31,7 +31,7 @@ let pp fmt (tenv: t) = TypenameHash.iter (fun name typ -> Format.fprintf fmt "@[<6>NAME: %s@." (Typ.Name.to_string name) ; - Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.Struct.pp Pp.text name) typ) + Format.fprintf fmt "@[<6>TYPE: %a@." (Typ.Struct.pp Pp.text name) typ ) tenv @@ -128,8 +128,8 @@ let global_tenv : t option ref = ref None (** Load a type environment from a file *) let load_from_file (filename: DB.filename) : t option = if DB.equal_filename filename DB.global_tenv_fname then ( - if is_none !global_tenv then global_tenv - := Serialization.read_from_file tenv_serializer DB.global_tenv_fname ; + if is_none !global_tenv then + global_tenv := Serialization.read_from_file tenv_serializer DB.global_tenv_fname ; !global_tenv ) else Serialization.read_from_file tenv_serializer filename @@ -157,4 +157,3 @@ let language_is tenv lang = Config.equal_language lang Java | exception Found _ -> Config.equal_language lang Clang - diff --git a/infer/src/IR/Typ.ml b/infer/src/IR/Typ.ml index df9fb2e39..66f47ea8e 100644 --- a/infer/src/IR/Typ.ml +++ b/infer/src/IR/Typ.ml @@ -816,8 +816,8 @@ module Procname = struct | Simple -> (* methodname(...) or without ... if there are no parameters *) let cls_prefix = - if withclass then java_type_to_string_verbosity (split_typename j.class_name) verbosity - ^ "." + if withclass then + java_type_to_string_verbosity (split_typename j.class_name) verbosity ^ "." else "" in let params = match j.parameters with [] -> "" | _ -> "..." in @@ -1186,7 +1186,6 @@ module Procname = struct let serialize pname = let default () = Sqlite3.Data.TEXT (to_filename pname) in Base.Hashtbl.find_or_add pname_to_key pname ~default - end (** given two template arguments, try to generate mapping from generic ones to concrete ones. *) @@ -1242,7 +1241,6 @@ module Procname = struct |> extract_mapping | _ -> None - end (** Return the return type of [pname_java]. *) @@ -1352,7 +1350,6 @@ module Fieldname = struct String.is_prefix ~prefix:"val$" (to_flat_string field_name) | Clang _ -> false - end end @@ -1439,11 +1436,10 @@ module Struct = struct | Some {fields; statics} -> List.find_map ~f:(fun (f, t, a) -> - match Fieldname.equal f fn with true -> Some (t, a) | false -> None) + match Fieldname.equal f fn with true -> Some (t, a) | false -> None ) (fields @ statics) | None -> None ) | _ -> None - end diff --git a/infer/src/IR/Typ.mli b/infer/src/IR/Typ.mli index 267fe9d61..19010a8d1 100644 --- a/infer/src/IR/Typ.mli +++ b/infer/src/IR/Typ.mli @@ -640,5 +640,4 @@ module Struct : sig val get_field_type_and_annotation : lookup:lookup -> Fieldname.t -> typ -> (typ * Annot.Item.t) option (** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] *) - end diff --git a/infer/src/absint/AbstractDomain.ml b/infer/src/absint/AbstractDomain.ml index d2995bcfe..c899de0c3 100644 --- a/infer/src/absint/AbstractDomain.ml +++ b/infer/src/absint/AbstractDomain.ml @@ -137,8 +137,8 @@ module Pair (Domain1 : S) (Domain2 : S) = struct let ( <= ) ~lhs ~rhs = if phys_equal lhs rhs then true - else Domain1.( <= ) ~lhs:(fst lhs) ~rhs:(fst rhs) - && Domain2.( <= ) ~lhs:(snd lhs) ~rhs:(snd rhs) + else + Domain1.( <= ) ~lhs:(fst lhs) ~rhs:(fst rhs) && Domain2.( <= ) ~lhs:(snd lhs) ~rhs:(snd rhs) let join astate1 astate2 = @@ -192,7 +192,7 @@ module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = stru else M.for_all (fun k lhs_v -> - try ValueDomain.( <= ) ~lhs:lhs_v ~rhs:(M.find k rhs) with Not_found -> false) + try ValueDomain.( <= ) ~lhs:lhs_v ~rhs:(M.find k rhs) with Not_found -> false ) lhs @@ -207,7 +207,7 @@ module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = stru | Some v, _ | _, Some v -> Some v | None, None -> - None) + None ) astate1 astate2 @@ -222,7 +222,7 @@ module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = stru | Some v, _ | _, Some v -> Some v | None, None -> - None) + None ) prev next @@ -251,7 +251,7 @@ module InvertedMap (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S | Some v1, Some v2 -> Some (ValueDomain.join v1 v2) | _ -> - None) + None ) astate1 astate2 @@ -264,7 +264,7 @@ module InvertedMap (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S | Some v1, Some v2 -> Some (ValueDomain.widen ~prev:v1 ~next:v2 ~num_iters) | _ -> - None) + None ) prev next diff --git a/infer/src/absint/AbstractInterpreter.ml b/infer/src/absint/AbstractInterpreter.ml index 785cdcbf9..2556f9d2c 100644 --- a/infer/src/absint/AbstractInterpreter.ml +++ b/infer/src/absint/AbstractInterpreter.ml @@ -162,7 +162,6 @@ struct let cfg = CFG.from_pdesc pdesc in let inv_map = exec_cfg cfg proc_data ~initial ~debug in extract_post (CFG.id (CFG.exit_node cfg)) inv_map - end module MakeWithScheduler (C : ProcCfg.S) (S : Scheduler.Make) (T : TransferFunctions.MakeSIL) = diff --git a/infer/src/absint/Checkers.ml b/infer/src/absint/Checkers.ml index 0e3aa955f..aa9f4ddce 100644 --- a/infer/src/absint/Checkers.ml +++ b/infer/src/absint/Checkers.ml @@ -28,7 +28,6 @@ module PP = struct in F.fprintf fmt "%a:%d@\n" SourceFile.pp loc.Location.file loc.Location.line ; for n = loc.Location.line - nbefore to loc.Location.line + nafter do printline n done - end (* PP *) @@ -109,5 +108,4 @@ module ST = struct (Typ.Procname.to_string proc_name) ; L.progress "%s@." description ; Reporting.log_error_deprecated proc_name ~loc ~ltr:trace exn ) - end diff --git a/infer/src/absint/FormalMap.ml b/infer/src/absint/FormalMap.ml index 484422adc..48fee033c 100644 --- a/infer/src/absint/FormalMap.ml +++ b/infer/src/absint/FormalMap.ml @@ -20,7 +20,7 @@ let make pdesc = List.mapi ~f:(fun index (name, typ) -> let pvar = Pvar.mk name pname in - (AccessPath.base_of_pvar pvar typ, index)) + (AccessPath.base_of_pvar pvar typ, index) ) attrs.ProcAttributes.formals in List.fold diff --git a/infer/src/absint/LowerHil.ml b/infer/src/absint/LowerHil.ml index fcfec6656..0d9296713 100644 --- a/infer/src/absint/LowerHil.ml +++ b/infer/src/absint/LowerHil.ml @@ -72,7 +72,7 @@ struct let dummy_assign = HilInstr.Assign (lhs_access_path, HilExp.AccessPath access_path, loc) in - TransferFunctions.exec_instr astate_acc extras node dummy_assign) + TransferFunctions.exec_instr astate_acc extras node dummy_assign ) id_map actual_state in let actual_state'' = TransferFunctions.exec_instr actual_state' extras node hil_instr in @@ -84,7 +84,6 @@ struct if phys_equal actual_state actual_state' then astate else (actual_state', id_map) | Ignore -> astate - end module MakeAbstractInterpreterWithConfig @@ -98,7 +97,6 @@ struct Preanal.do_preanalysis pdesc tenv ; let initial' = (initial, IdAccessPathMapDomain.empty) in Option.map ~f:fst (Interpreter.compute_post ~debug:false proc_data ~initial:initial') - end module MakeAbstractInterpreter = MakeAbstractInterpreterWithConfig (DefaultConfig) diff --git a/infer/src/absint/PatternMatch.ml b/infer/src/absint/PatternMatch.ml index ff4cd584e..a8701c8c5 100644 --- a/infer/src/absint/PatternMatch.ml +++ b/infer/src/absint/PatternMatch.ml @@ -431,4 +431,3 @@ let rec find_superclasses_with_attributes check tenv tname = if check struct_typ.annots then tname :: result_from_supers else result_from_supers | _ -> [] - diff --git a/infer/src/absint/ProcCfg.ml b/infer/src/absint/ProcCfg.ml index d4863827d..9c1bddf42 100644 --- a/infer/src/absint/ProcCfg.ml +++ b/infer/src/absint/ProcCfg.ml @@ -84,7 +84,6 @@ module InstrNode = struct Procdesc.Node.pp_id fmt id | Instr_index i -> F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i - end module type S = sig @@ -287,9 +286,8 @@ struct List.mapi ~f:(fun i instr -> let id = (Procdesc.Node.get_id t, Instr_index i) in - (instr, Some id)) + (instr, Some id) ) (instrs t) - end module NodeIdMap (CFG : S) = Caml.Map.Make (struct diff --git a/infer/src/absint/Scheduler.ml b/infer/src/absint/Scheduler.ml index a5effe54f..8bc09cef2 100644 --- a/infer/src/absint/Scheduler.ml +++ b/infer/src/absint/Scheduler.ml @@ -70,7 +70,6 @@ module ReversePostorder (CFG : ProcCfg.S) = struct let visited_preds' = IdSet.add node_id t.visited_preds in let priority' = compute_priority cfg t.node visited_preds' in {t with visited_preds= visited_preds'; priority= priority'} - end type t = {worklist: WorkUnit.t M.t; cfg: CFG.t} @@ -104,7 +103,7 @@ module ReversePostorder (CFG : ProcCfg.S) = struct M.fold (fun id work (lowest_id, lowest_priority) -> let priority = WorkUnit.priority work in - if priority < lowest_priority then (id, priority) else (lowest_id, lowest_priority)) + if priority < lowest_priority then (id, priority) else (lowest_id, lowest_priority) ) t.worklist (init_id, init_priority) in let max_priority_work = M.find max_priority_id t.worklist in diff --git a/infer/src/absint/Summary.ml b/infer/src/absint/Summary.ml index e4db3ea61..76fa67890 100644 --- a/infer/src/absint/Summary.ml +++ b/infer/src/absint/Summary.ml @@ -36,5 +36,4 @@ module Make (P : Payload) : S with type payload = P.payload = struct None | Some summary -> P.read_payload summary - end diff --git a/infer/src/backend/Attribute.ml b/infer/src/backend/Attribute.ml index ee6007431..74898580e 100644 --- a/infer/src/backend/Attribute.ml +++ b/infer/src/backend/Attribute.ml @@ -38,8 +38,7 @@ let add_or_replace_check_changed tenv check_attribute_change prop atom = let _, nexp = List.hd_exn pairs in (* len exps0 > 0 by match *) let atom_map = function - | Sil.Apred (att, exp :: _) - | Anpred (att, exp :: _) + | (Sil.Apred (att, exp :: _) | Anpred (att, exp :: _)) when Exp.equal nexp exp && attributes_in_same_category att att0 -> check_attribute_change att att0 ; atom | atom' -> @@ -268,8 +267,8 @@ let find_arithmetic_problem tenv proc_node_session prop exp = | Exp.UnOp (_, e, _) -> walk e | Exp.BinOp (op, e1, e2) -> - if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then exps_divided - := e2 :: !exps_divided ; + if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then + exps_divided := e2 :: !exps_divided ; walk e1 ; walk e2 | Exp.Exn _ -> @@ -394,10 +393,10 @@ let find_equal_formal_path tenv e prop = | None -> None ) | _ -> - None) + None ) fields ~init:None | _ -> - None) + None ) prop.Prop.sigma ~init:None in match find_in_sigma e [] with @@ -409,4 +408,3 @@ let find_equal_formal_path tenv e prop = Some vfs | _ -> None - diff --git a/infer/src/backend/BuiltinDefn.ml b/infer/src/backend/BuiltinDefn.ml index 1aa26cf5e..bd850151b 100644 --- a/infer/src/backend/BuiltinDefn.ml +++ b/infer/src/backend/BuiltinDefn.ml @@ -397,6 +397,7 @@ let execute___set_mem_attribute {Builtin.tenv; pdesc; prop_; path; ret_id; args; | _ -> raise (Exceptions.Wrong_argument_number __POS__) + let set_attr tenv pdesc prop path exp attr = let pname = Procdesc.get_proc_name pdesc in let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in @@ -521,7 +522,7 @@ let execute_free mk ?(mark_as_freed= true) {Builtin.pdesc; instr; tenv; prop_; p ~f:(fun p -> execute_free_nonzero_ mk ~mark_as_freed pdesc tenv instr p (Prop.exp_normalize_prop tenv p lexp) - typ loc) + typ loc ) prop_nonzero in List.map ~f:(fun p -> (p, path)) plist diff --git a/infer/src/backend/Differential.ml b/infer/src/backend/Differential.ml index bfed3190b..b3050e77c 100644 --- a/infer/src/backend/Differential.ml +++ b/infer/src/backend/Differential.ml @@ -134,4 +134,3 @@ let to_files {introduced; fixed; preexisting} destdir = Out_channel.write_all (destdir ^/ "fixed.json") ~data:(Jsonbug_j.string_of_report fixed) ; Out_channel.write_all (destdir ^/ "preexisting.json") ~data:(Jsonbug_j.string_of_report preexisting) - diff --git a/infer/src/backend/DifferentialFilters.ml b/infer/src/backend/DifferentialFilters.ml index 15c786cf2..d95345aef 100644 --- a/infer/src/backend/DifferentialFilters.ml +++ b/infer/src/backend/DifferentialFilters.ml @@ -123,7 +123,7 @@ let skip_duplicated_types_on_filenames renamings (diff: Differential.t) : Differ String.compare f1 f2 in let cmp ((issue1, _) as issue_with_previous_file1) ((issue2, _) as issue_with_previous_file2) = - [%compare : Digest.t * string * issue_file_with_renaming] + [%compare : Caml.Digest.t * string * issue_file_with_renaming] (issue1.Jsonbug_t.key, issue1.Jsonbug_t.bug_type, issue_with_previous_file1) (issue2.Jsonbug_t.key, issue2.Jsonbug_t.bug_type, issue_with_previous_file2) in @@ -180,7 +180,7 @@ let value_of_qualifier_tag qts tag = type file_extension = string [@@deriving compare] -type weak_hash = string * string * string * Digest.t * string option [@@deriving compare] +type weak_hash = string * string * string * Caml.Digest.t * string option [@@deriving compare] let skip_anonymous_class_renamings (diff: Differential.t) : Differential.t = (* diff --git a/infer/src/backend/InferAnalyze.ml b/infer/src/backend/InferAnalyze.ml index e7921dec8..8225225df 100644 --- a/infer/src/backend/InferAnalyze.ml +++ b/infer/src/backend/InferAnalyze.ml @@ -22,7 +22,7 @@ let analyze_exe_env_tasks cluster exe_env : Tasks.t = [ (fun () -> let call_graph = Exe_env.get_cg exe_env in Callbacks.iterate_callbacks call_graph exe_env ; - if Config.write_html then Printer.write_all_html_files cluster) ] + if Config.write_html then Printer.write_all_html_files cluster ) ] (** Create tasks to analyze a cluster *) @@ -85,7 +85,7 @@ let cluster_should_be_analyzed ~changed_files cluster = SourceFile.Set.fold (fun source_file source_dir_set -> let source_dir = DB.source_dir_from_source_file source_file in - String.Set.add source_dir_set (DB.source_dir_to_string source_dir)) + String.Set.add source_dir_set (DB.source_dir_to_string source_dir) ) changed_files String.Set.empty in Option.map ~f:source_dirs_to_analyze changed_files @@ -134,8 +134,8 @@ let main ~changed_files ~makefile = in let n_clusters_to_analyze = List.length clusters_to_analyze in L.progress "Found %d%s source file%s to analyze in %s@." n_clusters_to_analyze - ( if Config.reactive_mode || Option.is_some changed_files then " (out of " - ^ string_of_int (List.length all_clusters) ^ ")" + ( if Config.reactive_mode || Option.is_some changed_files then + " (out of " ^ string_of_int (List.length all_clusters) ^ ")" else "" ) (if Int.equal n_clusters_to_analyze 1 then "" else "s") Config.results_dir ; diff --git a/infer/src/backend/InferPrint.ml b/infer/src/backend/InferPrint.ml index d63eaafb0..15a2f4b4a 100644 --- a/infer/src/backend/InferPrint.ml +++ b/infer/src/backend/InferPrint.ml @@ -56,7 +56,7 @@ let compute_hash (kind: string) (type_str: string) (proc_name: Typ.Procname.t) ( in Utils.better_hash (kind, type_str, hashable_procedure_name, base_filename, location_independent_qualifier) - |> Digest.to_hex + |> Caml.Digest.to_hex let exception_value = "exception" @@ -143,7 +143,7 @@ let summary_values summary = ; verr= Errlog.size (fun ekind in_footprint -> - Exceptions.equal_err_kind ekind Exceptions.Kerror && in_footprint) + Exceptions.equal_err_kind ekind Exceptions.Kerror && in_footprint ) err_log ; vflags= attributes.ProcAttributes.proc_flags ; vfile= SourceFile.to_string attributes.ProcAttributes.loc.Location.file @@ -177,7 +177,6 @@ module ProcsCsv = struct pp "%d," sv.vline ; pp "\"%s\"," (Escape.escape_csv sv.vsignature) ; pp "%s@\n" sv.vproof_trace - end let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass = @@ -290,7 +289,7 @@ module IssuesJson = struct ; procedure_start_line ; file ; bug_trace= loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind - ; key= err_data.node_id_key.node_key |> Digest.to_hex + ; key= err_data.node_id_key.node_key |> Caml.Digest.to_hex ; qualifier_tags= Localise.Tags.tag_value_records_of_tags key.err_desc.tags ; hash= compute_hash kind bug_type procname file qualifier ; dotty= error_desc_to_dotty_string key.err_desc @@ -309,7 +308,6 @@ module IssuesJson = struct (** Write bug report in JSON format *) let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log = Errlog.iter (pp_issue fmt error_filter procname proc_loc_opt) err_log - end let pp_custom_of_report fmt report fields = @@ -352,9 +350,9 @@ let pp_custom_of_report fmt report fields = | `Issue_field_bug_trace -> pp_trace fmt issue.bug_trace (comma_separator index) | `Issue_field_key -> - Format.fprintf fmt "%s%s" (comma_separator index) (Digest.to_hex issue.key) + Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.key) | `Issue_field_hash -> - Format.fprintf fmt "%s%s" (comma_separator index) (Digest.to_hex issue.hash) + Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.hash) | `Issue_field_line_offset -> Format.fprintf fmt "%s%d" (comma_separator index) (issue.line - issue.procedure_start_line) @@ -371,7 +369,7 @@ let pp_custom_of_report fmt report fields = let tests_jsonbug_compare bug1 bug2 = let open Jsonbug_t in - [%compare : string * string * int * string * Digest.t] + [%compare : string * string * int * string * Caml.Digest.t] (bug1.file, bug1.procedure, bug1.line - bug1.procedure_start_line, bug1.bug_type, bug1.hash) (bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash) @@ -395,7 +393,6 @@ module IssuesTxt = struct (** Write bug report in text format *) let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log = Errlog.iter (pp_issue fmt error_filter proc_loc_opt) err_log - end let pp_text_of_report fmt report = @@ -423,7 +420,6 @@ module CallsCsv = struct pp "%a@\n" Specs.CallStats.pp_trace trace in Specs.CallStats.iter do_call stats.Specs.call_stats - end module Stats = struct @@ -559,7 +555,6 @@ module Stats = struct F.fprintf fmt "@\n -------------------@\n" ; F.fprintf fmt "@\nDetailed Errors@\n@\n" ; List.iter ~f:(fun s -> F.fprintf fmt "%s@\n" s) (List.rev stats.saved_errors) - end module Report = struct @@ -605,7 +600,6 @@ module PreconditionStats = struct L.result "Procedures with empty precondition: %d@." !nr_empty ; L.result "Procedures with only allocation conditions: %d@." !nr_onlyallocation ; L.result "Procedures with data constraints: %d@." !nr_dataconstraints - end (* Wrapper of an issue that compares all parts except the procname *) @@ -631,13 +625,12 @@ module Issue = struct identical warning on the same line. Accomplish this by sorting without regard to procname, then de-duplicating. *) let sort_filter_issues issues = - let issues' = List.dedup ~compare issues in + let issues' = List.dedup_and_sort ~compare issues in ( if Config.developer_mode then let num_pruned_issues = List.length issues - List.length issues' in if num_pruned_issues > 0 then L.user_warning "Note: pruned %d duplicate issues@\n" num_pruned_issues ) ; issues' - end let error_filter filters proc_name file error_desc error_name = @@ -842,7 +835,7 @@ module AnalysisResults = struct List.iter ~f:(fun arg -> if not (Filename.check_suffix arg Config.specs_files_suffix) && arg <> "." then - print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files")) + print_usage_exit ("file " ^ arg ^ ": arguments must be .specs files") ) Config.anon_args ; if Config.test_filtering then ( Inferconfig.test () ; L.exit 0 ) ; if List.is_empty Config.anon_args then load_specfiles () else List.rev Config.anon_args ) @@ -918,7 +911,6 @@ module AnalysisResults = struct iterator_of_summary_list r | None -> L.(die UserError) "Error: cannot open analysis results file %s@." fname - end let register_perf_stats_report () = @@ -1004,7 +996,7 @@ let pp_summary_and_issues formats_by_report_kind issue_formats = let error_filter = error_filter filters proc_name in List.iter ~f:(fun issue_format -> pp_issue_in_format issue_format error_filter issue) - issue_formats) + issue_formats ) (Issue.sort_filter_issues !all_issues) ; if Config.precondition_stats then PreconditionStats.pp_stats () ; LintIssues.load_issues_to_errlog_map Config.lint_issues_dir_name ; diff --git a/infer/src/backend/OndemandCapture.ml b/infer/src/backend/OndemandCapture.ml index 516d083c9..c14ea4ab2 100644 --- a/infer/src/backend/OndemandCapture.ml +++ b/infer/src/backend/OndemandCapture.ml @@ -59,4 +59,3 @@ let try_capture (attributes: ProcAttributes.t) : ProcAttributes.t option = Caveat: it's possible that procedure will be captured in some other unrelated file later - infer may ignore it then. *) Attributes.load_defined attributes.proc_name - diff --git a/infer/src/backend/PerfStats.ml b/infer/src/backend/PerfStats.ml index 9e305ab2b..6c2cf850d 100644 --- a/infer/src/backend/PerfStats.ml +++ b/infer/src/backend/PerfStats.ml @@ -153,4 +153,3 @@ let register_report_at_exit = String.Table.set registered_files ~key:file ~data:() ; if not Config.buck_cache_mode then Epilogues.register ~f:(report_at_exit file) ("stats reporting in " ^ file) ) - diff --git a/infer/src/backend/PropUtil.ml b/infer/src/backend/PropUtil.ml index af9fe6d19..d73c9f293 100644 --- a/infer/src/backend/PropUtil.ml +++ b/infer/src/backend/PropUtil.ml @@ -121,7 +121,7 @@ let remove_abduced_retvars tenv p = if Pvar.is_abduced pvar then (pvar :: abduceds, normal_pvars) else (abduceds, pvar :: normal_pvars) | _ -> - pvars) + pvars ) ~init:([], []) p.Prop.sigma in let _, p' = Attribute.deallocate_stack_vars tenv p abduceds in @@ -189,4 +189,3 @@ let remove_seed_vars tenv (prop: 'a Prop.t) : Prop.normal Prop.t = let sigma = prop.sigma in let sigma' = List.filter ~f:hpred_not_seed sigma in Prop.normalize tenv (Prop.set prop ~sigma:sigma') - diff --git a/infer/src/backend/RetainCycles.ml b/infer/src/backend/RetainCycles.ml index 0be79ccfa..f8d9f1b2d 100644 --- a/infer/src/backend/RetainCycles.ml +++ b/infer/src/backend/RetainCycles.ml @@ -182,4 +182,3 @@ let report_cycle tenv hpred original_prop = Some (exn_retain_cycle tenv prop hpred cycle) | _ -> None - diff --git a/infer/src/backend/StatsAggregator.ml b/infer/src/backend/StatsAggregator.ml index 0acb61627..70fe1c605 100644 --- a/infer/src/backend/StatsAggregator.ml +++ b/infer/src/backend/StatsAggregator.ml @@ -84,7 +84,7 @@ let collect_all_stats_files () = let targets_files = List.map ~f:(fun (t, p) -> - (t, find_stats_files_in_dir (concatenate_paths buck_out_parent p))) + (t, find_stats_files_in_dir (concatenate_paths buck_out_parent p)) ) r in Ok (Buck_out targets_files) @@ -179,4 +179,3 @@ let generate_files () = write_to_json_file_opt (Filename.concat aggregated_reporting_stats_dir aggregated_stats_filename) j.reporting_json_data - diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index 76cb27933..b43c1bebc 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -67,5 +67,4 @@ module Runner = struct let complete runner = ProcessPool.wait_all runner.pool ; Queue.iter ~f:(fun f -> f ()) runner.all_continuations - end diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index b890c8b25..bd48ffc7e 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -889,7 +889,7 @@ let abstract_pure_part tenv p ~(from_abstract_footprint: bool) = | Sil.Aneq (Var _, _) | Sil.Apred (_, (Var _) :: _) | Anpred (_, (Var _) :: _) -> a :: pi | Sil.Aeq _ | Aneq _ | Apred _ | Anpred _ -> - pi) + pi ) ~init:[] pi_filtered in List.rev new_pure @@ -926,7 +926,7 @@ let abstract_gc tenv p = let no_fav_e1 = Sil.fav_is_empty fav_e1 in let no_fav_e2 = Sil.fav_is_empty fav_e2 in (no_fav_e1 || intersect_e1 ()) && (no_fav_e2 || intersect_e2 ()) - | Sil.Apred _ | Anpred _ as a -> + | (Sil.Apred _ | Anpred _) as a -> let fav_a = Sil.atom_fav a in Sil.fav_is_empty fav_a || IList.intersect Ident.compare (Sil.fav_to_list fav_a) (Sil.fav_to_list fav_p_without_pi) @@ -1111,8 +1111,7 @@ let check_junk ?original_prop pname tenv prop = in let ml_bucket_opt = match resource with - | PredSymb.Rmemory PredSymb.Mnew - | PredSymb.Rmemory PredSymb.Mnew_array + | (PredSymb.Rmemory PredSymb.Mnew | PredSymb.Rmemory PredSymb.Mnew_array) when Config.curr_language_is Config.Clang -> Mleak_buckets.should_raise_cpp_leak | _ -> @@ -1137,9 +1136,7 @@ let check_junk ?original_prop pname tenv prop = (false, exn) | None -> (true, exn_leak) ) - | Some _, Rmemory Mobjc - | Some _, Rmemory Mnew - | Some _, Rmemory Mnew_array + | (Some _, Rmemory Mobjc | Some _, Rmemory Mnew | Some _, Rmemory Mnew_array) when Config.curr_language_is Config.Clang -> (is_none ml_bucket_opt, exn_leak) | Some _, Rmemory _ -> @@ -1327,5 +1324,4 @@ let lifted_abstract pname tenv pset = let abstracted_pset = Propset.map_option tenv f pset in abstracted_pset - (***************** End of Main Abstraction Functions *****************) diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 65dd42fd8..53a38c1f8 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -109,7 +109,7 @@ end = struct let fsel' = List.map ~f:(fun (f'', se'') -> - if Typ.Fieldname.equal f'' fld then (fld, se_mod) else (f'', se'')) + if Typ.Fieldname.equal f'' fld then (fld, se_mod) else (f'', se'') ) fsel in Sil.Estruct (fsel', inst) @@ -286,7 +286,6 @@ end = struct in let hpred' = hpred_replace_strexp tenv footprint_part hpred syn_offs update in replace_hpred (sigma, hpred, syn_offs) hpred' - end (** This function renames expressions in [p]. The renaming is, roughly @@ -305,8 +304,8 @@ let prop_replace_path_index tenv (p: Prop.exposed Prop.t) (path: StrexpMatch.pat let new_e_path_index = Prop.exp_normalize_prop tenv p (Exp.Lindex (e_path, new_index)) in - (old_e_path_index, new_e_path_index) :: acc_inner) - ~init:acc_outer map) + (old_e_path_index, new_e_path_index) :: acc_inner ) + ~init:acc_outer map ) ~init:[] elist_path in let expmap_fun e' = @@ -605,7 +604,7 @@ let check_after_array_abstraction tenv prop = List.iter ~f:(fun (f, se) -> let typ_f = Typ.Struct.fld_typ ~lookup ~default:(Typ.mk Tvoid) f typ in - check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se) + check_se root (offs @ [Sil.Off_fld (f, typ)]) typ_f se ) fsel in let check_hpred = function @@ -690,4 +689,3 @@ let remove_redundant_elements tenv prop = let prop' = Prop.set prop ~sigma:sigma' ~sigma_fp:sigma_fp' in Prop.normalize tenv prop' else prop - diff --git a/infer/src/backend/builtin.ml b/infer/src/backend/builtin.ml index f55bd9b44..2f47b3521 100644 --- a/infer/src/backend/builtin.ml +++ b/infer/src/backend/builtin.ml @@ -70,4 +70,3 @@ let pp_registered fmt () = let print_and_exit () = pp_registered Format.std_formatter () ; L.exit 0 - diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 8e9eb0457..ea0a4da0e 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -65,7 +65,7 @@ let iterate_procedure_callbacks get_proc_desc exe_env summary proc_desc = ~f:(fun summary (language, resolved, proc_callback) -> if Config.equal_language language procedure_language && (resolved || not is_specialized) then proc_callback {get_proc_desc; get_procs_in_file; tenv; summary; proc_desc} - else summary) + else summary ) !procedure_callbacks @@ -82,7 +82,7 @@ let iterate_cluster_callbacks all_procs exe_env get_proc_desc = in List.iter ~f:(fun (language_opt, cluster_callback) -> - if language_matches language_opt then cluster_callback environment) + if language_matches language_opt then cluster_callback environment ) !cluster_callbacks diff --git a/infer/src/backend/cluster.ml b/infer/src/backend/cluster.ml index 9a063ade8..4c80e0a11 100644 --- a/infer/src/backend/cluster.ml +++ b/infer/src/backend/cluster.ml @@ -49,4 +49,3 @@ let pp_cluster fmt (nr, cluster) = (* touch the target of the rule to let `make` know that the job has been done *) F.fprintf fmt "\t%@touch $%@@\n" ; F.fprintf fmt "@\n" - diff --git a/infer/src/backend/clusterMakefile.ml b/infer/src/backend/clusterMakefile.ml index e4d92512d..79e753983 100644 --- a/infer/src/backend/clusterMakefile.ml +++ b/infer/src/backend/clusterMakefile.ml @@ -49,4 +49,3 @@ let create_cluster_makefile (clusters: Cluster.t list) (fname: string) = List.iteri ~f:do_cluster clusters ; pp_epilog fmt () ; Out_channel.close outc - diff --git a/infer/src/backend/crashcontext.ml b/infer/src/backend/crashcontext.ml index 569b3ae82..64f1535d1 100644 --- a/infer/src/backend/crashcontext.ml +++ b/infer/src/backend/crashcontext.ml @@ -53,7 +53,7 @@ let stitch_summaries stacktrace_file summary_files out_file = let summary_map = List.fold ~f:(fun acc stacktree -> - String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc) + String.Map.set ~key:(frame_id_of_summary stacktree) ~data:stacktree acc ) ~init:String.Map.empty summaries in let expand_stack_frame frame = @@ -76,7 +76,7 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir = if Sys.is_directory path <> `Yes && Filename.check_suffix path "json" && String.is_suffix ~suffix:"crashcontext" (Filename.dirname path) then path :: summaries - else summaries) + else summaries ) [] root_summaries_dir in let pair_for_stacktrace_file = diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 584d62f03..176cb9341 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -181,7 +181,6 @@ end = struct let set = lookup_const' const_tbl r in List.for_all ~f:(fun v' -> Exp.equal (find' tbl v') r) vars' && List.for_all ~f:(fun c -> Exp.Set.mem c set) nonvars - end (** {2 Modules for checking whether join or meet loses too much info} *) @@ -234,7 +233,6 @@ end = struct not (Exp.Set.mem e lexps) | _ -> false - end module CheckJoinPre : InfoLossCheckerSig = struct @@ -356,7 +354,6 @@ end = struct CheckJoinPre.add side e1 e2 | JoinState.Post -> CheckJoinPost.add side e1 e2 - end module CheckMeet : InfoLossCheckerSig = struct @@ -452,7 +449,6 @@ end = struct let res = !tbl in tbl := [] ; res - end (** {2 Module for introducing fresh variables} *) @@ -553,7 +549,6 @@ end = struct acc in List.fold ~f:f_ineqs ~init:eqs t_minimal - end (** {2 Modules for renaming} *) @@ -868,7 +863,6 @@ end = struct in let entry = (e1, e2, e) in push entry ; Todo.push entry ; e - end (** {2 Functions for constructing fresh sil data types} *) @@ -1643,7 +1637,7 @@ let sigma_partial_join tenv mode (sigma1: Prop.sigma) (sigma2: Prop.sigma) SymOp.try_finally ~f:(fun () -> if Rename.check lost_little then (s1, s2, s3) - else ( L.d_strln "failed Rename.check" ; raise Sil.JoinFail )) + else ( L.d_strln "failed Rename.check" ; raise Sil.JoinFail ) ) ~finally:CheckJoin.final @@ -1897,8 +1891,9 @@ let prop_partial_meet tenv p1 p2 = FreshVarExp.init () ; Todo.init () ; try - SymOp.try_finally ~f:(fun () -> Some (eprop_partial_meet tenv p1 p2)) ~finally:(fun () -> - Rename.final () ; FreshVarExp.final () ; Todo.final () ) + SymOp.try_finally + ~f:(fun () -> Some (eprop_partial_meet tenv p1 p2)) + ~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ()) with Sil.JoinFail -> None @@ -2011,7 +2006,8 @@ let prop_partial_join pname tenv mode p1 p2 = Todo.reset rename_footprint ; let res = eprop_partial_join' tenv mode (Prop.expose p1') (Prop.expose p2') in if !Config.footprint then JoinState.set_footprint false ; - Some res) ~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final () ) + Some res ) + ~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ()) with Sil.JoinFail -> None ) | Some _ -> res_by_implication_only @@ -2022,8 +2018,9 @@ let eprop_partial_join tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed P Rename.init () ; FreshVarExp.init () ; Todo.init () ; - SymOp.try_finally ~f:(fun () -> eprop_partial_join' tenv mode ep1 ep2) ~finally:(fun () -> - Rename.final () ; FreshVarExp.final () ; Todo.final () ) + SymOp.try_finally + ~f:(fun () -> eprop_partial_join' tenv mode ep1 ep2) + ~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ()) (** {2 Join and Meet for Propset} *) @@ -2232,4 +2229,3 @@ let propset_meet_generate_pre tenv pset = let plist_old = Propset.to_proplist pset in let plist_new = Propset.to_proplist pset_new in plist_new @ plist_old - diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 8fed5fd0f..07b5e74b4 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -111,10 +111,11 @@ let print_stack_info = ref false (* replace a dollar sign in a name with a D. We need this because dotty get confused if there is*) (* a dollar sign i a label*) let strip_special_chars b = + let b = Bytes.of_string b in let replace st c c' = - if String.contains st c then - let idx = String.index_exn st c in - try st.[idx] <- c' ; st with Invalid_argument _ -> + if Bytes.contains st c then + let idx = String.index_exn (Bytes.to_string st) c in + try Bytes.set st idx c' ; st with Invalid_argument _ -> L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ; assert false else st @@ -127,7 +128,7 @@ let strip_special_chars b = let s5 = replace s4 ')' 'B' in let s6 = replace s5 '+' 'P' in let s7 = replace s6 '-' 'M' in - s7 + Bytes.to_string s7 let rec strexp_to_string pe coo f se = @@ -302,7 +303,7 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list | Dotdllseg (_, e', _, _, _, _, _, _) -> Exp.equal e e' | _ -> - false) + false ) allocated_nodes | _ -> false @@ -592,7 +593,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = mk_link k (mk_coordinate (n + 1) lambda) (strip_special_chars lab_src) (mk_coordinate m lambda) - (strip_special_chars lab_trg)) + (strip_special_chars lab_trg) ) target_list in let links_from_elements = List.concat_map ~f:ff (n :: nl) in @@ -619,7 +620,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = let ff n = List.map ~f:(fun (k, lab_src, m, lab_trg) -> - mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg) + mk_link k (mk_coordinate n lambda) lab_src (mk_coordinate m lambda) lab_trg ) target_list in let nodes_e = select_nodes_exp_lambda dotnodes e lambda in @@ -654,7 +655,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = List.map ~f:(fun (k, m, lab_target) -> mk_link k (mk_coordinate n lambda) "" (mk_coordinate m lambda) - (strip_special_chars lab_target)) + (strip_special_chars lab_target) ) target_list in let ll = List.concat_map ~f:ff nl in @@ -779,7 +780,7 @@ let filter_useless_spec_dollar_box (nodes: dotty_node list) (links: link list) = let remove_node n ns = List.filter ~f:(fun n' -> - match n' with Dotpointsto _ -> get_coordinate_id n' <> get_coordinate_id n | _ -> true) + match n' with Dotpointsto _ -> get_coordinate_id n' <> get_coordinate_id n | _ -> true ) ns in let rec boxes_pointed_by n lns = @@ -1065,7 +1066,7 @@ let pp_dotty_one_spec f pre posts = for j = 1 to 4 do F.fprintf f " inv_%i%i%i%i -> state_pi_%i [style=invis]@\n" !spec_counter j j j !target_invisible_arrow_pre - done) + done ) posts ; F.fprintf f "@\n } @\n" @@ -1082,7 +1083,7 @@ let pp_dotty_prop_list_in_path f plist prev_n curr_n = List.iter ~f:(fun po -> incr proposition_counter ; - pp_dotty f Generic_proposition po None) + pp_dotty f Generic_proposition po None ) plist ; if prev_n <> -1 then F.fprintf f "@\n state%iN ->state%iN@\n" prev_n curr_n ; F.fprintf f "@\n } @\n" @@ -1164,7 +1165,7 @@ let pp_etlist byvals fmt etl = let byval_mark = if is_ptr && List.mem byvals index ~equal:Int.equal then "(byval)" else "" in - Format.fprintf fmt " %a:%a%s" Mangled.pp id (Typ.pp_full Pp.text) ty byval_mark) + Format.fprintf fmt " %a:%a%s" Mangled.pp id (Typ.pp_full Pp.text) ty byval_mark ) etl @@ -1445,7 +1446,7 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = | VH_pointsto (_, e', _, _) | VH_lseg (_, e', _, _) | VH_dllseg (_, e', _, _, _, _) -> Exp.equal e e' | _ -> - false) + false ) allocated_nodes in not allocated @@ -1712,7 +1713,7 @@ let print_specs_xml signature specs loc fmt = :: List.map ~f:(fun (po, _) -> jj := !jj + 1 ; - prop_to_xml (add_stack_to_prop po) "postcondition" !jj) + prop_to_xml (add_stack_to_prop po) "postcondition" !jj ) posts in Io_infer.Xml.create_tree "specification" [("id", string_of_int n)] xml_spec @@ -1722,7 +1723,7 @@ let print_specs_xml signature specs loc fmt = List.map ~f:(fun s -> j := !j + 1 ; - do_one_spec (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts !j) + do_one_spec (Specs.Jprop.to_prop s.Specs.pre) s.Specs.posts !j ) specs in let xml_specifications = Io_infer.Xml.create_tree "specifications" [] list_of_specs_xml in @@ -1733,4 +1734,3 @@ let print_specs_xml signature specs loc fmt = [xml_signature; xml_specifications] in Io_infer.Xml.pp_document true fmt proc_summary - diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index e1258f0be..b80f2a92d 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -1331,4 +1331,3 @@ let explain_null_test_after_dereference tenv exp node line loc = let warning_err loc fmt_string = L.(debug Analysis Medium) ("%a: Warning: " ^^ fmt_string) Location.pp loc - diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index a1416b209..5bf33e94a 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -218,4 +218,3 @@ let iter_files f exe_env = SourceFile.Set.add fname seen_files_acc ) in ignore (Typ.Procname.Hash.fold do_file exe_env.proc_map SourceFile.Set.empty) - diff --git a/infer/src/backend/infer.ml b/infer/src/backend/infer.ml index 3e97a333c..02fda1485 100644 --- a/infer/src/backend/infer.ml +++ b/infer/src/backend/infer.ml @@ -38,7 +38,8 @@ let setup () = if not ( Driver.(equal_mode driver_mode Analyze) || - Config.(buck || continue_capture || infer_is_clang || infer_is_javac || reactive_mode) ) + Config.(buck || continue_capture || infer_is_clang || infer_is_javac || reactive_mode) + ) then ResultsDir.remove_results_dir () ; ResultsDir.create_results_dir () | Explore -> diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index 645ab0a63..b1079bd93 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -41,7 +41,7 @@ let is_matching patterns source_file = let path = SourceFile.to_rel_path source_file in List.exists ~f:(fun pattern -> - try Int.equal (Str.search_forward pattern path 0) 0 with Not_found -> false) + try Int.equal (Str.search_forward pattern path 0) 0 with Not_found -> false ) patterns @@ -83,7 +83,6 @@ module FileContainsStringMatcher = struct source_map := SourceFile.Map.add source_file pattern_found !source_map ; pattern_found with Sys_error _ -> false - end type method_pattern = @@ -106,7 +105,7 @@ module FileOrProcMatcher = struct List.fold ~f:(fun map pattern -> let previous = try String.Map.find_exn map pattern.class_name with Not_found -> [] in - String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map) + String.Map.set ~key:pattern.class_name ~data:(pattern :: previous) map ) ~init:String.Map.empty m_patterns in let do_java pname_java = @@ -116,7 +115,7 @@ module FileOrProcMatcher = struct let class_patterns = String.Map.find_exn pattern_map class_name in List.exists ~f:(fun p -> - match p.method_name with None -> true | Some m -> String.equal m method_name) + match p.method_name with None -> true | Some m -> String.equal m method_name ) class_patterns with Not_found -> false in @@ -171,7 +170,6 @@ module FileOrProcMatcher = struct Format.fprintf fmt "Source contains (%s) {@\n%a}@\n" (Config.string_of_language language) pp_source_contains sc - end (* of module FileOrProcMatcher *) @@ -186,7 +184,6 @@ module OverridesMatcher = struct L.(die UserError) "Expecting method pattern" in List.exists ~f:is_matching patterns - end let patterns_of_json_with_key (json_key, json) = @@ -369,6 +366,5 @@ let test () = let matching = matching_analyzers source_file in if matching <> [] then let matching_s = String.concat ~sep:", " (List.map ~f:fst matching) in - L.result "%s -> {%s}@." (SourceFile.to_rel_path source_file) matching_s) + L.result "%s -> {%s}@." (SourceFile.to_rel_path source_file) matching_s ) (Sys.getcwd ()) - diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index c271cac3c..eef3cb97a 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -62,7 +62,6 @@ module NodeVisitSet = Caml.Set.Make (struct | _ -> compare_number_of_visits x1 x2 else compare_ids x1.node x2.node - end) (** Table for the results of the join operation on nodes. *) @@ -122,7 +121,6 @@ module Worklist = struct with Not_found -> L.internal_error "@\n...Work list is empty! Impossible to remove edge...@\n" ; assert false - end (* =============== END of module Worklist =============== *) @@ -325,8 +323,8 @@ let do_symexec_join proc_cfg tenv wl curr_node (edgeset_todo: Paths.PathSet.t) = State.set_path path None ; propagate wl pname ~is_exception:false (Paths.PathSet.from_renamed_list [(prop, path)]) - node) - new_dset') + node ) + new_dset' ) succ_nodes @@ -575,7 +573,7 @@ let report_context_leaks pname sigma tenv = Errdesc.explain_context_leak pname (Typ.mk (Tstruct name)) fld_name leak_path in let exn = Exceptions.Context_leak (err_desc, __POS__) in - Reporting.log_error_deprecated pname exn) + Reporting.log_error_deprecated pname exn ) context_exps in (* get the set of pointed-to expressions of type T <: Context *) @@ -588,7 +586,7 @@ let report_context_leaks pname sigma tenv = && not (AndroidFramework.is_application tenv name) -> (exp, name) :: exps | _ -> - exps) + exps ) ~init:[] sigma in List.iter @@ -596,7 +594,7 @@ let report_context_leaks pname sigma tenv = | Sil.Hpointsto (Exp.Lvar pv, Sil.Estruct (static_flds, _), _) when Pvar.is_global pv -> List.iter ~f:(fun (f_name, f_strexp) -> - check_reachable_context_from_fld (f_name, f_strexp) context_exps) + check_reachable_context_from_fld (f_name, f_strexp) context_exps ) static_flds | _ -> ()) @@ -733,7 +731,7 @@ let collect_postconditions wl tenv proc_cfg : Paths.PathSet.t * Specs.Visitedset (fun prop -> Attribute.remove_resource tenv Racquire (Rmemory Mobjc) (Attribute.remove_resource tenv Racquire (Rmemory Mmalloc) - (Attribute.remove_resource tenv Racquire Rfile prop))) + (Attribute.remove_resource tenv Racquire Rfile prop)) ) pathset else pathset | _ -> @@ -1135,7 +1133,7 @@ let update_specs tenv prev_summary phase (new_specs: Specs.NormSpec.t list) (List.fold ~f:(fun map spec -> SpecMap.add spec.Specs.pre - (Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map) + (Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map ) ~init:SpecMap.empty old_specs) in let re_exe_filter old_spec = @@ -1230,7 +1228,8 @@ let transition_footprint_re_exe tenv proc_name joined_pres = let specs = List.map ~f:(fun jp -> - Specs.spec_normalize tenv {Specs.pre= jp; posts= []; visited= Specs.Visitedset.empty}) + Specs.spec_normalize tenv {Specs.pre= jp; posts= []; visited= Specs.Visitedset.empty} + ) joined_pres in let payload = {summary.Specs.payload with Specs.preposts= Some specs} in diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index f8b2cf34d..462b8adf2 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -936,4 +936,3 @@ let hpara_dll_create tenv corres sigma1 root1 blink1 flink1 = ; Sil.body_dll= body } in (hpara_dll, es_shared) - diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index ef90fa38c..6dd76ff00 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/infer/src/backend/mergeCapture.ml @@ -65,7 +65,7 @@ let rec slink ~stats ~skiplevels src dst = Array.iter ~f:(fun item -> slink ~stats ~skiplevels:(skiplevels - 1) (Filename.concat src item) - (Filename.concat dst item)) + (Filename.concat dst item) ) items ) else if skiplevels > 0 then () else create_link ~stats src dst @@ -92,7 +92,7 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst = ~f:(fun file -> let file_path = Filename.concat captured_file file in Sys.file_exists file_path = `Yes - && (not check_timestamp_of_symlinks || symlink_up_to_date file_path)) + && (not check_timestamp_of_symlinks || symlink_up_to_date file_path) ) contents else true in @@ -129,8 +129,8 @@ let process_merge_file deps_file = match Str.split_delim (Str.regexp (Str.quote "\t")) line with | target :: _ :: target_results_dir :: _ -> let infer_out_src = - if Filename.is_relative target_results_dir then Filename.dirname (buck_out ()) - ^/ target_results_dir + if Filename.is_relative target_results_dir then + Filename.dirname (buck_out ()) ^/ target_results_dir else target_results_dir in let skiplevels = 2 in @@ -156,4 +156,3 @@ let merge_captured_targets () = MergeResults.merge_buck_flavors_results infer_deps_file ; process_merge_file infer_deps_file ; L.progress "Merging captured Buck targets took %a@\n%!" Mtime.Span.pp (Mtime_clock.count time0) - diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index bdf06aaaa..e8617cbe1 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -211,4 +211,3 @@ let analyze_proc_name : Procdesc.t -> Typ.Procname.t -> Specs.summary option = (** Find a proc desc for the procedure, perhaps loading it from disk. *) let get_proc_desc callee_pname = match !callbacks_ref with Some callbacks -> callbacks.get_proc_desc callee_pname | None -> None - diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 0e77b520c..51622e4f7 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -253,7 +253,6 @@ end = struct let stats1 = compute_stats do_calls f path ; get_stats path in stats.max_length <- stats1.max_length ; stats.linear_num <- stats1.linear_num - end (* End of module Invariant *) @@ -376,7 +375,7 @@ end = struct (fun node num -> if num > !max_rep_num then ( max_rep_node := node ; - max_rep_num := num )) + max_rep_num := num ) ) !map ; (!max_rep_node, !max_rep_num) @@ -480,7 +479,7 @@ end = struct let definition_descr = Format.sprintf "Definition of %s" (Typ.Procname.to_simplified_string pname) in - trace := Errlog.make_trace_element (level + 1) loc definition_descr [] :: !trace) + trace := Errlog.make_trace_element (level + 1) loc definition_descr [] :: !trace ) loc_opt | _, Some curr_node -> ( @@ -548,7 +547,6 @@ end = struct in let relevant lt = lt.Errlog.lt_node_tags <> [] in IList.remove_irrelevant_duplicates compare relevant (List.rev !trace) - end (* =============== END of the Path module ===============*) @@ -740,7 +738,6 @@ end = struct (** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *) let from_renamed_list (pl: ('a Prop.t * Path.t) list) : t = List.fold ~f:(fun ps (p, pa) -> add_renamed_prop p pa ps) ~init:empty pl - end (* =============== END of the PathSet module ===============*) diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 34045c106..b699af07c 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -108,7 +108,6 @@ module NullifyTransferFunctions = struct "Should not add nullify instructions before running nullify analysis!" in if is_last_instr_in_node instr node then postprocess astate' node extras else astate' - end module NullifyAnalysis = @@ -162,13 +161,13 @@ let add_nullify_instrs pdesc tenv liveness_inv_map = | Exp.Var id -> (pvars_acc, id :: ids_acc) | _ -> - (pvars_acc, ids_acc)) + (pvars_acc, ids_acc) ) to_nullify ([], []) in node_add_removetmps_instructions node ids_to_remove ; node_add_nullify_instructions node pvars_to_nullify | None -> - ()) + () ) (ProcCfg.Exceptional.nodes nullify_proc_cfg) ; (* nullify all address taken variables *) if not (AddressTaken.Domain.is_empty address_taken_vars) then @@ -199,4 +198,3 @@ let do_abstraction pdesc = let do_preanalysis pdesc tenv = if not (Procdesc.did_preanalysis pdesc) then ( do_liveness pdesc tenv ; do_abstraction pdesc ) - diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index b6a7bce50..40de117b9 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -151,7 +151,6 @@ end = struct let fd = Hashtbl.find log_files (node_fname, source) in Unix.close fd ; curr_html_formatter := F.std_formatter - end (* =============== END of module NodesHtml =============== *) @@ -380,7 +379,7 @@ let write_proc_html pdesc = ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~isvisited:(is_visited n) ~isproof:false fmt - (Procdesc.Node.get_id n :> int)) + (Procdesc.Node.get_id n :> int) ) nodes ; match Specs.get_summary pname with | None -> @@ -483,7 +482,7 @@ let write_html_file linereader filename procs = ~succs:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_succs n) :> int list) ~exn:(List.map ~f:Procdesc.Node.get_id (Procdesc.Node.get_exn n) :> int list) ~isvisited:(is_visited n) ~isproof fmt - (Procdesc.Node.get_id n :> int)) + (Procdesc.Node.get_id n :> int) ) nodes_at_linenum ; List.iter ~f:(fun n -> @@ -502,7 +501,7 @@ let write_html_file linereader filename procs = in Io_infer.Html.pp_proc_link [fname_encoding] proc_name fmt label | _ -> - ()) + () ) nodes_at_linenum ; List.iter ~f:(fun err_string -> F.fprintf fmt "%s" (create_err_message err_string)) @@ -557,5 +556,5 @@ let write_all_html_files cluster = in SourceFile.Set.iter (fun file -> write_html_file linereader file (Cfg.get_all_procs cfg)) - source_files_in_cfg) + source_files_in_cfg ) exe_env diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 0dfcfefee..0b3de2751 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -1318,8 +1318,7 @@ module Normalize = struct in let handle_unary_negation (e1: Exp.t) (e2: Exp.t) = match (e1, e2) with - | UnOp (LNot, e1', _), Const Cint i - | Const Cint i, UnOp (LNot, e1', _) + | (UnOp (LNot, e1', _), Const Cint i | Const Cint i, UnOp (LNot, e1', _)) when IntLit.iszero i -> (e1', Exp.zero, true) | _ -> @@ -1389,7 +1388,7 @@ module Normalize = struct List.map ~f:(fun (idx, cnt) -> let idx' = exp_normalize tenv sub idx in - (idx', strexp_normalize tenv sub cnt)) + (idx', strexp_normalize tenv sub cnt) ) idx_cnts in let idx_cnts'' = List.sort ~cmp:[%compare : Exp.t * Sil.strexp] idx_cnts' in @@ -1578,7 +1577,7 @@ module Normalize = struct ~f:(fun (n', e') -> Exp.equal e e' && IntLit.leq n n') lt_list_tightened) | _ -> - true) + true ) nonineq_list in (ineq_list', nonineq_list') @@ -1712,7 +1711,6 @@ module Normalize = struct let nprop = List.fold ~f:(prop_atom_and tenv) ~init:p0 (get_pure_extended eprop) in unsafe_cast_to_normal (footprint_normalize tenv (set nprop ~pi_fp:eprop.pi_fp ~sigma_fp:eprop.sigma_fp)) - end (* End of module Normalize *) @@ -1730,7 +1728,7 @@ let lexp_normalize_prop tenv p lexp = let noffsets = List.map ~f:(fun (n: Sil.offset) -> - match n with Off_fld _ -> n | Off_index e -> Sil.Off_index (exp_normalize_prop tenv p e)) + match n with Off_fld _ -> n | Off_index e -> Sil.Off_index (exp_normalize_prop tenv p e) ) offsets in Sil.exp_add_offsets nroot noffsets @@ -2668,7 +2666,6 @@ end = struct let prop_chain_size p = let fp_size = pi_size p.pi_fp + sigma_size p.sigma_fp in pi_size p.pi + sigma_size p.sigma + fp_size - end (*** END of module Metrics ***) @@ -2729,7 +2726,6 @@ module CategorizePreconditions = struct OnlyAllocation | _ :: _, [], [] -> DataConstraints - end (* Export for interface *) diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index 6bc37e923..7a50b1cb3 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -90,7 +90,8 @@ let get_subl footprint_part g = if footprint_part then [] else Sil.sub_to_list g let edge_from_source g n footprint_part is_hpred = let edges = if is_hpred then List.map ~f:(fun hpred -> Ehpred hpred) (get_sigma footprint_part g) - else List.map ~f:(fun a -> Eatom a) (get_pi footprint_part g) + else + List.map ~f:(fun a -> Eatom a) (get_pi footprint_part g) @ List.map ~f:(fun entry -> Esub_entry entry) (get_subl footprint_part g) in let starts_from hpred = diff --git a/infer/src/backend/propset.ml b/infer/src/backend/propset.ml index 7910b9f93..de5bb5bdb 100644 --- a/infer/src/backend/propset.ml +++ b/infer/src/backend/propset.ml @@ -102,4 +102,3 @@ let pp pe prop f pset = let d p ps = let plist = to_proplist ps in Propgraph.d_proplist p plist - diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 808f683bb..42e677d41 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -194,7 +194,6 @@ end = struct let saturate constraints = let constraints_cleaned = sort_then_remove_redundancy constraints in saturate_ constraints_cleaned constraints_cleaned - end (** Return true if the two types have sizes which can be compared *) @@ -460,7 +459,7 @@ end = struct List.iter ~f:(fun (idx, se) -> add_lt_minus1_e idx ; - strexp_extract (se, elt_t)) + strexp_extract (se, elt_t) ) isel in let hpred_extract = function @@ -604,7 +603,6 @@ end = struct List.exists ~f:inconsistent_neq neqs || List.exists ~f:inconsistent_leq leqs || List.exists ~f:inconsistent_lt lts - (* (** Pretty print inequalities and disequalities *) let pp pe fmt { leqs = leqs; lts = lts; neqs = neqs } = @@ -871,7 +869,7 @@ let get_smt_key a p = let fmt_tmp = F.formatter_of_out_channel outc_tmp in let () = F.fprintf fmt_tmp "%a%a" (Sil.pp_atom Pp.text) a (Prop.pp_prop Pp.text) p in Out_channel.close outc_tmp ; - Digest.to_hex (Digest.file tmp_filename) + Caml.Digest.to_hex (Caml.Digest.file tmp_filename) (** Check whether [prop |- a]. False means dont know. *) @@ -1323,7 +1321,6 @@ end = struct d_inner () ; L.d_strln " returning FALSE" ; L.d_ln () - end let d_impl (s1, s2) = ProverState.d_implication (`Exp s1, `Exp s2) @@ -1939,7 +1936,6 @@ module Subtyping_check = struct | _ -> (* don't know, consider both possibilities *) (Some texp1, Some texp1) - end let cast_exception tenv texp1 texp2 e1 subs = @@ -2774,7 +2770,6 @@ let find_minimum_pure_cover tenv cases = let shrink cases = if List.length cases > 2 then shrink_ [] cases else cases in try Some (shrink (grow [] cases)) with NO_COVER -> None - (* (** Check [prop |- e1 - (laundry_atoms @ atoms', se', Exp.Sizeof {sizeof_data with typ= typ'})) + (laundry_atoms @ atoms', se', Exp.Sizeof {sizeof_data with typ= typ'}) ) atoms_se_typ_list_filtered @@ -667,7 +667,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let iter' = List.fold ~f:(Prop.prop_iter_add_atom !Config.footprint) ~init:iter atoms in - Prop.prop_iter_replace_footprint_sigma iter' fp_sigma) + Prop.prop_iter_replace_footprint_sigma iter' fp_sigma ) iter_atoms_fp_sigma_list in let res_prop_list = List.map ~f:(Prop.prop_iter_to_prop tenv) res_iter_list in @@ -888,7 +888,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = && Pvar.is_this pvar -> Some (rhs_exp, typ) | _ -> - None) + None ) sigma in (* warn if the access to [lexp] is not protected by the [guarded_by_fld_str] lock *) @@ -964,7 +964,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = | Sil.Eexp (rhs_exp, _) -> Exp.equal exp rhs_exp && not (Typ.Fieldname.equal fld accessed_fld) | _ -> - false) + false ) flds | _ -> false) @@ -1775,4 +1775,3 @@ let rearrange ?(report_deref_errors= true) pdesc tenv lexp typ prop loc raise (Exceptions.Symexec_memory_error __POS__) ) | Some iter -> iter_rearrange pname tenv nlexp typ prop' iter inst - diff --git a/infer/src/backend/reporting.ml b/infer/src/backend/reporting.ml index 5ad32e796..85e714ff7 100644 --- a/infer/src/backend/reporting.ml +++ b/infer/src/backend/reporting.ml @@ -11,7 +11,7 @@ open! IStd module L = Logging type log_t = - ?loc:Location.t -> ?node_id:int * Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace + ?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit type log_issue_from_errlog = Errlog.t -> log_t @@ -24,7 +24,7 @@ let log_issue_from_errlog err_kind err_log ?loc ?node_id ?session ?ltr ?linters_ let node_id = match node_id with | None -> - (State.get_node_id_key () :> int * Digest.t) + (State.get_node_id_key () :> int * Caml.Digest.t) | Some node_id -> node_id in @@ -88,4 +88,3 @@ let log_warning_deprecated ?(store_summary= false) = let log_info_deprecated ?(store_summary= false) = log_issue_deprecated ~store_summary Exceptions.Kinfo - diff --git a/infer/src/backend/reporting.mli b/infer/src/backend/reporting.mli index caeb7b94d..4fd0ead2f 100644 --- a/infer/src/backend/reporting.mli +++ b/infer/src/backend/reporting.mli @@ -12,7 +12,7 @@ open! IStd (** Type of functions to report issues to the error_log in a spec. *) type log_t = - ?loc:Location.t -> ?node_id:int * Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace + ?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit type log_issue_from_errlog = Errlog.t -> log_t diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index e07bd7ee8..6674c53f9 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -135,7 +135,6 @@ module Jprop = struct | Joined (n, p, jp1, jp2) -> Joined (n, f p, map f jp1, map f jp2) - (* let rec jprop_sub sub = function | Prop (n, p) -> Prop (n, Prop.prop_sub sub p) @@ -232,7 +231,6 @@ end = struct let erase_join_info_pre tenv spec = let spec' = {spec with pre= Jprop.Prop (1, Jprop.to_prop spec.pre)} in normalize tenv spec' - end (** Convert spec into normal form w.r.t. variable renaming *) @@ -311,7 +309,6 @@ module CallStats = struct in List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems - (* let pp fmt t = let do_call (pname, loc) tr = @@ -443,13 +440,13 @@ let pp_specs pe fmt specs = List.iter ~f:(fun spec -> incr cnt ; - F.fprintf fmt "%a" (pp_spec pe (Some (!cnt, total))) spec) + F.fprintf fmt "%a" (pp_spec pe (Some (!cnt, total))) spec ) specs | HTML -> List.iter ~f:(fun spec -> incr cnt ; - F.fprintf fmt "%a
@\n" (pp_spec pe (Some (!cnt, total))) spec) + F.fprintf fmt "%a
@\n" (pp_spec pe (Some (!cnt, total))) spec ) specs @@ -464,7 +461,7 @@ let get_signature summary = ~f:(fun (p, typ) -> let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) typ Mangled.pp p in let decl = F.asprintf "%t" pp in - s := if String.equal !s "" then decl else !s ^ ", " ^ decl) + s := if String.equal !s "" then decl else !s ^ ", " ^ decl ) (get_formals summary) ; let pp f = F.fprintf f "%a %a" (Typ.pp_full Pp.text) (get_ret_type summary) Typ.Procname.pp @@ -579,8 +576,7 @@ let res_dir_specs_filename pname = (** paths to the .specs file for the given procedure in the current spec libraries *) let specs_library_filenames pname = List.map - ~f:(fun specs_dir -> - DB.filename_from_string (Filename.concat specs_dir (specs_filename pname))) + ~f:(fun specs_dir -> DB.filename_from_string (Filename.concat specs_dir (specs_filename pname))) Config.specs_library diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index a8ff3c087..8ba2a82a4 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -25,7 +25,7 @@ type failure_stats = ; (* number of node failures (i.e. at least one instruction failure) *) mutable node_ok: int ; (* number of node successes (i.e. no instruction failures) *) - mutable first_failure: (Location.t * (int * Digest.t) * int * Errlog.loc_trace * exn) option + mutable first_failure: (Location.t * (int * Caml.Digest.t) * int * Errlog.loc_trace * exn) option (* exception at the first failure *) } module NodeHash = Procdesc.NodeHash @@ -310,7 +310,7 @@ let mark_instr_ok () = let mark_instr_fail exn = let loc = get_loc () in - let key = (get_node_id_key () :> int * Digest.t) in + let key = (get_node_id_key () :> int * Caml.Digest.t) in let session = get_session () in let loc_trace = get_loc_trace () in let fs = get_failure_stats (get_node ()) in @@ -320,7 +320,7 @@ let mark_instr_fail exn = type log_issue = - ?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Digest.t + ?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit diff --git a/infer/src/backend/state.mli b/infer/src/backend/state.mli index 778041502..4566da967 100644 --- a/infer/src/backend/state.mli +++ b/infer/src/backend/state.mli @@ -42,7 +42,7 @@ val get_node : unit -> Procdesc.Node.t val get_node_id : unit -> Procdesc.Node.id (** Get id of last node seen in symbolic execution *) -val get_node_id_key : unit -> Procdesc.Node.id * Digest.t +val get_node_id_key : unit -> Procdesc.Node.id * Caml.Digest.t (** Get id and key of last node seen in symbolic execution *) val get_normalized_pre : @@ -80,7 +80,7 @@ val mk_find_duplicate_nodes : Procdesc.t -> Procdesc.Node.t -> Procdesc.NodeSet. and normalized (w.r.t. renaming of let - bound ids) list of instructions. *) type log_issue = - ?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Digest.t + ?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 812ce26ad..770e699db 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -53,7 +53,7 @@ let get_blocks_nullified node = let null_blocks = List.concat_map ~f:(fun i -> - match i with Sil.Nullify (pvar, _) when Sil.is_block_pvar pvar -> [pvar] | _ -> []) + match i with Sil.Nullify (pvar, _) when Sil.is_block_pvar pvar -> [pvar] | _ -> [] ) (ProcCfg.Exceptional.instrs node) in null_blocks @@ -642,7 +642,7 @@ let resolve_java_pname tenv prop args pname_java call_flags : Typ.Procname.java | Some class_name -> Typ.Procname.split_classname (Typ.Name.name class_name) :: accu | None -> - name :: accu) + name :: accu ) ~init:[] args (Typ.Procname.java_get_parameters resolved_pname_java) |> List.rev @@ -700,8 +700,7 @@ let resolve_and_analyze tenv caller_pdesc prop args callee_proc_name call_flags Some resolved_proc_desc | None -> Option.map - ~f:(fun callee_proc_desc -> - Cfg.specialize_types callee_proc_desc resolved_pname args) + ~f:(fun callee_proc_desc -> Cfg.specialize_types callee_proc_desc resolved_pname args) (Ondemand.get_proc_desc callee_proc_name) in Option.bind resolved_proc_desc_option ~f:analyze @@ -753,7 +752,7 @@ let receiver_self receiver prop = Exp.equal e receiver && Pvar.is_seed pv && Mangled.equal (Pvar.get_name pv) (Mangled.from_string "self") | _ -> - false) + false ) prop.Prop.sigma @@ -914,7 +913,7 @@ let add_constraints_on_retval tenv pdesc prop ret_exp ~has_nonnull_annot typ cal | Sil.Hpointsto (Exp.Lvar pv, _, exp) when Pvar.equal pv abduced_ret_pv -> Some exp | _ -> - None) + None ) p.Prop.sigma_fp in (* find an hpred [abduced] |-> A in [prop] and add [exp] = A to prop *) @@ -1432,7 +1431,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call | Sil.Hpointsto (Exp.Lvar pv, _, _) -> Pvar.equal pv abduced | _ -> - false) + false ) p.Prop.sigma_fp in (* prevent introducing multiple abduced retvals for a single call site in a loop *) @@ -1480,7 +1479,7 @@ and add_constraints_on_actuals_by_ref tenv prop actuals_by_ref callee_pname call let new_hpred = Sil.Hpointsto (actual, rhs, texp) in Prop.normalize tenv (Prop.set p ~sigma:(new_hpred :: prop'.Prop.sigma)) | _ -> - p) + p ) ~init:prop' prop'.Prop.sigma in let non_const_actuals_by_ref = @@ -1549,7 +1548,7 @@ and unknown_or_scan_call ~is_scan ~reason ret_type_option ret_annots | (Exp.Var _ as e), ({Typ.desc= Tptr _} as t) when should_abduce_param_value callee_pname -> Some (e, t, i) | _ -> - None) + None ) args in let has_nonnull_annot = Annotations.ia_is_nonnull ret_annots in @@ -1819,7 +1818,7 @@ and sym_exec_wrapper handle_exn tenv proc_cfg instr ((prop: Prop.normal Prop.t), let res_list = Config.run_with_abs_val_equal_zero (* no exp abstraction during sym exe *) - (fun () -> sym_exec tenv (ProcCfg.Exceptional.proc_desc proc_cfg) instr prop' path) + (fun () -> sym_exec tenv (ProcCfg.Exceptional.proc_desc proc_cfg) instr prop' path ) () in let res_list_nojunk = diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 41cc22878..468a045ca 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -353,7 +353,7 @@ let check_dereferences caller_pname tenv callee_pname actual_pre sub spec_pre fo let deref_err_list = List.fold ~f:(fun deref_errs hpred -> - match check_hpred hpred with Some reason -> reason :: deref_errs | None -> deref_errs) + match check_hpred hpred with Some reason -> reason :: deref_errs | None -> deref_errs ) ~init:[] spec_pre.Prop.sigma in match deref_err_list with @@ -789,13 +789,14 @@ let combine tenv ret_id (posts: ('a Prop.t * Paths.Path.t) list) actual_pre path else List.map ~f:(fun (p, path_post) -> - (p, Paths.Path.add_call (include_subtrace callee_pname) path_pre callee_pname path_post)) + (p, Paths.Path.add_call (include_subtrace callee_pname) path_pre callee_pname path_post) + ) posts in List.map ~f:(fun (p, path) -> post_process_post tenv caller_pname callee_pname loc actual_pre - (Prop.prop_sub split.sub p, path)) + (Prop.prop_sub split.sub p, path) ) posts' in L.d_increase_indent 1 ; @@ -1029,7 +1030,7 @@ let check_uninitialize_dangling_deref caller_pname tenv callee_pname actual_pre | Some (Deref_undef_exp, desc) -> raise (Exceptions.Dangling_pointer_dereference (Some PredSymb.DAuninit, desc, __POS__)) | _ -> - ()) + () ) props @@ -1366,4 +1367,3 @@ let exe_function_call callee_summary tenv ret_id_opt caller_pdesc callee_pname l in let results = List.map ~f:exe_one_spec spec_list in exe_call_postprocess tenv ret_id_opt trace_call callee_pname callee_attrs loc results - diff --git a/infer/src/backend/timeout.ml b/infer/src/backend/timeout.ml index ed1a5dc7e..69e720be0 100644 --- a/infer/src/backend/timeout.ml +++ b/infer/src/backend/timeout.ml @@ -118,10 +118,9 @@ let exe_timeout f x = ~f:(fun () -> suspend_existing_timeout_and_start_new_one () ; f x ; - None) + None ) ~finally:resume_previous_timeout with SymOp.Analysis_failure_exe kind -> L.progressbar_timeout_event kind ; Errdesc.warning_err (State.get_loc ()) "TIMEOUT: %a@." SymOp.pp_failure_kind kind ; Some kind - diff --git a/infer/src/base/CommandDoc.ml b/infer/src/base/CommandDoc.ml index bcea91158..b5461eec8 100644 --- a/infer/src/base/CommandDoc.ml +++ b/infer/src/base/CommandDoc.ml @@ -283,4 +283,3 @@ let command_to_data = let data_of_command command = List.Assoc.find_exn ~equal:CLOpt.equal_command command_to_data command - diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index 34c815d83..fdf616760 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -181,7 +181,7 @@ let xdesc {long; short; spec} = (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s" arg (dashdash ~short long) - (String.concat ~sep:" | " symbols)))) + (String.concat ~sep:" | " symbols))) ) | _ -> spec in @@ -218,7 +218,6 @@ module SectionMap = Caml.Map.Make (struct -1 else (* reverse order *) String.compare s2 s1 - end) let help_sections_desc_lists = @@ -384,8 +383,10 @@ let mk_set var value ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= let setter () = var := value in ignore (mk ~deprecated ~long ?short ~default:() ?parse_mode ?in_help ~meta doc - ~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long) - ~mk_setter:(fun _ _ -> setter ()) ~mk_spec:(fun _ -> Unit setter )) + ~default_to_string:(fun () -> "") + ~decode_json:(string_json_decoder ~long) + ~mk_setter:(fun _ _ -> setter ()) + ~mk_spec:(fun _ -> Unit setter)) let mk_with_reset value ~reset_doc ?deprecated ~long ?parse_mode mk = @@ -405,8 +406,9 @@ let mk_option ?(default= None) ?(default_to_string= fun _ -> "") ~f ?(mk_reset= ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "string") doc = let mk () = mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string - ~decode_json:(string_json_decoder ~long) ~mk_setter:(fun var str -> var := f str) ~mk_spec: - (fun set -> String set ) + ~decode_json:(string_json_decoder ~long) + ~mk_setter:(fun var str -> var := f str) + ~mk_spec:(fun set -> String set) in if mk_reset then let reset_doc = reset_doc_opt ~long in @@ -423,7 +425,7 @@ let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated and noshort = Option.map ~f:(fun short -> - if Char.is_lowercase short then Char.uppercase short else Char.lowercase short) + if Char.is_lowercase short then Char.uppercase short else Char.lowercase short ) short in let doc long short = @@ -444,7 +446,7 @@ let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated mk ~long ?short ~deprecated ~default ?parse_mode ?in_help ~meta doc ~default_to_string ~mk_setter:(fun var _ -> var := f true) ~decode_json:(fun ~inferconfig_dir:_ json -> - [dashdash (if YBU.to_bool json then long else nolong)]) + [dashdash (if YBU.to_bool json then long else nolong)] ) ~mk_spec in ignore @@ -452,7 +454,7 @@ let mk_bool ?(deprecated_no= []) ?(default= false) ?(f= fun b -> b) ?(deprecated ?in_help ~meta nodoc ~default_to_string ~mk_setter:(fun _ _ -> var := f false) ~decode_json:(fun ~inferconfig_dir:_ json -> - [dashdash (if YBU.to_bool json then nolong else long)]) + [dashdash (if YBU.to_bool json then nolong else long)] ) ~mk_spec) ; var @@ -470,8 +472,10 @@ let mk_bool_group ?(deprecated_no= []) ?(default= false) ?f:(f0 = Fn.id) ?(depre let mk_int ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "int") doc = mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc - ~default_to_string:string_of_int ~mk_setter:(fun var str -> var := f (int_of_string str)) - ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set ) + ~default_to_string:string_of_int + ~mk_setter:(fun var str -> var := f (int_of_string str)) + ~decode_json:(string_json_decoder ~long) + ~mk_spec:(fun set -> String set) let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help @@ -483,8 +487,10 @@ let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mo let mk_float ~default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc = mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc - ~default_to_string:string_of_float ~mk_setter:(fun var str -> var := float_of_string str) - ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set ) + ~default_to_string:string_of_float + ~mk_setter:(fun var str -> var := float_of_string str) + ~decode_json:(string_json_decoder ~long) + ~mk_spec:(fun set -> String set) let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc = @@ -496,8 +502,10 @@ let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?( let mk_string ~default ?(f= fun s -> s) ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "string") doc = mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc - ~default_to_string:(fun s -> s) ~mk_setter:(fun var str -> var := f str) - ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set ) + ~default_to_string:(fun s -> s) + ~mk_setter:(fun var str -> var := f str) + ~decode_json:(string_json_decoder ~long) + ~mk_spec:(fun set -> String set) let mk_string_opt ?default ?(f= fun s -> s) ?mk_reset ?(deprecated= []) ~long ?short ?parse_mode @@ -512,9 +520,10 @@ let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?shor ?in_help ?(meta= "string") doc = let mk () = mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta:("+" ^ meta) doc - ~default_to_string:(String.concat ~sep:",") ~mk_setter:(fun var str -> var := f str :: !var) - ~decode_json:(list_json_decoder (string_json_decoder ~long)) ~mk_spec:(fun set -> String set - ) + ~default_to_string:(String.concat ~sep:",") + ~mk_setter:(fun var str -> var := f str :: !var) + ~decode_json:(list_json_decoder (string_json_decoder ~long)) + ~mk_spec:(fun set -> String set) in let reset_doc = reset_doc_list ~long in mk_with_reset [] ~reset_doc ~long ?parse_mode mk @@ -539,7 +548,8 @@ let mk_path_helper ~setter ~default_to_string ~default ~deprecated ~long ~short ~default_to_string ~mk_setter:(fun var str -> let abs_path = normalize_path_in_args_being_parsed ~is_anon_arg:false str in - setter var abs_path) ~mk_spec:(fun set -> String set ) + setter var abs_path ) + ~mk_spec:(fun set -> String set) let mk_path ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help @@ -589,8 +599,10 @@ let mk_symbol ~default ~symbols ~eq ?(f= Fn.id) ?(deprecated= []) ~long ?short ? let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in let meta = Option.value meta ~default:(mk_symbols_meta symbols) in mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc - ~default_to_string:(fun s -> to_string s) ~mk_setter:(fun var str -> var := of_string str |> f) - ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set) ) + ~default_to_string:(fun s -> to_string s) + ~mk_setter:(fun var str -> var := of_string str |> f) + ~decode_json:(string_json_decoder ~long) + ~mk_spec:(fun set -> Symbol (strings, set)) let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long ?short ?parse_mode @@ -600,8 +612,10 @@ let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long let meta = Option.value meta ~default:(mk_symbols_meta symbols) in let mk () = mk ~deprecated ~long ?short ~default:None ?parse_mode ?in_help ~meta doc - ~default_to_string:(fun _ -> "") ~mk_setter:(fun var str -> var := Some (f (of_string str))) - ~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set) ) + ~default_to_string:(fun _ -> "") + ~mk_setter:(fun var str -> var := Some (f (of_string str))) + ~decode_json:(string_json_decoder ~long) + ~mk_spec:(fun set -> Symbol (strings, set)) in if mk_reset then let reset_doc = reset_doc_opt ~long in @@ -619,8 +633,8 @@ let mk_symbol_seq ?(default= []) ~symbols ~eq ?(deprecated= []) ~long ?short ?pa ~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms)) ~mk_setter:(fun var str_seq -> var := List.map ~f:of_string (String.split ~on:',' str_seq)) ~decode_json:(fun ~inferconfig_dir:_ json -> - [dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)]) ~mk_spec: - (fun set -> String set ) + [dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)] ) + ~mk_spec:(fun set -> String set) let mk_set_from_json ~default ~default_to_string ~f ?(deprecated= []) ~long ?short ?parse_mode @@ -628,7 +642,7 @@ let mk_set_from_json ~default ~default_to_string ~f ?(deprecated= []) ~long ?sho mk ~deprecated ~long ?short ?parse_mode ?in_help ~meta doc ~default ~default_to_string ~mk_setter:(fun var json -> var := f (Yojson.Basic.from_string json)) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json]) - ~mk_spec:(fun set -> String set ) + ~mk_spec:(fun set -> String set) let mk_json ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "json") doc = @@ -636,7 +650,7 @@ let mk_json ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "json") ~default_to_string:Yojson.Basic.to_string ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json) ~decode_json:(fun ~inferconfig_dir:_ json -> [dashdash long; Yojson.Basic.to_string json]) - ~mk_spec:(fun set -> String set ) + ~mk_spec:(fun set -> String set) (** [mk_anon] always return the same ref. Anonymous arguments are only accepted if @@ -756,7 +770,7 @@ let mk_rest_actions ?(parse_mode= InferCommand) ?(in_help= []) doc ~usage decode String (fun arg -> rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; - select_parse_mode ~usage (decode_action arg) |> ignore) + select_parse_mode ~usage (decode_action arg) |> ignore ) in add parse_mode in_help {long= "--"; short= ""; meta= ""; doc; spec; decode_json= (fun ~inferconfig_dir:_ _ -> [])} ; @@ -772,12 +786,14 @@ let mk_subcommand command ?on_unknown_arg:(on_unknown = `Reject) ~name ?deprecat ( match deprecated_long with | Some long -> ignore - (mk ~long ~default:() ?parse_mode ?in_help ~meta:"" "" ~default_to_string:(fun () -> "") + (mk ~long ~default:() ?parse_mode ?in_help ~meta:"" "" + ~default_to_string:(fun () -> "") ~decode_json:(fun ~inferconfig_dir:_ _ -> - raise (Arg.Bad ("Bad option in config file: " ^ long))) + raise (Arg.Bad ("Bad option in config file: " ^ long)) ) ~mk_setter:(fun _ _ -> warnf "WARNING: '%s' is deprecated. Please use '%s' instead.@\n" (dashdash long) name ; - switch ()) ~mk_spec:(fun set -> Unit (fun () -> set "") )) + switch () ) + ~mk_spec:(fun set -> Unit (fun () -> set ""))) | None -> () ) ; subcommands := (command, (command_doc, name, in_help)) :: !subcommands ; @@ -856,7 +872,7 @@ let decode_inferconfig_to_argv path = ~f:(fun {long; short} -> String.equal key long || String.equal key short (* for deprecated options *) - || (* for deprecated options that start with "-" *) String.equal ("-" ^ key) short) + || (* for deprecated options that start with "-" *) String.equal ("-" ^ key) short ) !desc_list in decode_json ~inferconfig_dir json_val @ result @@ -883,7 +899,7 @@ let encode_argv_to_env argv = || (warnf "WARNING: Ignoring unsupported option containing '%c' character: %s@\n" env_var_sep arg ; - false)) + false) ) argv) @@ -1008,8 +1024,8 @@ let wrap_line indent_string wrap_length line0 = let add_word_to_paragraph (rev_lines, non_empty, line, line_length) word = let word_length = let len = String.length word in - if String.is_prefix ~prefix:"$(b," word || String.is_prefix ~prefix:"$(i," word then len - 4 - (* length of formatting tag prefix *) + if String.is_prefix ~prefix:"$(b," word || String.is_prefix ~prefix:"$(i," word then + len - 4 (* length of formatting tag prefix *) - 1 (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *) else len in @@ -1059,8 +1075,9 @@ let show_manual ?internal_section format default_doc command_opt = (* base indentation of documentation strings *) in `I (Format.asprintf "$(b,%s)%a%a" (dashdash long) pp_short short pp_meta meta, doc_first_line) - :: List.concat_map (List.concat_map ~f:(wrap_line indent_string width) doc_other_lines) ~f: - (fun s -> [`Noblank; `Pre s] ) + :: List.concat_map + (List.concat_map ~f:(wrap_line indent_string width) doc_other_lines) + ~f:(fun s -> [`Noblank; `Pre s]) in let option_blocks = match command_doc.manual_options with @@ -1085,7 +1102,7 @@ let show_manual ?internal_section format default_doc command_opt = (fun section descs result -> `S section :: (if String.equal section Cmdliner.Manpage.s_options then blocks else []) - @ List.concat_map ~f:block_of_desc (normalize_desc_list descs) @ result) + @ List.concat_map ~f:block_of_desc (normalize_desc_list descs) @ result ) !sections hidden | None -> `S Cmdliner.Manpage.s_options :: blocks @@ -1098,4 +1115,3 @@ let show_manual ?internal_section format default_doc command_opt = in Cmdliner.Manpage.print format Format.std_formatter (command_doc.title, blocks) ; () - diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 843023aed..7463a724a 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -667,7 +667,7 @@ and analyzer = - $(b,compile): similar to specifying the $(b,compile) subcommand (DEPRECATED) - $(b,crashcontext): experimental (see $(b,--crashcontext))|} ~f:(function - | CaptureOnly | CompileOnly as x -> + | (CaptureOnly | CompileOnly) as x -> let analyzer_str = List.find_map_exn string_to_analyzer ~f:(fun (s, y) -> if equal_analyzer x y then Some s else None ) @@ -752,7 +752,7 @@ and ( annotation_reachability ~f:(fun b -> disable_all_checkers () ; var := b ; - b) + b ) ( if String.equal doc "" then "" else Printf.sprintf "Enable $(b,--%s) and disable all other checkers" long ) [] (* do all the work in ~f *) @@ -769,15 +769,14 @@ and ( annotation_reachability ( "Default checkers: " ^ ( List.rev_filter_map ~f:(fun (_, long, _, default) -> - if default then Some (Printf.sprintf "$(b,--%s)" long) else None) + if default then Some (Printf.sprintf "$(b,--%s)" long) else None ) !all_checkers |> String.concat ~sep:", " ) ) ~f:(fun b -> List.iter - ~f:(fun (var, _, _, default) -> - var := if b then default || !var else not default && !var) + ~f:(fun (var, _, _, default) -> var := if b then default || !var else not default && !var) !all_checkers ; - b) + b ) [] (* do all the work in ~f *) [] (* do all the work in ~f *) @@ -1058,7 +1057,7 @@ and ( bo_debug "Debug mode (also sets $(b,--debug-level 2), $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), $(b,--print-types), $(b,--reports-include-ml-loc), $(b,--no-only-cheap-debug), $(b,--trace-error), $(b,--write-dotty), $(b,--write-html))" ~f:(fun debug -> if debug then set_debug_level 2 else set_debug_level 0 ; - debug) + debug ) [ developer_mode ; print_buckets ; print_types @@ -1104,7 +1103,7 @@ and ( bo_debug "Debug mode for developing new linters. (Sets the analyzer to $(b,linters); also sets $(b,--debug), $(b,--debug-level-linters 2), $(b,--developer-mode), and unsets $(b,--allowed-failures) and $(b,--default-linters)." ~f:(fun debug -> debug_level_linters := if debug then 2 else 0 ; - debug) + debug ) [debug; developer_mode] [default_linters; keep_going] in ( bo_debug @@ -1156,7 +1155,7 @@ and () = CLOpt.mk_string_list ?deprecated ~long ~f:(fun issue_id -> let issue = IssueType.from_string issue_id in - IssueType.set_enabled issue b ; issue_id) + IssueType.set_enabled issue b ; issue_id ) ?default ~meta:"issue_type" ~in_help:CLOpt.([(Report, manual_generic)]) doc @@ -1728,10 +1727,12 @@ and report_previous = and rest = - CLOpt.mk_rest_actions ~in_help:CLOpt.([(Capture, manual_generic); (Run, manual_generic)]) + CLOpt.mk_rest_actions + ~in_help:CLOpt.([(Capture, manual_generic); (Run, manual_generic)]) "Stop argument processing, use remaining arguments as a build command" ~usage:exe_usage (fun build_exe -> - match Filename.basename build_exe with "java" | "javac" -> CLOpt.Javac | _ -> CLOpt.NoParse ) + match Filename.basename build_exe with "java" | "javac" -> CLOpt.Javac | _ -> CLOpt.NoParse + ) and results_dir = @@ -1834,7 +1835,7 @@ and specs_library = ~long:"specs-library-index" ~default:"" ~f:(fun file -> specs_library := read_specs_dir_list_file file @ !specs_library ; - "") + "" ) ~in_help:CLOpt.([(Analyze, manual_generic)]) ~meta:"file" "" in @@ -2013,7 +2014,7 @@ let javac_classes_out = (* extend env var args to pass args to children that do not receive the rest args *) CLOpt.extend_env_args ["--results-dir"; classes_out_infer] ; results_dir := classes_out_infer ) ; - classes_out) + classes_out ) "" @@ -2025,7 +2026,7 @@ and _ = let files = List.filter paths ~f:(fun path -> Sys.is_file path = `Yes) in CLOpt.extend_env_args (List.concat_map files ~f:(fun file -> ["--specs-library"; file])) ; specs_library := List.rev_append files !specs_library ) ; - classpath) + classpath ) "" @@ -2093,7 +2094,7 @@ let post_parsing_initialization command_opt = match inferconfig_file with | Some inferconfig -> Printf.sprintf "version %s/inferconfig %s" Version.commit - (Digest.to_hex (Digest.file inferconfig)) + (Caml.Digest.to_hex (Caml.Digest.file inferconfig)) | None -> Version.commit in @@ -2786,7 +2787,7 @@ let set_reference_and_call_function reference value f x = Utils.try_finally_swallow_timeout ~f:(fun () -> reference := value ; - f x) + f x ) ~finally:restore diff --git a/infer/src/base/DB.ml b/infer/src/base/DB.ml index 226389f6a..701f83919 100644 --- a/infer/src/base/DB.ml +++ b/infer/src/base/DB.ml @@ -92,13 +92,13 @@ let find_source_dirs () = List.iter ~f:(fun fname -> let path = Filename.concat dir fname in - if Filename.check_suffix path ".cg" then source_dirs := dir :: !source_dirs) + if Filename.check_suffix path ".cg" then source_dirs := dir :: !source_dirs ) files in List.iter ~f:(fun fname -> let dir = Filename.concat Config.captured_dir fname in - if Sys.is_directory dir = `Yes then add_cg_files_from_dir dir) + if Sys.is_directory dir = `Yes then add_cg_files_from_dir dir ) files_in_results_dir ; List.rev !source_dirs @@ -164,7 +164,7 @@ let update_file_with_lock dir fname update = let buf = read_whole_file fd in reset_file fd ; let str = update buf in - let i = Unix.write fd ~buf:str ~pos:0 ~len:(String.length str) in + let i = Unix.write fd ~buf:(Bytes.of_string str) ~pos:0 ~len:(String.length str) in if Int.equal i (String.length str) then ( Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ; Unix.close fd ) @@ -265,7 +265,6 @@ module Results_dir = struct in let full_fname = Filename.concat (create dir_path) filename in Unix.openfile full_fname ~mode:Unix.([O_WRONLY; O_CREAT; O_TRUNC]) ~perm:0o777 - end let global_tenv_fname = @@ -304,7 +303,8 @@ let fold_paths_matching ~dir ~p ~init ~f = Array.fold ~f:(fun acc file -> let path = dir ^/ file in - if Sys.is_directory path = `Yes then paths acc path else if p path then f path acc else acc) + if Sys.is_directory path = `Yes then paths acc path else if p path then f path acc else acc + ) ~init:path_list (Sys.readdir dir) in paths init dir diff --git a/infer/src/base/Die.ml b/infer/src/base/Die.ml index c9a7f6427..608895172 100644 --- a/infer/src/base/Die.ml +++ b/infer/src/base/Die.ml @@ -50,4 +50,3 @@ let exit_code_of_exception = function exitcode | _ -> (* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2 - diff --git a/infer/src/base/Epilogues.ml b/infer/src/base/Epilogues.ml index b5e6844cc..acebf78d3 100644 --- a/infer/src/base/Epilogues.ml +++ b/infer/src/base/Epilogues.ml @@ -36,4 +36,3 @@ let register ~f desc = Pervasives.at_exit f_no_exn ; (* Register signal masking. *) Lazy.force activate_run_epilogues_on_signal - diff --git a/infer/src/base/EventLogger.ml b/infer/src/base/EventLogger.ml index dc96c28d7..97098983e 100644 --- a/infer/src/base/EventLogger.ml +++ b/infer/src/base/EventLogger.ml @@ -70,7 +70,6 @@ end = struct let new_id = generate () in Unix.putenv ~key:infer_run_identifier_env_var ~data:new_id ; new_id - end let get_log_identifier () = Random_id.get () diff --git a/infer/src/base/MarkupFormatter.ml b/infer/src/base/MarkupFormatter.ml index 6274ba0bf..2f4af84dd 100644 --- a/infer/src/base/MarkupFormatter.ml +++ b/infer/src/base/MarkupFormatter.ml @@ -37,7 +37,6 @@ end = struct ; wrap_bold= wrap_simple ; pp_bold= pp_simple ; bold_to_string= Fn.id } - end module PhabricatorFormatter : sig @@ -72,7 +71,6 @@ end = struct ; wrap_bold ; pp_bold ; bold_to_string } - end let formatter = diff --git a/infer/src/base/MergeResults.ml b/infer/src/base/MergeResults.ml index df485e84f..4bf698db9 100644 --- a/infer/src/base/MergeResults.ml +++ b/infer/src/base/MergeResults.ml @@ -78,4 +78,3 @@ let merge_buck_flavors_results infer_deps_file = List.iter ~f:one_line lines | Error error -> L.internal_error "Couldn't read deps file '%s': %s" infer_deps_file error - diff --git a/infer/src/base/Multilinks.ml b/infer/src/base/Multilinks.ml index caa1bc60b..0dad2740f 100644 --- a/infer/src/base/Multilinks.ml +++ b/infer/src/base/Multilinks.ml @@ -64,4 +64,3 @@ let resolve fname = fname | Some links -> try DB.filename_from_string (String.Table.find_exn links base) with Not_found -> fname - diff --git a/infer/src/base/Pp.ml b/infer/src/base/Pp.ml index 3136a86fe..fd12c34e7 100644 --- a/infer/src/base/Pp.ml +++ b/infer/src/base/Pp.ml @@ -63,7 +63,8 @@ let text = (** Default html print environment *) let html color = { text with - kind= HTML; cmap_norm= colormap_from_color color; cmap_foot= colormap_from_color color; color } + kind= HTML; cmap_norm= colormap_from_color color; cmap_foot= colormap_from_color color; color + } (** Extend the normal colormap for the given object with the given color *) @@ -146,4 +147,3 @@ let pp_argfile fmt fname = let cli_args fmt args = F.fprintf fmt "'%a'@\n%a" (seq ~sep:"' '" string) args (seq ~sep:"\n" pp_argfile) (List.filter_map ~f:(String.chop_prefix ~prefix:"@") args) - diff --git a/infer/src/base/PrettyPrintable.ml b/infer/src/base/PrettyPrintable.ml index 046b4f664..e922e396c 100644 --- a/infer/src/base/PrettyPrintable.ml +++ b/infer/src/base/PrettyPrintable.ml @@ -63,5 +63,4 @@ module MakePPMap (Ord : PrintableOrderedType) = struct let pp ~pp_value fmt m = let pp_item fmt (k, v) = F.fprintf fmt "%a -> %a" Ord.pp k pp_value v in pp_collection ~pp_item fmt (bindings m) - end diff --git a/infer/src/base/Process.ml b/infer/src/base/Process.ml index 7f119b15f..36254cbf8 100644 --- a/infer/src/base/Process.ml +++ b/infer/src/base/Process.ml @@ -17,7 +17,7 @@ let print_error_and_exit ?(exit_code= 1) fmt = F.kfprintf (fun _ -> L.external_error "%s" (F.flush_str_formatter ()) ; - L.exit exit_code) + L.exit exit_code ) F.str_formatter fmt @@ -65,4 +65,3 @@ let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args = let producer_status = Unix.waitpid producer_pid in let consumer_status = Unix.waitpid consumer_pid in (producer_status, consumer_status) - diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index 44b4944e9..d9ec1191a 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -45,4 +45,3 @@ let start_child ~f ~pool x = | `In_the_parent _pid -> incr pool ; if should_wait pool then wait pool - diff --git a/infer/src/base/Serialization.ml b/infer/src/base/Serialization.ml index a4d12993e..5232019a7 100644 --- a/infer/src/base/Serialization.ml +++ b/infer/src/base/Serialization.ml @@ -34,7 +34,6 @@ module Key = struct , 579094948 , 972393003 , 852343110 ) - end (** version of the binary files, to be incremented for each change *) @@ -95,8 +94,9 @@ let create_serializer (key: Key.t) : 'a serializer = (* Retry to read for 1 second in case of end of file, *) (* which indicates that another process is writing the same file. *) let one_second = Mtime.Span.of_uint64_ns (Int64.of_int 1_000_000_000) in - SymOp.try_finally ~f:(fun () -> retry_exception ~timeout:one_second ~catch_exn ~f:read ()) - ~finally:(fun () -> In_channel.close inc ) + SymOp.try_finally + ~f:(fun () -> retry_exception ~timeout:one_second ~catch_exn ~f:read ()) + ~finally:(fun () -> In_channel.close inc) in let write_to_tmp_file fname data = let fname_tmp = diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index aacfadd76..a778fed0d 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -179,5 +179,4 @@ module SQLite = struct RelativeProjectRoot rel_path | Sqlite3.Data.BLOB b -> Marshal.from_string b 0 - end diff --git a/infer/src/base/StatisticsToolbox.ml b/infer/src/base/StatisticsToolbox.ml index de88b3102..44b2a37b9 100644 --- a/infer/src/base/StatisticsToolbox.ml +++ b/infer/src/base/StatisticsToolbox.ml @@ -69,4 +69,3 @@ let compute_statistics values = ; p75= percentile 0.75 ; max= percentile 1.0 ; count= num_elements } - diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 087fe2743..32bf7def8 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -185,7 +185,7 @@ let directory_iter f path = let directory_is_empty path = Sys.readdir path |> Array.is_empty -let string_crc_hex32 s = Digest.to_hex (Digest.string s) +let string_crc_hex32 s = Caml.Digest.to_hex (Caml.Digest.string s) let read_json_file path = try Ok (Yojson.Basic.from_file path) with Sys_error msg | Yojson.Json_error msg -> Error msg @@ -245,8 +245,8 @@ let shell_escape_command = | arg -> if Str.string_match no_quote_needed arg 0 then arg else if Str.string_match easy_single_quotable arg 0 then F.sprintf "'%s'" arg - else if Str.string_match easy_double_quotable arg 0 then arg |> Escape.escape_double_quotes - |> F.sprintf "\"%s\"" + else if Str.string_match easy_double_quotable arg 0 then + arg |> Escape.escape_double_quotes |> F.sprintf "\"%s\"" else (* ends on-going single quote, output single quote inside double quotes, then open a new single quote *) @@ -338,7 +338,10 @@ let compare_versions v1 v2 = let write_file_with_locking ?(delete= false) ~f:do_write fname = - Unix.with_file ~mode:Unix.([O_WRONLY; O_CREAT]) fname ~f:(fun file_descr -> + Unix.with_file + ~mode:Unix.([O_WRONLY; O_CREAT]) + fname + ~f:(fun file_descr -> if Unix.flock file_descr Unix.Flock_command.lock_exclusive then ( (* make sure we're not writing over some existing, possibly longer content: some other process may have snagged the file from under us between open(2) and flock(2) so passing @@ -387,4 +390,4 @@ let yield () = Unix.select ~read:[] ~write:[] ~except:[] ~timeout:(`After Time_ns.Span.min_value) |> ignore -let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Digest.string +let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Caml.Digest.string diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index 178879626..6634dba8d 100644 --- a/infer/src/base/Utils.mli +++ b/infer/src/base/Utils.mli @@ -111,5 +111,5 @@ val without_gc : f:(unit -> unit) -> unit val yield : unit -> unit (** try to give the control back to the OS without sleeping too much *) -val better_hash : 'a -> Digest.t +val better_hash : 'a -> Caml.Digest.t (** Hashtbl.hash only hashes the first 10 meaningful values, [better_hash] uses everything. *) diff --git a/infer/src/base/ZipLib.ml b/infer/src/base/ZipLib.ml index dd91a5b73..f5a5bee2d 100644 --- a/infer/src/base/ZipLib.ml +++ b/infer/src/base/ZipLib.ml @@ -98,4 +98,3 @@ let load serializer path = if Option.is_some opt then opt else loop other_libraries in loop (Lazy.force zip_libraries) - diff --git a/infer/src/bufferoverrun/absLoc.ml b/infer/src/bufferoverrun/absLoc.ml index 4856a1886..66492530c 100644 --- a/infer/src/bufferoverrun/absLoc.ml +++ b/infer/src/bufferoverrun/absLoc.ml @@ -66,7 +66,6 @@ module Loc = struct Mangled.equal (Pvar.get_name x) Ident.name_return | _ -> false - end module PowLoc = struct diff --git a/infer/src/bufferoverrun/arrayBlk.ml b/infer/src/bufferoverrun/arrayBlk.ml index b18d58d9a..da7c2fc89 100644 --- a/infer/src/bufferoverrun/arrayBlk.ml +++ b/infer/src/bufferoverrun/arrayBlk.ml @@ -56,7 +56,8 @@ module ArrInfo = struct let ( <= ) : lhs:t -> rhs:t -> bool = fun ~lhs ~rhs -> if phys_equal lhs rhs then true - else Itv.le ~lhs:lhs.offset ~rhs:rhs.offset && Itv.le ~lhs:lhs.size ~rhs:rhs.size + else + Itv.le ~lhs:lhs.offset ~rhs:rhs.offset && Itv.le ~lhs:lhs.size ~rhs:rhs.size && Itv.le ~lhs:lhs.stride ~rhs:rhs.stride diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index 479a83b2d..32471636c 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -271,7 +271,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct in print_debug_info instr mem output_mem ; output_mem - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Normal) (TransferFunctions) @@ -379,7 +378,6 @@ module Report = struct false ) | _ -> false - end let rec collect_instrs @@ -511,7 +509,6 @@ module Report = struct Reporting.log_error_deprecated pname ~loc:location ~ltr:trace exn in PO.ConditionSet.check_all ~report cond_set - end let compute_post : Analyzer.TransferFunctions.extras ProcData.t -> Summary.payload option = @@ -553,4 +550,3 @@ let checker : Callbacks.proc_callback_args -> Specs.summary = Summary.update_summary post summary | None -> summary - diff --git a/infer/src/bufferoverrun/bufferOverrunDomain.ml b/infer/src/bufferoverrun/bufferOverrunDomain.ml index ddcc0cb5d..38637f78d 100644 --- a/infer/src/bufferoverrun/bufferOverrunDomain.ml +++ b/infer/src/bufferoverrun/bufferOverrunDomain.ml @@ -44,7 +44,8 @@ module Val = struct let ( <= ) ~lhs ~rhs = if phys_equal lhs rhs then true - else Itv.( <= ) ~lhs:lhs.itv ~rhs:rhs.itv && PowLoc.( <= ) ~lhs:lhs.powloc ~rhs:rhs.powloc + else + Itv.( <= ) ~lhs:lhs.itv ~rhs:rhs.itv && PowLoc.( <= ) ~lhs:lhs.powloc ~rhs:rhs.powloc && ArrayBlk.( <= ) ~lhs:lhs.arrayblk ~rhs:rhs.arrayblk @@ -216,7 +217,8 @@ module Val = struct let traces_caller = List.fold symbols ~f:(fun traces symbol -> - try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces with Not_found -> traces) + try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces with Not_found -> traces + ) ~init:TraceSet.empty in let traces = TraceSet.instantiate ~traces_caller ~traces_callee:x.traces location in @@ -293,7 +295,6 @@ module Stack = struct remove temp_loc mem in List.fold temps ~init:mem ~f:remove_temp - end module Heap = struct @@ -312,7 +313,6 @@ module Heap = struct F.fprintf fmt "@[{ " ; pp_collection ~pp_item fmt (bindings m) ; F.fprintf fmt " }@]" - end include AbstractDomain.Map (Loc) (Val) @@ -355,7 +355,6 @@ module Heap = struct fun mem -> let mem = filter (fun l _ -> Loc.is_return l) mem in if is_empty mem then Val.bot else snd (choose mem) - end module AliasTarget = struct @@ -448,7 +447,6 @@ module AliasMap = struct fun temps m -> let remove_temp m temp = M.remove temp m in List.fold temps ~init:m ~f:remove_temp - end module AliasRet = struct @@ -537,7 +535,6 @@ module Alias = struct let remove_temps : Ident.t list -> astate -> astate = fun temps a -> (AliasMap.remove_temps temps (fst a), snd a) - end module MemReach = struct @@ -549,7 +546,8 @@ module MemReach = struct let ( <= ) ~lhs ~rhs = if phys_equal lhs rhs then true - else Stack.( <= ) ~lhs:lhs.stack ~rhs:rhs.stack && Heap.( <= ) ~lhs:lhs.heap ~rhs:rhs.heap + else + Stack.( <= ) ~lhs:lhs.stack ~rhs:rhs.stack && Heap.( <= ) ~lhs:lhs.heap ~rhs:rhs.heap && Alias.( <= ) ~lhs:lhs.alias ~rhs:rhs.alias @@ -672,7 +670,6 @@ module MemReach = struct let remove_temps : Ident.t list -> t -> t = fun temps m -> {m with stack= Stack.remove_temps temps m.stack; alias= Alias.remove_temps temps m.alias} - end module Mem = struct @@ -813,5 +810,4 @@ module Summary = struct fun fmt (entry_mem, exit_mem, condition_set) -> F.fprintf fmt "%a@,%a@,%a@," Mem.pp entry_mem Mem.pp exit_mem PO.ConditionSet.pp condition_set - end diff --git a/infer/src/bufferoverrun/bufferOverrunModels.ml b/infer/src/bufferoverrun/bufferOverrunModels.ml index 69b140b6c..6a46ca6c5 100644 --- a/infer/src/bufferoverrun/bufferOverrunModels.ml +++ b/infer/src/bufferoverrun/bufferOverrunModels.ml @@ -176,7 +176,6 @@ module Make (BoUtils : BufferOverrunUtils.S) = struct Sem.eval vector_exp mem |> Dom.Val.get_all_locs |> PowLoc.append_field ~fn:size_field in Dom.Mem.transform_mem ~f:(Dom.Val.plus increment) vector_size_locs mem - end module Boost = struct @@ -186,7 +185,6 @@ module Make (BoUtils : BufferOverrunUtils.S) = struct Split.std_vector ~adds_at_least_one:true vector_arg location mem in {exec; check= no_check} - end end @@ -205,7 +203,6 @@ module Make (BoUtils : BufferOverrunUtils.S) = struct Split.std_vector ~adds_at_least_one vector_arg location mem in {exec; check= no_check} - end end @@ -228,12 +225,10 @@ module Make (BoUtils : BufferOverrunUtils.S) = struct $+? any_arg $--> Boost.Split.std_vector ; -"folly" &:: "split" $ any_arg $+ any_arg $+ capt_arg_of_typ (-"std" &:: "vector") $+? capt_exp $--> Folly.Split.std_vector ] - end module TypName = struct let dispatch : typ_model ProcnameDispatcher.typ_dispatcher = ProcnameDispatcher.TypName.make_dispatcher [] - end end diff --git a/infer/src/bufferoverrun/bufferOverrunProofObligations.ml b/infer/src/bufferoverrun/bufferOverrunProofObligations.ml index 0dda2909e..94c5e1429 100644 --- a/infer/src/bufferoverrun/bufferOverrunProofObligations.ml +++ b/infer/src/bufferoverrun/bufferOverrunProofObligations.ml @@ -38,7 +38,7 @@ module AllocSizeCondition = struct `LeftSubsumesRight | `RightSubsumesLeft -> `RightSubsumesLeft - | `LeftSmallerThanRight | `RightSmallerThanLeft as cmp -> + | (`LeftSmallerThanRight | `RightSmallerThanLeft) as cmp -> let lpos = ItvPure.le_sem ItvPure.zero lhs in let rpos = ItvPure.le_sem ItvPure.zero rhs in if not (ItvPure.equal lpos rpos) then `NotComparable @@ -83,7 +83,6 @@ module AllocSizeCondition = struct let subst bound_map length = match ItvPure.subst length bound_map with NonBottom length -> Some length | Bottom -> None - end module ArrayAccessCondition = struct @@ -227,7 +226,6 @@ module ArrayAccessCondition = struct Some {idx; size} | _ -> None - end module Condition = struct @@ -290,7 +288,6 @@ module Condition = struct AllocSizeCondition.check c | ArrayAccess c -> ArrayAccessCondition.check c - end module ConditionTrace = struct @@ -352,7 +349,6 @@ module ConditionTrace = struct ValTraceSet.instantiate ~traces_caller ~traces_callee:ct.val_traces location in {ct with cond_trace= Inter (caller_pname, callee_pname, location); val_traces} - end module ConditionSet = struct @@ -482,9 +478,7 @@ module ConditionSet = struct F.pp_print_list ~pp_sep pp_cwt fmt condset ; F.fprintf fmt " }@]" ; F.fprintf fmt "@]" - end let description cond trace = F.asprintf "%a%a" Condition.pp_description cond ConditionTrace.pp_description trace - diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index 6fd7df976..42e838fe1 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -571,5 +571,4 @@ module Make (CFG : ProcCfg.S) = struct list_fold2_def ~default:Val.Itv.top ~f:add_pair formals actuals ~init:([], None) in (subst_map_of_pairs pairs, ret_alias) - end diff --git a/infer/src/bufferoverrun/bufferOverrunTrace.ml b/infer/src/bufferoverrun/bufferOverrunTrace.ml index 827db84cd..6f2654938 100644 --- a/infer/src/bufferoverrun/bufferOverrunTrace.ml +++ b/infer/src/bufferoverrun/bufferOverrunTrace.ml @@ -53,7 +53,6 @@ module BoTrace = struct fun fmt t -> let pp_sep fmt () = F.fprintf fmt " :: " in F.pp_print_list ~pp_sep pp_elem fmt t.trace - end module Set = struct @@ -90,8 +89,8 @@ module Set = struct (fun trace_caller traces -> let new_trace_caller = BoTrace.add_elem (BoTrace.Call location) trace_caller in let new_trace = BoTrace.append trace_callee new_trace_caller in - add new_trace traces) - traces_caller traces) + add new_trace traces ) + traces_caller traces ) traces_callee empty @@ -105,10 +104,9 @@ module Set = struct (fun arr_traces traces -> let new_trace_idx = BoTrace.add_elem (BoTrace.ArrAccess location) idx_traces in let new_trace = BoTrace.append new_trace_idx arr_traces in - add new_trace traces) - arr_traces traces) + add new_trace traces ) + arr_traces traces ) idx_traces empty - end include BoTrace diff --git a/infer/src/bufferoverrun/bufferOverrunUtils.ml b/infer/src/bufferoverrun/bufferOverrunUtils.ml index d21ea732f..5d4f26acc 100644 --- a/infer/src/bufferoverrun/bufferOverrunUtils.ml +++ b/infer/src/bufferoverrun/bufferOverrunUtils.ml @@ -131,7 +131,6 @@ module Make (CFG : ProcCfg.S) = struct let mem = Dom.Mem.add_heap loc arr mem in let deref_loc = Loc.of_allocsite (Sem.get_allocsite pname node inst_num alloc_num) in decl_sym_val pname tenv node location ~depth deref_loc typ mem - end module Check = struct @@ -160,6 +159,5 @@ module Make (CFG : ProcCfg.S) = struct let idx = Dom.Val.get_itv v_idx in let idx_traces = Dom.Val.get_traces v_idx in array_access ~arr ~arr_traces ~idx ~idx_traces ~is_plus:true pname location cond_set - end end diff --git a/infer/src/bufferoverrun/itv.ml b/infer/src/bufferoverrun/itv.ml index 5aa9fd33c..1b8c52311 100644 --- a/infer/src/bufferoverrun/itv.ml +++ b/infer/src/bufferoverrun/itv.ml @@ -46,7 +46,6 @@ module SymLinear = struct fun cond x y -> let merge_function k x y = if cond k x y then None else raise Exit in match merge merge_function x y with _ -> true | exception Exit -> false - end type t = int M.t [@@deriving compare] diff --git a/infer/src/checkers/BoundedCallTree.ml b/infer/src/checkers/BoundedCallTree.ml index 6d13426d1..8e5692efc 100644 --- a/infer/src/checkers/BoundedCallTree.ml +++ b/infer/src/checkers/BoundedCallTree.ml @@ -39,7 +39,7 @@ let line_range_of_pdesc pdesc = Procdesc.fold_instrs (fun acc _ instr -> let new_loc = Sil.instr_get_loc instr in - max acc new_loc.Location.line) + max acc new_loc.Location.line ) start_line pdesc in {Stacktree_j.start_line; end_line} @@ -84,7 +84,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Some callee_pdesc -> stacktree_of_pdesc callee_pdesc "proc_start" ) | Some stracktree -> - stracktree) + stracktree ) procs in stacktree_of_pdesc pdesc ~loc ~callees location_type @@ -143,7 +143,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct astate | Sil.Load _ | Store _ | Prune _ | Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> astate - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Exceptional) (TransferFunctions) @@ -183,4 +182,3 @@ let checker {Callbacks.proc_desc; tenv; get_proc_desc; summary} : Specs.summary let extras = {get_proc_desc; stacktraces} in ignore (Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras) ~initial:Domain.empty) ) ; summary - diff --git a/infer/src/checkers/IdAccessPathMapDomain.ml b/infer/src/checkers/IdAccessPathMapDomain.ml index 33856a448..6ac57da22 100644 --- a/infer/src/checkers/IdAccessPathMapDomain.ml +++ b/infer/src/checkers/IdAccessPathMapDomain.ml @@ -34,7 +34,7 @@ let ( <= ) ~lhs ~rhs = (fun id lhs_ap -> let rhs_has = IdMap.mem id rhs in if rhs_has && Config.debug_exceptions then check_invariant lhs_ap (IdMap.find id rhs) id ; - rhs_has) + rhs_has ) lhs @@ -52,7 +52,7 @@ let join astate1 astate2 = | None, Some _ -> ap2_opt | None, None -> - None) + None ) astate1 astate2 diff --git a/infer/src/checkers/Litho.ml b/infer/src/checkers/Litho.ml index 3bb44f06f..248f407db 100644 --- a/infer/src/checkers/Litho.ml +++ b/infer/src/checkers/Litho.ml @@ -111,7 +111,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct with Not_found -> astate ) | _ -> astate - end module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions) @@ -140,7 +139,7 @@ let unroll_call call astate summary = Domain.CallSet.iter (fun call -> if not (is_cycle call.receiver) then unroll_call_ call (acc', depth') - else report receiver.access_path acc' summary) + else report receiver.access_path acc' summary ) calls' with Not_found -> report receiver.access_path acc' summary in diff --git a/infer/src/checkers/LithoDomain.ml b/infer/src/checkers/LithoDomain.ml index 4bf3204e4..12a7e770a 100644 --- a/infer/src/checkers/LithoDomain.ml +++ b/infer/src/checkers/LithoDomain.ml @@ -37,7 +37,6 @@ module MethodCall = struct let pp fmt {receiver; procname} = F.fprintf fmt "%a.%a" LocalAccessPath.pp receiver Typ.Procname.pp procname - end module CallSet = AbstractDomain.FiniteSet (MethodCall) @@ -59,9 +58,8 @@ let substitute ~(f_sub: LocalAccessPath.t -> LocalAccessPath.t option) astate = let receiver = match f_sub call.receiver with Some receiver' -> receiver' | None -> call.receiver in - CallSet.add {receiver; procname} call_set_acc) + CallSet.add {receiver; procname} call_set_acc ) call_set CallSet.empty in - add access_path' call_set' acc) + add access_path' call_set' acc ) astate empty - diff --git a/infer/src/checkers/NullabilityCheck.ml b/infer/src/checkers/NullabilityCheck.ml index c394c5caa..7eafc2bb2 100644 --- a/infer/src/checkers/NullabilityCheck.ml +++ b/infer/src/checkers/NullabilityCheck.ml @@ -68,7 +68,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct found_confict || in_footprint && IssueType.equal err_name IssueType.null_dereference && Location.equal loc report_location - && Localise.error_desc_is_reportable_bucket err_desc) + && Localise.error_desc_is_reportable_bucket err_desc ) (Specs.get_err_log summary) false @@ -238,7 +238,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct if not (is_pointer_assignment proc_data.ProcData.tenv nullable_ap rhs) then (* TODO (T22426288): Undertand why the pointer derference and the pointer assignment have the same HIL representation *) - report_nullable_dereference nullable_ap call_sites proc_data loc) + report_nullable_dereference nullable_ap call_sites proc_data loc ) (longest_nullable_prefix lhs astate) ; match rhs with | HilExp.AccessPath ap -> ( @@ -271,7 +271,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct if HilExp.is_null_literal exp then assume_pnames_notnull ap astate else astate | _ -> astate - end module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions) diff --git a/infer/src/checkers/NullabilityPreanalysis.ml b/infer/src/checkers/NullabilityPreanalysis.ml index d4ab48fdd..c65c66e44 100644 --- a/infer/src/checkers/NullabilityPreanalysis.ml +++ b/infer/src/checkers/NullabilityPreanalysis.ml @@ -17,7 +17,6 @@ module FieldsAssignedInConstructors = AbstractDomain.FiniteSet (struct let pp fmt (fieldname, typ) = F.fprintf fmt "(%a, %a)" Typ.Fieldname.pp fieldname (Typ.pp_full Pp.text) typ - end) module TransferFunctions (CFG : ProcCfg.S) = struct @@ -59,7 +58,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct astate ) | _ -> astate - end (* Tracks when block variables of ObjC classes have been assigned to in constructors *) @@ -113,4 +111,3 @@ let analysis cfg tenv = let procs = Cfg.get_defined_procs cfg in let fields_assigned_in_constructor = List.fold ~f ~init:initial procs in add_nonnull_to_fields fields_assigned_in_constructor tenv - diff --git a/infer/src/checkers/NullabilitySuggest.ml b/infer/src/checkers/NullabilitySuggest.ml index 1e477b46e..3722f52e5 100644 --- a/infer/src/checkers/NullabilitySuggest.ml +++ b/infer/src/checkers/NullabilitySuggest.ml @@ -33,7 +33,6 @@ module UseDefChain = struct F.fprintf fmt "NullDefCompare(%a, %a)" Location.pp loc AccessPath.pp ap | DependsOn (loc, ap) -> F.fprintf fmt "DependsOn(%a, %a)" Location.pp loc AccessPath.pp ap - end module Domain = AbstractDomain.Map (AccessPath) (UseDefChain) @@ -101,7 +100,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | None -> astate else astate - end module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions) @@ -131,8 +129,9 @@ let make_error_trace astate ap ud = let ud' = Domain.find dep astate in let msg = F.sprintf "%s could be assigned here" (name_of ap) in let trace_elem = Errlog.make_trace_element depth loc msg [] in - Option.map (error_trace_impl (depth + 1) dep ud') ~f:(fun (_, trace) -> - (loc, trace_elem :: trace) ) + Option.map + (error_trace_impl (depth + 1) dep ud') + ~f:(fun (_, trace) -> (loc, trace_elem :: trace)) with Not_found -> None in error_trace_impl 0 ap ud @@ -212,4 +211,3 @@ let checker {Callbacks.summary; proc_desc; tenv} = | None -> L.internal_error "Analyzer failed to compute post for %a@." Typ.Procname.pp proc_name ) ; summary - diff --git a/infer/src/checkers/SimpleChecker.ml b/infer/src/checkers/SimpleChecker.ml index 52f6c6160..b693e0e10 100644 --- a/infer/src/checkers/SimpleChecker.ml +++ b/infer/src/checkers/SimpleChecker.ml @@ -59,7 +59,6 @@ module Make (Spec : Spec) : S = struct L.(die InternalError) "Stopping analysis after 1000 iterations without convergence. Make sure your domain is finite height." else widen ~prev ~next ~num_iters - end module TransferFunctions (CFG : ProcCfg.S) = struct @@ -73,9 +72,8 @@ module Make (Spec : Spec) : S = struct let pname = Procdesc.get_proc_name proc_data.ProcData.pdesc in Domain.fold (fun astate acc -> - Domain.add (Spec.exec_instr astate instr node_kind pname proc_data.ProcData.tenv) acc) + Domain.add (Spec.exec_instr astate instr node_kind pname proc_data.ProcData.tenv) acc ) astate_set Domain.empty - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Exceptional) (TransferFunctions) @@ -101,5 +99,4 @@ module Make (Spec : Spec) : S = struct in Analyzer.InvariantMap.iter do_reporting inv_map ; summary - end diff --git a/infer/src/checkers/SinkTrace.ml b/infer/src/checkers/SinkTrace.ml index 5270ea9dd..e4701e633 100644 --- a/infer/src/checkers/SinkTrace.ml +++ b/infer/src/checkers/SinkTrace.ml @@ -67,7 +67,7 @@ module Make (TraceElem : TraceElem.S) = struct List.fold ~f:(fun t_acc sink -> let callee_sink = Sink.with_callsite sink call_site in - add_sink callee_sink t_acc) + add_sink callee_sink t_acc ) ~init:empty (Sinks.elements (sinks t)) @@ -92,5 +92,4 @@ module Make (TraceElem : TraceElem.S) = struct if not (Passthroughs.is_empty p) then F.fprintf fmt " via %a" Passthroughs.pp p in F.fprintf fmt "%a%a" Sinks.pp (sinks t) pp_passthroughs_if_not_empty (passthroughs t) - end diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index c373875f2..f01c9bd96 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -108,7 +108,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct GlobalVarSet.fold (fun global acc -> if is_dangerous global then SiofTrace.add_sink (SiofTrace.make_access global loc) acc - else acc) + else acc ) globals trace in (NonBottom trace_with_non_init_globals, snd astate) @@ -173,7 +173,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct at_least_nonbottom | Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> astate - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Normal) (TransferFunctions) @@ -283,4 +282,3 @@ let checker {Callbacks.proc_desc; tenv; summary; get_procs_in_file} : Specs.summ | None -> () ) ; updated_summary - diff --git a/infer/src/checkers/SiofTrace.ml b/infer/src/checkers/SiofTrace.ml index 50e57bcb6..16a4bc4d1 100644 --- a/infer/src/checkers/SiofTrace.ml +++ b/infer/src/checkers/SiofTrace.ml @@ -20,7 +20,6 @@ module GlobalVar = struct let pp fmt v = F.fprintf fmt "%a|%a" Mangled.pp (Pvar.get_name v) Pvar.pp_translation_unit (Pvar.get_translation_unit v) - end module GlobalVarSet = PrettyPrintable.MakePPSet (GlobalVar) @@ -77,4 +76,3 @@ let trace_of_error loc gname path = Errlog.make_trace_element 0 loc (Format.asprintf "initialization of %s" gname) [] in trace_elem_of_global :: to_sink_loc_trace ~desc_of_sink ~sink_should_nest path - diff --git a/infer/src/checkers/Source.ml b/infer/src/checkers/Source.ml index 9b2ed673b..b67bd322d 100644 --- a/infer/src/checkers/Source.ml +++ b/infer/src/checkers/Source.ml @@ -59,7 +59,7 @@ module Make (Kind : Kind) = struct let site = CallSite.make (Procdesc.get_proc_name pdesc) (Procdesc.get_loc pdesc) in List.map ~f:(fun (name, typ, kind_opt) -> - (name, typ, Option.map kind_opt ~f:(fun kind -> make kind site))) + (name, typ, Option.map kind_opt ~f:(fun kind -> make kind site)) ) (Kind.get_tainted_formals pdesc tenv) diff --git a/infer/src/checkers/Stacktrace.ml b/infer/src/checkers/Stacktrace.ml index 1ed01a0bd..3c35ffd15 100644 --- a/infer/src/checkers/Stacktrace.ml +++ b/infer/src/checkers/Stacktrace.ml @@ -117,4 +117,3 @@ let of_json_file filename = | Sys_error msg | Yojson.Json_error msg -> L.(die UserError) "Could not read or parse the supplied JSON stacktrace file %s :@\n %s" filename msg - diff --git a/infer/src/checkers/Trace.ml b/infer/src/checkers/Trace.ml index d7007eaf9..34df7b77d 100644 --- a/infer/src/checkers/Trace.ml +++ b/infer/src/checkers/Trace.ml @@ -145,7 +145,7 @@ module Expander (TraceElem : TraceElem.S) = struct List.filter ~f:(fun callee_elem -> TraceElem.Kind.matches ~caller:caller_elem_kind ~callee:(TraceElem.kind callee_elem) - && not (is_recursive callee_elem seen_acc')) + && not (is_recursive callee_elem seen_acc') ) elems in (* arbitrarily pick one elem and explore it further *) @@ -160,7 +160,6 @@ module Expander (TraceElem : TraceElem.S) = struct ((elem, Passthrough.Set.empty) :: elems_passthroughs_acc, seen_acc') in fst (expand_ elem0 ([], CallSite.Set.empty)) - end module Make (Spec : Spec) = struct @@ -178,7 +177,8 @@ module Make (Spec : Spec) = struct let ( <= ) ~lhs ~rhs = if phys_equal lhs rhs then true - else Known.( <= ) ~lhs:lhs.known ~rhs:rhs.known + else + Known.( <= ) ~lhs:lhs.known ~rhs:rhs.known && Footprint.( <= ) ~lhs:lhs.footprint ~rhs:rhs.footprint && Sanitizers.( <= ) ~lhs:lhs.sanitizers ~rhs:rhs.sanitizers @@ -241,9 +241,8 @@ module Make (Spec : Spec) = struct | Some footprint_index -> IntSet.add footprint_index acc | None -> - acc) + acc ) footprint IntSet.empty - end module Sinks = Sink.Set @@ -399,7 +398,7 @@ module Make (Spec : Spec) = struct let source_site = Source.call_site path_source in filter_passthroughs_ Top_level source_site (Sink.call_site path_sink) path_passthroughs in - (filtered_passthroughs, sources_passthroughs, sinks_passthroughs)) + (filtered_passthroughs, sources_passthroughs, sinks_passthroughs) ) (get_reports ?cur_site t) @@ -426,7 +425,7 @@ module Make (Spec : Spec) = struct ~cmp:(fun passthrough1 passthrough2 -> let loc1 = CallSite.loc (Passthrough.site passthrough1) in let loc2 = CallSite.loc (Passthrough.site passthrough2) in - Int.compare loc1.Location.line loc2.Location.line) + Int.compare loc1.Location.line loc2.Location.line ) (Passthroughs.elements passthroughs) in List.fold_right ~f:trace_elem_of_passthrough sorted_passthroughs ~init:acc0 @@ -573,5 +572,4 @@ module Make (Spec : Spec) = struct let sinks = Sinks.union prev.sinks next.sinks in let passthroughs = Passthroughs.union prev.passthroughs next.passthroughs in {sources; sinks; passthroughs} - end diff --git a/infer/src/checkers/accessPathDomains.ml b/infer/src/checkers/accessPathDomains.ml index f91302402..7cf353509 100644 --- a/infer/src/checkers/accessPathDomains.ml +++ b/infer/src/checkers/accessPathDomains.ml @@ -29,7 +29,7 @@ module Set = struct not (APSet.exists (fun rhs -> not (phys_equal lhs rhs) && AccessPath.Abs.( <= ) ~lhs ~rhs) - aps)) + aps) ) aps @@ -70,5 +70,4 @@ module Set = struct in let diff_aps = APSet.diff next prev in APSet.fold abstract_access_path diff_aps APSet.empty |> join prev - end diff --git a/infer/src/checkers/accessTree.ml b/infer/src/checkers/accessTree.ml index 55022a633..372086a81 100644 --- a/infer/src/checkers/accessTree.ml +++ b/infer/src/checkers/accessTree.ml @@ -181,7 +181,8 @@ module Make (TraceDomain : AbstractDomain.WithBottom) (Config : Config) = struct let rec access_tree_lteq ((lhs_trace, lhs_tree) as lhs) ((rhs_trace, rhs_tree) as rhs) = if phys_equal lhs rhs then true - else TraceDomain.( <= ) ~lhs:lhs_trace ~rhs:rhs_trace + else + TraceDomain.( <= ) ~lhs:lhs_trace ~rhs:rhs_trace && match (lhs_tree, rhs_tree) with | Subtree lhs_subtree, Subtree rhs_subtree -> @@ -190,7 +191,7 @@ module Make (TraceDomain : AbstractDomain.WithBottom) (Config : Config) = struct try let rhs_v = AccessMap.find k rhs_subtree in access_tree_lteq lhs_v rhs_v - with Not_found -> false) + with Not_found -> false ) lhs_subtree | _, Star -> true @@ -206,7 +207,7 @@ module Make (TraceDomain : AbstractDomain.WithBottom) (Config : Config) = struct try let rhs_v = BaseMap.find k rhs in access_tree_lteq lhs_v rhs_v - with Not_found -> false) + with Not_found -> false ) lhs @@ -444,5 +445,4 @@ module PathSet (Config : Config) = struct let pp fmt tree = let collect_path acc access_path (is_mem, _) = if is_mem then access_path :: acc else acc in fold collect_path tree [] |> PrettyPrintable.pp_collection ~pp_item:AccessPath.Abs.pp fmt - end diff --git a/infer/src/checkers/addressTaken.ml b/infer/src/checkers/addressTaken.ml index 36aa045a6..46012f236 100644 --- a/infer/src/checkers/addressTaken.ml +++ b/infer/src/checkers/addressTaken.ml @@ -50,7 +50,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct List.fold ~f:add_actual_by_ref ~init:astate actuals | Sil.Store _ | Load _ | Prune _ | Nullify _ | Abstract _ | Remove_temps _ | Declare_locals _ -> astate - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Exceptional) (TransferFunctions) diff --git a/infer/src/checkers/androidFramework.ml b/infer/src/checkers/androidFramework.ml index f49699fa0..19b25fe83 100644 --- a/infer/src/checkers/androidFramework.ml +++ b/infer/src/checkers/androidFramework.ml @@ -52,4 +52,3 @@ let is_fragment tenv tname = let is_android_lib_class class_name = let class_str = Typ.Name.name class_name in String.is_prefix ~prefix:"android" class_str || String.is_prefix ~prefix:"com.android" class_str - diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index 90af966cd..30bf40361 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -59,7 +59,6 @@ module Domain = struct let is_tracked_var var (_, vstate) = match vstate with Bottom -> false | NonBottom vars -> TrackingVar.mem var vars - end module Summary = Summary.Make (struct @@ -198,7 +197,7 @@ let report_call_stack summary end_of_stack lookup_next_calls report call_site si let loc = CallSite.loc call_site in if Typ.Procname.Set.mem p visited then accu else ((p, loc) :: unseen, Typ.Procname.Set.add p visited) - with Not_found -> accu) + with Not_found -> accu ) next_calls ([], visited_pnames) in List.iter ~f:(loop fst_call_loc updated_callees (new_trace, new_stack_str)) unseen_callees @@ -211,7 +210,7 @@ let report_call_stack summary end_of_stack lookup_next_calls report call_site si let fst_call_loc = CallSite.loc fst_call_site in let start_trace = update_trace (CallSite.loc call_site) [] in loop fst_call_loc Typ.Procname.Set.empty (start_trace, "") (fst_callee_pname, fst_call_loc) - with Not_found -> ()) + with Not_found -> () ) sink_map @@ -254,18 +253,16 @@ module StandardAnnotationSpec = struct let from_annotations src_annots snk_annot = let open AnnotationSpec in { source_predicate= - (fun tenv pname -> - List.exists src_annots ~f:(fun a -> method_overrides_annot a tenv pname)) + (fun tenv pname -> List.exists src_annots ~f:(fun a -> method_overrides_annot a tenv pname)) ; sink_predicate= (fun tenv pname -> let has_annot ia = Annotations.ia_ends_with ia snk_annot.Annot.class_name in - check_attributes has_annot tenv pname) + check_attributes has_annot tenv pname ) ; sanitizer_predicate= default_sanitizer ; sink_annotation= snk_annot ; report= (fun proc_data annot_map -> report_src_snk_paths proc_data annot_map src_annots snk_annot) } - end module NoAllocationAnnotationSpec = struct @@ -282,8 +279,7 @@ module NoAllocationAnnotationSpec = struct ; sink_annotation= constructor_annot ; report= (fun proc_data annot_map -> - report_src_snk_paths proc_data annot_map [no_allocation_annot] constructor_annot) } - + report_src_snk_paths proc_data annot_map [no_allocation_annot] constructor_annot ) } end module ExpensiveAnnotationSpec = struct @@ -320,7 +316,7 @@ module ExpensiveAnnotationSpec = struct ; sink_predicate= (fun tenv pname -> let has_annot ia = Annotations.ia_ends_with ia expensive_annot.class_name in - check_attributes has_annot tenv pname || is_modeled_expensive tenv pname) + check_attributes has_annot tenv pname || is_modeled_expensive tenv pname ) ; sanitizer_predicate= default_sanitizer ; sink_annotation= expensive_annot ; report= @@ -328,8 +324,7 @@ module ExpensiveAnnotationSpec = struct let proc_name = Procdesc.get_proc_name proc_desc in if is_expensive tenv proc_name then PatternMatch.override_iter (check_expensive_subtyping_rules proc_data) tenv proc_name ; - report_src_snk_paths proc_data astate [performance_critical_annot] expensive_annot) } - + report_src_snk_paths proc_data astate [performance_critical_annot] expensive_annot ) } end (* parse user-defined specs from .inferconfig *) @@ -406,7 +401,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct if spec.sink_predicate tenv callee_pname && not (spec.sanitizer_predicate tenv caller_pname) then Domain.add_call_site spec.sink_annotation callee_pname call_site astate - else astate) + else astate ) annot_specs @@ -421,7 +416,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct in AnnotReachabilityDomain.fold (fun annot sink_map astate -> - AnnotReachabilityDomain.SinkMap.fold (add_call_site annot) sink_map astate) + AnnotReachabilityDomain.SinkMap.fold (add_call_site annot) sink_map astate ) callee_call_map astate @@ -445,7 +440,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct L.(die InternalError) "Expecting a return identifier" | _ -> astate - end module Analyzer = AbstractInterpreter.Make (ProcCfg.Exceptional) (TransferFunctions) diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index be7540eea..3c2872d3a 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -157,7 +157,6 @@ module MakeDF (St : DFStateType) : DF with type state = St.t = struct with Not_found -> Dead_state in transitions - end (* MakeDF *) @@ -186,4 +185,3 @@ let callback_test_dataflow {Callbacks.proc_desc; tenv; summary} = in List.iter ~f:do_node (Procdesc.get_nodes proc_desc) ; summary - diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 60126a99d..50591833a 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -49,7 +49,7 @@ let callback_fragment_retains_view_java pname_java {Callbacks.proc_desc; summary List.iter ~f:(fun (fname, fld_typ, _) -> if not (Typ.Fieldname.Set.mem fname fields_nullified) then - report_error (Typ.mk (Tstruct class_typename)) fname fld_typ summary proc_desc) + report_error (Typ.mk (Tstruct class_typename)) fname fld_typ summary proc_desc ) declared_view_fields | _ -> () diff --git a/infer/src/checkers/idenv.ml b/infer/src/checkers/idenv.ml index e33e3e673..108a1c9c2 100644 --- a/infer/src/checkers/idenv.ml +++ b/infer/src/checkers/idenv.ml @@ -52,4 +52,3 @@ let expand_expr_temps idenv node exp_ = (** Return true if the expression is a temporary variable introduced by the front-end. *) let exp_is_temp idenv e = match expand_expr idenv e with Exp.Lvar pvar -> Pvar.is_frontend_tmp pvar | _ -> false - diff --git a/infer/src/checkers/immutableChecker.ml b/infer/src/checkers/immutableChecker.ml index bcd6e5433..44683ea50 100644 --- a/infer/src/checkers/immutableChecker.ml +++ b/infer/src/checkers/immutableChecker.ml @@ -24,7 +24,7 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l let in_casts expected given = List.exists ~f:(fun (x, y) -> - String.equal (Typ.Name.name expected) x && String.equal (Typ.Name.name given) y) + String.equal (Typ.Name.name expected) x && String.equal (Typ.Name.name given) y ) casts in match @@ -48,4 +48,3 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l let callback_check_immutable_cast ({Callbacks.tenv} as args) = Eradicate.callback_check_return_type (check_immutable_cast tenv) args - diff --git a/infer/src/checkers/liveness.ml b/infer/src/checkers/liveness.ml index b7b038408..1d8212964 100644 --- a/infer/src/checkers/liveness.ml +++ b/infer/src/checkers/liveness.ml @@ -75,7 +75,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct |> exp_add_live call_exp |> add_live_actuals actuals call_exp | Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> astate - end module CFG = ProcCfg.OneInstrPerNode (ProcCfg.Backward (ProcCfg.Exceptional)) @@ -160,4 +159,3 @@ let checker {Callbacks.tenv; summary; proc_desc} : Specs.summary = in List.iter (CFG.nodes cfg) ~f:report_on_node ; summary - diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 5e047ef6f..c7a6462c5 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -201,4 +201,3 @@ let callback_printf_args {Callbacks.tenv; proc_desc; summary} : Specs.summary = (fun n i -> check_printf_args_ok tenv n i proc_name proc_desc summary) proc_desc ; summary - diff --git a/infer/src/checkers/registerCheckers.ml b/infer/src/checkers/registerCheckers.ml index 4bef55f14..6e68b28bc 100644 --- a/infer/src/checkers/registerCheckers.ml +++ b/infer/src/checkers/registerCheckers.ml @@ -134,4 +134,3 @@ let pp_checker fmt {name; callbacks} = F.fprintf fmt "%s (%a)" name (Pp.seq ~sep:", " (Pp.to_string ~f:Config.string_of_language)) langs_of_callbacks - diff --git a/infer/src/checkers/uninit.ml b/infer/src/checkers/uninit.ml index d5e0c8833..41dc74cf0 100644 --- a/infer/src/checkers/uninit.ml +++ b/infer/src/checkers/uninit.ml @@ -107,7 +107,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct && not (is_struct_field_passed_by_ref call t al idx) -> report_intra ((var, t), al) loc (snd extras) | _ -> - ()) + () ) actuals @@ -142,7 +142,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | _ -> t in - ((v', t'), a)) + ((v', t'), a) ) initialized_fields in match base with @@ -265,14 +265,13 @@ module TransferFunctions (CFG : ProcCfg.S) = struct (* remove the captured variables of a block/lambda *) List.fold ~f:(fun acc' (base, _) -> D.remove (base, []) acc') ~init:acc apl | _ -> - acc) + acc ) ~init:astate.uninit_vars actuals in report_on_function_params call pdesc tenv uninit_vars actuals loc extras ; {astate with uninit_vars} | Call _ | Assume _ -> astate - end module CFG = ProcCfg.OneInstrPerNode (ProcCfg.Normal) @@ -301,7 +300,7 @@ let get_locals cfg tenv pdesc = | Typ.Tarray (t', _, _) -> (fst base_ap, [AccessPath.ArrayAccess (t', [])]) :: acc | _ -> - base_ap :: acc) + base_ap :: acc ) ~init:[] (Procdesc.get_locals cfg) @@ -332,4 +331,3 @@ let checker {Callbacks.tenv; summary; proc_desc} : Specs.summary = (Procdesc.get_proc_name proc_desc) ; summary ) else summary - diff --git a/infer/src/checkers/uninitDomain.ml b/infer/src/checkers/uninitDomain.ml index 78eb0d1af..c1ef3f248 100644 --- a/infer/src/checkers/uninitDomain.ml +++ b/infer/src/checkers/uninitDomain.ml @@ -41,7 +41,8 @@ struct let ( <= ) ~lhs:({uninit_vars= lhs_uv; aliased_vars= lhs_av; prepost= lhs_pp} as lhs) ~rhs:({uninit_vars= rhs_uv; aliased_vars= rhs_av; prepost= rhs_pp} as rhs) = if phys_equal lhs rhs then true - else Domain1.( <= ) ~lhs:lhs_uv ~rhs:rhs_uv && Domain2.( <= ) ~lhs:lhs_av ~rhs:rhs_av + else + Domain1.( <= ) ~lhs:lhs_uv ~rhs:rhs_uv && Domain2.( <= ) ~lhs:lhs_av ~rhs:rhs_av && Domain3.( <= ) ~lhs:(fst lhs_pp) ~rhs:(fst rhs_pp) && Domain3.( <= ) ~lhs:(snd lhs_pp) ~rhs:(snd rhs_pp) @@ -69,5 +70,4 @@ struct let pp fmt {uninit_vars= uv; aliased_vars= av; prepost= pp} = F.fprintf fmt "@\n uninit_vars: %a @\n aliased_vars: %a @\n prepost: (%a, %a)" Domain1.pp uv Domain2.pp av Domain3.pp (fst pp) Domain3.pp (snd pp) - end diff --git a/infer/src/clang/CLintersContext.ml b/infer/src/clang/CLintersContext.ml index f0db5c16a..ece53fd55 100644 --- a/infer/src/clang/CLintersContext.ml +++ b/infer/src/clang/CLintersContext.ml @@ -48,4 +48,3 @@ let update_current_method context decl = { context with current_method= Some decl ; parent_methods= add_parent_method context.current_method context.parent_methods } - diff --git a/infer/src/clang/CProcname.ml b/infer/src/clang/CProcname.ml index be100549e..b7ec328a5 100644 --- a/infer/src/clang/CProcname.ml +++ b/infer/src/clang/CProcname.ml @@ -187,7 +187,6 @@ module NoAstDecl = struct let objc_method_of_string_kind class_name method_name method_kind = mk_objc_method class_name method_name method_kind - end let objc_method_procname ?tenv decl_info method_name mdi = @@ -239,4 +238,3 @@ let from_decl_for_linters translation_unit_context method_decl = objc_method_procname decl_info method_name mdi | _ -> from_decl translation_unit_context method_decl - diff --git a/infer/src/clang/CTLExceptions.ml b/infer/src/clang/CTLExceptions.ml index 81138df5a..80e642f4d 100644 --- a/infer/src/clang/CTLExceptions.ml +++ b/infer/src/clang/CTLExceptions.ml @@ -36,4 +36,3 @@ let () = Some (Format.sprintf "ALFileException: %s" (hum_string_of_exc_info exc_info)) | _ -> None ) - diff --git a/infer/src/clang/CTLParserHelper.ml b/infer/src/clang/CTLParserHelper.ml index 315904a33..e926ce9f4 100644 --- a/infer/src/clang/CTLParserHelper.ml +++ b/infer/src/clang/CTLParserHelper.ml @@ -36,4 +36,3 @@ let validate_al_files () = Ok () | _ as errors -> Error (Yojson.Basic.to_string (`List errors)) - diff --git a/infer/src/clang/CType.ml b/infer/src/clang/CType.ml index c6e72af77..cb6415f2c 100644 --- a/infer/src/clang/CType.ml +++ b/infer/src/clang/CType.ml @@ -88,7 +88,6 @@ let get_name_from_type_pointer custom_type_pointer = | _ -> assert false - (* let rec get_type_list nn ll = match ll with diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index 9370a3808..e1969abfe 100644 --- a/infer/src/clang/CType_decl.ml +++ b/infer/src/clang/CType_decl.ml @@ -331,4 +331,3 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info = expr_info.Clang_ast_t.ei_qual_type in qual_type_to_sil_type tenv qt - diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index 139fe8f39..86d70a755 100644 --- a/infer/src/clang/Capture.ml +++ b/infer/src/clang/Capture.ml @@ -180,4 +180,3 @@ let capture clang_cmd = let command_to_run = ClangCommand.command_to_run clang_cmd in L.(debug Capture Quiet) "Running non-cc command without capture: %s@\n" command_to_run ; run_clang command_to_run Utils.consume_in - diff --git a/infer/src/clang/CiOSVersionNumbers.ml b/infer/src/clang/CiOSVersionNumbers.ml index 42e2fa6e2..b2c395a9e 100644 --- a/infer/src/clang/CiOSVersionNumbers.ml +++ b/infer/src/clang/CiOSVersionNumbers.ml @@ -79,4 +79,3 @@ let pp_diff_of_version_opt fmt (expected, actual) = let option_to_string opt = Option.value ~default:"" opt in Format.fprintf fmt "Expected: [%s] Found: [%s]" (option_to_string expected) (option_to_string actual) - diff --git a/infer/src/clang/ClangCommand.ml b/infer/src/clang/ClangCommand.ml index 28d05a471..024743750 100644 --- a/infer/src/clang/ClangCommand.ml +++ b/infer/src/clang/ClangCommand.ml @@ -31,7 +31,7 @@ let value_of_argv_option argv opt_name = else if String.equal opt_name prev_arg then Some arg else None in - (arg, result')) + (arg, result') ) ~init:("", None) argv |> snd diff --git a/infer/src/clang/ClangPointers.ml b/infer/src/clang/ClangPointers.ml index 96023c932..98f06138a 100644 --- a/infer/src/clang/ClangPointers.ml +++ b/infer/src/clang/ClangPointers.ml @@ -113,4 +113,3 @@ let populate_all_tables top_decl = (* populate caches *) visit_ast ~visit_decl:process_decl ~visit_stmt:add_stmt_to_cache ~visit_type:add_type_to_cache ~visit_src_loc:complete_source_location top_decl - diff --git a/infer/src/clang/ClangWrapper.ml b/infer/src/clang/ClangWrapper.ml index f8a785a11..bc2156568 100644 --- a/infer/src/clang/ClangWrapper.ml +++ b/infer/src/clang/ClangWrapper.ml @@ -159,4 +159,3 @@ let exe ~prog ~args = "WARNING: `clang -### ` returned an empty set of commands to run and no error. Will run the original command directly:@\n %s@\n" (String.concat ~sep:" " @@ prog :: args) ; Process.create_process_and_wait ~prog ~args ) - diff --git a/infer/src/clang/ComponentKit.ml b/infer/src/clang/ComponentKit.ml index 56fd3bf29..4d757eafa 100644 --- a/infer/src/clang/ComponentKit.ml +++ b/infer/src/clang/ComponentKit.ml @@ -291,7 +291,7 @@ let component_with_multiple_factory_methods_advice context an = Some "Instead, always expose all parameters in a single designated initializer and document which are optional." ; doc_url= None - ; loc= CFrontend_checkers.location_from_decl context meth_decl }) + ; loc= CFrontend_checkers.location_from_decl context meth_decl } ) (List.drop factory_methods 1) | _ -> assert false @@ -408,7 +408,7 @@ let component_file_line_count_info (context: CLintersContext.context) dec = ; description= "Line count analytics" ; suggestion= None ; doc_url= None - ; loc= {Location.line= i; Location.col= 0; Location.file= source_file} }) + ; loc= {Location.line= i; Location.col= 0; Location.file= source_file} } ) (List.range 1 line_count ~start:`inclusive ~stop:`inclusive) | _ -> [] @@ -462,4 +462,3 @@ let component_file_cyclomatic_complexity_info (context: CLintersContext.context) ; loc } | _ -> None - diff --git a/infer/src/clang/ast_expressions.ml b/infer/src/clang/ast_expressions.ml index 2a6bb2dc2..4d694b5f3 100644 --- a/infer/src/clang/ast_expressions.ml +++ b/infer/src/clang/ast_expressions.ml @@ -229,4 +229,3 @@ let trans_with_conditional stmt_info expr_info stmt_list = let trans_negation_with_conditional stmt_info expr_info stmt_list = let stmt_list_cond = stmt_list @ [create_integer_literal "0"] @ [create_integer_literal "1"] in Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info) - diff --git a/infer/src/clang/cArithmetic_trans.ml b/infer/src/clang/cArithmetic_trans.ml index 4b83b8333..2a37d001f 100644 --- a/infer/src/clang/cArithmetic_trans.ml +++ b/infer/src/clang/cArithmetic_trans.ml @@ -251,4 +251,3 @@ let sil_const_plus_one const = Exp.Const (Const.Cint (IntLit.add n IntLit.one)) | _ -> Exp.BinOp (Binop.PlusA, const, Exp.Const (Const.Cint IntLit.one)) - diff --git a/infer/src/clang/cAst_utils.ml b/infer/src/clang/cAst_utils.ml index 94c66e754..4664772db 100644 --- a/infer/src/clang/cAst_utils.ml +++ b/infer/src/clang/cAst_utils.ml @@ -111,14 +111,14 @@ let update_enum_map enum_constant_pointer sil_exp = in let enum_map_value = (predecessor_pointer_opt, Some sil_exp) in CFrontend_config.enum_map - := ClangPointers.Map.add !CFrontend_config.enum_map ~key:enum_constant_pointer + := ClangPointers.Map.set !CFrontend_config.enum_map ~key:enum_constant_pointer ~data:enum_map_value let add_enum_constant enum_constant_pointer predecessor_pointer_opt = let enum_map_value = (predecessor_pointer_opt, None) in CFrontend_config.enum_map - := ClangPointers.Map.add !CFrontend_config.enum_map ~key:enum_constant_pointer + := ClangPointers.Map.set !CFrontend_config.enum_map ~key:enum_constant_pointer ~data:enum_map_value @@ -594,4 +594,3 @@ let get_superclass_curr_class_objc_from_decl (decl: Clang_ast_t.decl) = Logging.die InternalError "Expected to be called only with ObjCInterfaceDecl, ObjCImplementationDecl, ObjCCategoryDecl or ObjCCategoryImplDecl, but got %s" (Clang_ast_proj.get_decl_kind_string decl) - diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 716539aa2..779559fc4 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -164,4 +164,3 @@ let rec get_outer_procname context = get_outer_procname outer_context | None -> Procdesc.get_proc_name context.procdesc - diff --git a/infer/src/clang/cEnum_decl.ml b/infer/src/clang/cEnum_decl.ml index 03d78f218..8448c4661 100644 --- a/infer/src/clang/cEnum_decl.ml +++ b/infer/src/clang/cEnum_decl.ml @@ -56,4 +56,3 @@ let enum_decl decl = sil_desc | _ -> assert false - diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 01a7b86f8..75a823457 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -121,4 +121,3 @@ let modelled_field class_name_info = else res in List.fold ~f:modelled_field_in_class ~init:[] modelled_fields_in_classes - diff --git a/infer/src/clang/cFrontend_checkers.ml b/infer/src/clang/cFrontend_checkers.ml index f0012c532..b5d74e594 100644 --- a/infer/src/clang/cFrontend_checkers.ml +++ b/infer/src/clang/cFrontend_checkers.ml @@ -157,4 +157,3 @@ let class_name node = "" ) | _ -> "" - diff --git a/infer/src/clang/cFrontend_checkers_main.ml b/infer/src/clang/cFrontend_checkers_main.ml index d1c15075a..bcc18cf9f 100644 --- a/infer/src/clang/cFrontend_checkers_main.ml +++ b/infer/src/clang/cFrontend_checkers_main.ml @@ -274,7 +274,7 @@ let rec do_frontend_checks_stmt (context: CLintersContext.context) List.iter ~f:(fun (cxt, stmts) -> List.iter ~f:(do_all_checks_on_stmts cxt map_active) stmts ; - call_tableaux cxt an map_active) + call_tableaux cxt an map_active ) stmt_context_list @@ -291,7 +291,7 @@ and do_frontend_checks_via_transition context map_active an trans = | Ctl_parser_types.Decl d -> do_frontend_checks_decl context map_active d | Ctl_parser_types.Stmt st -> - do_frontend_checks_stmt context map_active st) + do_frontend_checks_stmt context map_active st ) succs @@ -361,7 +361,7 @@ let find_linters_files () = let linters_files = - List.dedup ~compare:String.compare (find_linters_files () @ Config.linters_def_file) + List.dedup_and_sort ~compare:String.compare (find_linters_files () @ Config.linters_def_file) let do_frontend_checks (trans_unit_ctx: CFrontend_config.translation_unit_context) ast = diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index 85b7c9b74..5b5b178f3 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -32,11 +32,12 @@ let protect ~f ~recover ~pp_context = (* FIXME(t21762295): we do not expect this to happen but it does *) log_and_recover ~print:true "Unexpected SelfClassException %a@\n" Typ.Name.pp class_name | exn -> - let trace = Exn.backtrace () in + let trace = Backtrace.get () in reraise_if exn ~f:(fun () -> L.internal_error "%a: %a@\n%!" pp_context () Exn.pp exn ; not Config.keep_going ) ; - log_and_recover ~print:true "Frontend error: %a@\nBacktrace:@\n%s" Exn.pp exn trace + log_and_recover ~print:true "Frontend error: %a@\nBacktrace:@\n%s" Exn.pp exn + (Backtrace.to_string trace) module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFrontend = struct @@ -357,8 +358,10 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron in let method_decls, no_method_decls = List.partition_tf ~f:is_method_decl decl_list in List.iter ~f:translate no_method_decls ; - protect ~f:(fun () -> ignore (CType_decl.add_types_from_decl_to_tenv tenv dec)) - ~recover:Fn.id ~pp_context:(fun fmt () -> + protect + ~f:(fun () -> ignore (CType_decl.add_types_from_decl_to_tenv tenv dec)) + ~recover:Fn.id + ~pp_context:(fun fmt () -> F.fprintf fmt "Error adding types from decl '%a'" (Pp.to_string ~f:Clang_ast_j.string_of_decl) dec ) ; @@ -378,5 +381,4 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron List.iter ~f:translate decl_list | _ -> () - end diff --git a/infer/src/clang/cFrontend_errors.ml b/infer/src/clang/cFrontend_errors.ml index 9ad2cb38a..1ba48dde3 100644 --- a/infer/src/clang/cFrontend_errors.ml +++ b/infer/src/clang/cFrontend_errors.ml @@ -379,7 +379,7 @@ let build_macros_map_ macros init_map = "Macro '%s' has more than one definition." (ALVar.formula_id_to_string key) else ALVar.FormulaIdMap.add key (false, params, formula) map' | _ -> - map') + map' ) ~init:init_map macros in macros_map @@ -398,7 +398,7 @@ let build_paths_map paths = match data with path_name, paths -> if ALVar.VarMap.mem path_name map' then L.(die ExternalError) "Path '%s' has more than one definition." path_name - else ALVar.VarMap.add path_name paths map') + else ALVar.VarMap.add path_name paths map' ) ~init:init_map paths in paths_map @@ -423,7 +423,7 @@ let expand_checkers macro_map path_map checkers = L.(debug Linters Medium) " -Expanding path@\n" ; CPath (black_or_white_list, expand_path paths path_map) :: defs | cl -> - cl :: defs) + cl :: defs ) ~init:[] c.definitions in {c with definitions= exp_defs} @@ -484,8 +484,8 @@ let invoke_set_of_hard_coded_checkers_an context (an: Ctl_parser_types.ast_node) List.iter ~f:(fun issue_desc -> if CIssue.should_run_check issue_desc.CIssue.mode then - fill_issue_desc_info_and_log context an issue_desc None issue_desc.CIssue.loc) - issue_desc_list) + fill_issue_desc_info_and_log context an issue_desc None issue_desc.CIssue.loc ) + issue_desc_list ) checkers @@ -499,7 +499,7 @@ let invoke_set_of_parsed_checkers_an parsed_linters context (an: Ctl_parser_type () | Some witness -> let loc = CFrontend_checkers.location_from_an context witness in - fill_issue_desc_info_and_log context witness linter.issue_desc linter.def_file loc) + fill_issue_desc_info_and_log context witness linter.issue_desc linter.def_file loc ) parsed_linters @@ -514,4 +514,3 @@ let invoke_set_of_checkers_on_node context an = if not CFrontend_config.tableaux_evaluation then invoke_set_of_parsed_checkers_an !parsed_linters context an ) ; if Config.default_linters then invoke_set_of_hard_coded_checkers_an context an - diff --git a/infer/src/clang/cGeneral_utils.ml b/infer/src/clang/cGeneral_utils.ml index 197dcf358..2790d0c4e 100644 --- a/infer/src/clang/cGeneral_utils.ml +++ b/infer/src/clang/cGeneral_utils.ml @@ -174,7 +174,7 @@ let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname o if var_decl_info.Clang_ast_t.vdi_is_static_local then Some (fun name_string _ -> - Mangled.from_string (Typ.Procname.to_string outer_procname ^ "_" ^ name_string)) + Mangled.from_string (Typ.Procname.to_string outer_procname ^ "_" ^ name_string) ) else None in mk_sil_global_var trans_unit_ctx ?mk_name named_decl_info var_decl_info qt @@ -191,4 +191,3 @@ let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname o CAst_utils.get_qualified_name named_decl_info |> QualifiedCppName.to_qual_string in Pvar.mk (Mangled.from_string name_string) procname - diff --git a/infer/src/clang/cIssue.ml b/infer/src/clang/cIssue.ml index 4916efaa6..51123e1c8 100644 --- a/infer/src/clang/cIssue.ml +++ b/infer/src/clang/cIssue.ml @@ -47,4 +47,3 @@ let should_run_check mode = true | Off -> Config.debug_mode || Config.debug_exceptions || not Config.filtering - diff --git a/infer/src/clang/cLocation.ml b/infer/src/clang/cLocation.ml index dda6c9b83..6b0d9e844 100644 --- a/infer/src/clang/cLocation.ml +++ b/infer/src/clang/cLocation.ml @@ -98,4 +98,3 @@ let get_sil_location_from_range trans_unit_ctx source_range prefer_first = let get_sil_location stmt_info context = let sloc1, _ = stmt_info.Clang_ast_t.si_source_range in clang_to_sil_location context.CContext.translation_unit_context sloc1 - diff --git a/infer/src/clang/cMethod_signature.ml b/infer/src/clang/cMethod_signature.ml index 851adcaf7..4452d4177 100644 --- a/infer/src/clang/cMethod_signature.ml +++ b/infer/src/clang/cMethod_signature.ml @@ -98,4 +98,3 @@ let ms_to_string ms = ms.args ^ "->" ^ Clang_ast_extend.type_ptr_to_string ms.ret_type.Clang_ast_t.qt_type_ptr ^ " " ^ Clang_ast_j.string_of_source_range ms.loc - diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 3c8037d70..8b82259af 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -692,4 +692,3 @@ let get_captures_from_cpp_lambda dec = cxx_rdi.xrdi_lambda_captures | _ -> assert false - diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index e2e31c4ec..d43bdb0ac 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -673,7 +673,7 @@ let type_ptr_equal_type type_ptr type_str = abs_ctype' | None -> let abs_ctype' = parse_type_string type_str in - parsed_type_map := String.Map.add !parsed_type_map ~key:type_str ~data:abs_ctype' ; + parsed_type_map := String.Map.set !parsed_type_map ~key:type_str ~data:abs_ctype' ; abs_ctype' in match CAst_utils.get_type type_ptr with diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index d150e5a37..552f07275 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -536,7 +536,6 @@ module Debug = struct ~f:(fun cluster_id tree -> Buffer.add_string buf (dotty_of_tree cluster_id tree ^ "\n")) (List.rev t.forest) ; Printf.sprintf "digraph CTL_Evaluation {\n%s\n}\n" (buffer_content buf) - end end end @@ -561,7 +560,7 @@ let print_checker c = match paths_keyword with `WhitelistPath -> "whitelist_path" | _ -> "blacklist_path" in let paths_str = String.concat ~sep:"," (List.map ~f:ALVar.alexp_to_string paths) in - L.(debug Linters Medium) " %s= @\n %s@\n@\n" keyword paths_str) + L.(debug Linters Medium) " %s= @\n %s@\n@\n" keyword paths_str ) c.definitions ; L.(debug Linters Medium) "@\n-------------------- @\n" @@ -1071,7 +1070,6 @@ let rec eval_Atomic pred_name_ args an lcxt = | _ -> L.(die ExternalError) "Undefined Predicate or wrong set of arguments: '%s'" pred_name - and eval_AND an lcxt f1 f2 = match eval_formula f1 an lcxt with | Some witness1 -> ( @@ -1083,7 +1081,6 @@ and eval_AND an lcxt f1 f2 = | None (* we short-circuit the AND evaluation *) -> None - and eval_OR an lcxt f1 f2 = choose_witness_opt (eval_formula f1 an lcxt) (eval_formula f2 an lcxt) and eval_Implies an lcxt f1 f2 = @@ -1091,7 +1088,6 @@ and eval_Implies an lcxt f1 f2 = let witness2 = eval_formula f2 an lcxt in choose_witness_opt witness1 witness2 - (* an, lcxt |= EF phi <=> an, lcxt |= phi or exists an' in Successors(st): an', lcxt |= EF phi @@ -1112,7 +1108,6 @@ and eval_EF phi an lcxt trans = List.fold_left (Ctl_parser_types.get_direct_successor_nodes an) ~init:witness_opt ~f: (fun acc node -> choose_witness_opt (eval_EF phi node lcxt trans) acc ) - (* an, lcxt |= EX phi <=> exists an' in Successors(st): an', lcxt |= phi That is: a (an, lcxt) satifies EX phi if and only if @@ -1137,7 +1132,6 @@ and eval_EX phi an lcxt trans = | _ -> witness_opt - (* an, lcxt |= E(phi1 U phi2) evaluated using the equivalence an, lcxt |= E(phi1 U phi2) <=> an, lcxt |= phi2 or (phi1 and EX(E(phi1 U phi2))) @@ -1148,7 +1142,6 @@ and eval_EU phi1 phi2 an lcxt trans = let f = Or (phi2, And (phi1, EX (trans, EU (trans, phi1, phi2)))) in eval_formula f an lcxt - (* an |= A(phi1 U phi2) evaluated using the equivalence an |= A(phi1 U phi2) <=> an |= phi2 or (phi1 and AX(A(phi1 U phi2))) @@ -1158,7 +1151,6 @@ and eval_AU phi1 phi2 an lcxt trans = let f = Or (phi2, And (phi1, AX (trans, AU (trans, phi1, phi2)))) in eval_formula f an lcxt - (* an, lcxt |= InNode[node_type_list] phi <=> an is a node of type in node_type_list and an satifies phi *) @@ -1176,7 +1168,6 @@ and in_node node_type_list phi an lctx = List.fold_left node_type_list ~init:None ~f:(fun acc node -> choose_witness_opt (holds_for_one_node node) acc ) - (* Intuitive meaning: (an,lcxt) satifies EH[Classes] phi if the node an is among the declaration specified by the list Classes and there exists a super class in its hierarchy whose declaration satisfy phi. @@ -1189,7 +1180,6 @@ and eval_EH classes phi an lcxt = let f = ET (classes, None, EX (Some Super, EF (Some Super, phi))) in eval_formula f an lcxt - (* an, lcxt |= ET[T][->l]phi <=> eventually we reach a node an' such that an' is among the types defined in T and: @@ -1210,7 +1200,6 @@ and eval_ET tl trs phi an lcxt = in eval_formula f an lcxt - (* Formulas are evaluated on a AST node an and a linter context lcxt *) and eval_formula f an lcxt : Ctl_parser_types.ast_node option = debug_eval_begin (debug_create_payload an f lcxt) ; diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 8f1eb91b9..5bc376328 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -408,7 +408,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let tenv = trans_state.context.CContext.tenv in let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with - | `SizeOf | `SizeOfWithSize _ as size -> + | (`SizeOf | `SizeOfWithSize _) as size -> let qt_opt = CAst_utils.type_from_unary_expr_or_type_trait_expr_info unary_expr_or_type_trait_expr_info @@ -1705,7 +1705,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s in List.iter ~f:(fun n' -> - Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] []) + Procdesc.node_set_succs_exn context.procdesc n' [switch_special_cond_node] [] ) res_trans_cond_tmp.leaf_nodes ; let root_nodes = if res_trans_cond_tmp.root_nodes <> [] then res_trans_cond_tmp.root_nodes @@ -3465,5 +3465,4 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let instrs_trans = List.map ~f:get_custom_stmt_trans instrs in let res_trans = exec_trans_instrs trans_state' instrs_trans in res_trans.root_nodes - end diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index 191a0ed08..642267406 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -116,7 +116,6 @@ module Nodes = struct true | `Minus | `Not | `LNot | `Real | `Imag | `Extension | `Coawait -> false - end module GotoLabel = struct @@ -126,7 +125,6 @@ module GotoLabel = struct let new_node = Nodes.create_node (Procdesc.Node.Skip_node node_name) [] sil_loc context in Hashtbl.add context.CContext.label_map label new_node ; new_node - end type continuation = @@ -269,7 +267,6 @@ module PriorityNode = struct else (* The node is created by the parent. We just pass back nodes/leafs params *) {res_state with exps= []} - end module Loops = struct @@ -303,7 +300,6 @@ module Loops = struct let get_cond loop_kind = match loop_kind with For (_, _, cond, _, _) | While (_, cond, _) | DoWhile (cond, _) -> cond - end module Scope = struct @@ -311,7 +307,7 @@ module Scope = struct let add_scope_vars_to_destroy var_map stmt_info vars = let ptr = stmt_info.Clang_ast_t.si_pointer in - StmtMap.add var_map ~key:ptr ~data:vars + StmtMap.set var_map ~key:ptr ~data:vars let rec compute_vars vars_in_scope break_count var_map stmt = @@ -365,7 +361,6 @@ module Scope = struct let compute_vars_to_destroy body = List.fold_left ~f:(compute_vars [] 0) ~init:StmtMap.empty [body] - end (** This function handles ObjC new/alloc and C++ new calls *) @@ -683,7 +678,6 @@ module Self = struct let is_var_self pvar is_objc_method = let is_self = String.equal (Mangled.to_string (Pvar.get_name pvar)) CFrontend_config.self in is_self && is_objc_method - end let rec is_method_call s = @@ -737,7 +731,6 @@ let is_logical_negation_of_int tenv ei uoi = let is_block_enumerate_function mei = String.equal mei.Clang_ast_t.omei_selector CFrontend_config.enumerateObjectsUsingBlock - (* (** Similar to extract_item_from_singleton but for option type *) let extract_item_from_option op warning_string = diff --git a/infer/src/clang/cType_to_sil_type.ml b/infer/src/clang/cType_to_sil_type.ml index 0b7b8d8a9..fd542dd3f 100644 --- a/infer/src/clang/cType_to_sil_type.ml +++ b/infer/src/clang/cType_to_sil_type.ml @@ -94,7 +94,6 @@ let rec build_array_type translate_decl tenv (qual_type: Clang_ast_t.qual_type) let stride = Option.map ~f:IntLit.of_int stride_opt in Typ.Tarray (array_type, length, stride) - and type_desc_of_attr_type translate_decl tenv type_info attr_info = match type_info.Clang_ast_t.ti_desugared_type with | Some type_ptr -> ( @@ -107,7 +106,6 @@ and type_desc_of_attr_type translate_decl tenv type_info attr_info = | None -> Typ.Tvoid - and type_desc_of_c_type translate_decl tenv c_type : Typ.desc = let open Clang_ast_t in match c_type with @@ -165,7 +163,6 @@ and type_desc_of_c_type translate_decl tenv c_type : Typ.desc = | None -> Typ.Tvoid - and decl_ptr_to_type_desc translate_decl tenv decl_ptr : Typ.desc = let open Clang_ast_t in let typ = Clang_ast_extend.DeclPtr decl_ptr in @@ -192,7 +189,6 @@ and decl_ptr_to_type_desc translate_decl tenv decl_ptr : Typ.desc = (Clang_ast_j.string_of_pointer decl_ptr) ; Typ.Tvoid - and clang_type_ptr_to_type_desc translate_decl tenv type_ptr = try Clang_ast_extend.TypePointerMap.find type_ptr !CFrontend_config.sil_types_map with Not_found -> @@ -204,7 +200,6 @@ and clang_type_ptr_to_type_desc translate_decl tenv type_ptr = | _ -> Typ.Tvoid - and type_ptr_to_type_desc translate_decl tenv type_ptr : Typ.desc = match type_ptr with | Clang_ast_types.TypePtr.Ptr _ -> @@ -226,9 +221,7 @@ and type_ptr_to_type_desc translate_decl tenv type_ptr : Typ.desc = | _ -> L.(die InternalError) "unknown variant for type_ptr" - and qual_type_to_sil_type translate_decl tenv qual_type = let desc = type_ptr_to_type_desc translate_decl tenv qual_type.Clang_ast_t.qt_type_ptr in let quals = Typ.mk_type_quals ~is_const:qual_type.Clang_ast_t.qt_is_const () in Typ.mk ~quals desc - diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index f53885aab..70fd4c05b 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -130,4 +130,3 @@ let captured_vars_from_block_info context cvl = assert false in List.fold_right ~f:sil_var_of_captured_var cvl ~init:[] - diff --git a/infer/src/clang/clang_ast_extend.ml b/infer/src/clang/clang_ast_extend.ml index ae31d3ff0..87db0a1b1 100644 --- a/infer/src/clang/clang_ast_extend.ml +++ b/infer/src/clang/clang_ast_extend.ml @@ -90,7 +90,6 @@ module TypePointerOrd = struct L.(die InternalError) "unexpected type_ptr variants: %s, %s" (type_ptr_to_string t1) (type_ptr_to_string t2) - and compare_qual_type (qt1: Clang_ast_t.qual_type) (qt2: Clang_ast_t.qual_type) = if phys_equal qt1 qt2 then 0 else @@ -115,7 +114,6 @@ module TypePointerOrd = struct else let restrict_cmp = Bool.compare r1 r2 in if restrict_cmp <> 0 then restrict_cmp else Bool.compare v1 v2 - end module TypePointerMap = Caml.Map.Make (TypePointerOrd) diff --git a/infer/src/clang/ctl_parser_types.ml b/infer/src/clang/ctl_parser_types.ml index 4e3ae144b..891cfaa74 100644 --- a/infer/src/clang/ctl_parser_types.ml +++ b/infer/src/clang/ctl_parser_types.ml @@ -549,4 +549,3 @@ let stmt_node_child_type an = match stmts with [stmt] -> ast_node_type (Stmt stmt) | _ -> "" ) | _ -> "" - diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index 85be127ae..007778a5f 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -114,4 +114,3 @@ let category_impl_decl qual_type_to_sil_type tenv decl = typ | _ -> assert false - diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 89ec4a112..e62711742 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -40,7 +40,7 @@ let get_protocols protocols = | Some name_info -> CAst_utils.get_qualified_name name_info | None -> - assert false) + assert false ) protocols in protocol_names @@ -104,7 +104,7 @@ let add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info decl_list o List.iter ~f:(fun (fn, ft, _) -> L.(debug Capture Verbose) "----->SuperClass field: '%s' " (Typ.Fieldname.to_string fn) ; - L.(debug Capture Verbose) "type: '%s'@\n" (Typ.to_string ft)) + L.(debug Capture Verbose) "type: '%s'@\n" (Typ.to_string ft) ) fields_sc ; (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) let fields, (supers: Typ.Name.t list) = @@ -121,7 +121,7 @@ let add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info decl_list o L.(debug Capture Verbose) "Class %a field:@\n" QualifiedCppName.pp class_name ; List.iter ~f:(fun (fn, _, _) -> - L.(debug Capture Verbose) "-----> field: '%s'@\n" (Typ.Fieldname.to_string fn)) + L.(debug Capture Verbose) "-----> field: '%s'@\n" (Typ.Fieldname.to_string fn) ) all_fields ; ignore (Tenv.mk_struct tenv ~fields:all_fields ~supers ~methods:[] ~annots:Annot.Class.objc @@ -174,4 +174,3 @@ let interface_impl_declaration qual_type_to_sil_type tenv decl = class_desc | _ -> assert false - diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index bd5736668..db777fdda 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -32,4 +32,3 @@ let is_weak_property obj_c_property_decl_info = let is_assign_property obj_c_property_decl_info = let attrs = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in List.exists ~f:(fun a -> match a with `Assign -> true | _ -> false) attrs - diff --git a/infer/src/clang/tableaux.ml b/infer/src/clang/tableaux.ml index 70962b07b..1c6706479 100644 --- a/infer/src/clang/tableaux.ml +++ b/infer/src/clang/tableaux.ml @@ -73,7 +73,7 @@ let init_active_map () = List.fold ~f:(fun acc_map linter -> let not_inf = not (is_in_formula linter.CFrontend_errors.condition) in - ClosureHashtbl.add linter.CFrontend_errors.condition not_inf acc_map) + ClosureHashtbl.add linter.CFrontend_errors.condition not_inf acc_map ) ~init:ClosureHashtbl.empty !CFrontend_errors.parsed_linters @@ -212,7 +212,7 @@ let exists_formula_in_successor_nodes an checker trans phi = let key = (node_pointer, checker) in let succ_sat_set = get_node_valuation key in (*print_formula_set succ_sat_set "SUCC_SAT_SET" ;*) - CTLFormulaSet.mem phi succ_sat_set) + CTLFormulaSet.mem phi succ_sat_set ) succs @@ -345,6 +345,5 @@ let build_valuation an lcxt linter_map_context = ~f:(fun (linter: linter) -> if CIssue.should_run_check linter.issue_desc.CIssue.mode && check_linter_map linter_map_context linter.condition - then do_one_check linter) + then do_one_check linter ) !parsed_linters - diff --git a/infer/src/clang_stubs/CTLParserHelper.ml b/infer/src/clang_stubs/CTLParserHelper.ml index 9c8a4959b..0c031c60e 100644 --- a/infer/src/clang_stubs/CTLParserHelper.ml +++ b/infer/src/clang_stubs/CTLParserHelper.ml @@ -10,4 +10,3 @@ let validate_al_files () = prerr_endline "ERROR: infer was built without clang support." ; Die.exit 1 - diff --git a/infer/src/concurrency/RacerD.ml b/infer/src/concurrency/RacerD.ml index d47690793..fc6f2ce08 100644 --- a/infer/src/concurrency/RacerD.ml +++ b/infer/src/concurrency/RacerD.ml @@ -222,7 +222,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct in List.fold ~f:(fun acc (base, accesses) -> - if is_static_access (fst base) then acc else add_field_accesses (base, []) acc accesses) + if is_static_access (fst base) then acc else add_field_accesses (base, []) acc accesses ) ~init:accesses (HilExp.get_access_paths exp) @@ -278,7 +278,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | ("android.app.Activity" | "android.view.View"), "findViewById" -> (* assume findViewById creates fresh View's (note: not always true) *) true - | ( ( "android.support.v4.util.Pools$Pool" | "android.support.v4.util.Pools$SimplePool" + | ( ( "android.support.v4.util.Pools$Pool" + | "android.support.v4.util.Pools$SimplePool" | "android.support.v4.util.Pools$SynchronizedPool" ) , "acquire" ) -> (* a pool should own all of its objects *) @@ -394,8 +395,14 @@ module TransferFunctions (CFG : ProcCfg.S) = struct match (Typ.Procname.java_get_class_name java_pname, Typ.Procname.java_get_method java_pname) with - | ( ( "java.lang.Boolean" | "java.lang.Byte" | "java.lang.Char" | "java.lang.Double" - | "java.lang.Float" | "java.lang.Integer" | "java.lang.Long" | "java.lang.Short" ) + | ( ( "java.lang.Boolean" + | "java.lang.Byte" + | "java.lang.Char" + | "java.lang.Double" + | "java.lang.Float" + | "java.lang.Integer" + | "java.lang.Long" + | "java.lang.Short" ) , "valueOf" ) -> true | _ -> @@ -407,7 +414,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let add_reads exps loc accesses locks threads ownership proc_data = List.fold ~f:(fun acc exp -> - add_access exp loc ~is_write_access:false acc locks threads ownership proc_data) + add_access exp loc ~is_write_access:false acc locks threads ownership proc_data ) exps ~init:accesses @@ -444,7 +451,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct PathDomain.Sinks.fold (fun elem acc -> let new_elem = TraceElem.map ~f:expand_path elem in - PathDomain.Sinks.add new_elem acc) + PathDomain.Sinks.add new_elem acc ) (PathDomain.sinks accesses) PathDomain.Sinks.empty in PathDomain.update_sinks accesses sinks @@ -621,7 +628,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct L.internal_error "Bad actual index %d for callee %a with %d actuals." index Typ.Procname.pp callee_pname (List.length actuals) ; - acc) + acc ) formal_indexes accesses_acc in AccessDomain.fold update_accesses accesses astate.accesses @@ -692,7 +699,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct not (List.is_empty rhs_access_paths) && List.for_all ~f:(fun access_path -> - AttributeMapDomain.has_attribute access_path Functional astate.attribute_map) + AttributeMapDomain.has_attribute access_path Functional astate.attribute_map ) rhs_access_paths && match AccessPath.get_typ lhs_access_path tenv with @@ -782,7 +789,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct L.(die InternalError) "Unexpected indirect call instruction %a" HilInstr.pp instr | _ -> astate - end module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Normal) (TransferFunctions) @@ -820,7 +826,7 @@ let is_thread_safe item_annot = List.exists ~f:(fun annot_string -> Annotations.annot_ends_with annot annot_string - || String.equal annot.class_name annot_string) + || String.equal annot.class_name annot_string ) threadsafe_annotations && match annot.Annot.parameters with ["false"] -> false | _ -> true in @@ -881,7 +887,7 @@ let is_thread_safe_method pname tenv = PatternMatch.override_exists (fun pn -> Annotations.pname_has_return_annot pn ~attrs_of_pname:Specs.proc_resolve_attributes - is_thread_safe) + is_thread_safe ) tenv pname @@ -1068,7 +1074,7 @@ let get_all_accesses_with_pre pre_filter access_filter accesses = let open RacerDDomain in AccessDomain.fold (fun pre trace acc -> - if pre_filter pre then PathDomain.join (filter_by_access access_filter trace) acc else acc) + if pre_filter pre then PathDomain.join (filter_by_access access_filter trace) acc else acc ) accesses PathDomain.empty @@ -1333,7 +1339,7 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi ~f:(fun {access= other_access; threads= other_threads} -> if TraceElem.is_write other_access && ThreadsDomain.is_any other_threads then Some other_access - else None) + else None ) accesses in if not (List.is_empty writes_on_background_thread && not (ThreadsDomain.is_any threads)) @@ -1363,14 +1369,14 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi let is_conflict other_access pre other_thread = TraceElem.is_write other_access && - if Typ.Procname.is_java pname then ThreadsDomain.is_any threads - || ThreadsDomain.is_any other_thread + if Typ.Procname.is_java pname then + ThreadsDomain.is_any threads || ThreadsDomain.is_any other_thread else is_cpp_protected_write pre in let all_writes = List.filter ~f:(fun {access= other_access; precondition; threads= other_threads} -> - is_conflict other_access precondition other_threads) + is_conflict other_access precondition other_threads ) accesses in if not (List.is_empty all_writes) then @@ -1398,7 +1404,7 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi | AccessPrecondition.Protected other_excl when is_opposite (excl, other_excl) -> TraceElem.is_write access | _ -> - false) + false ) accesses in if not (List.is_empty conflicting_writes) then @@ -1417,7 +1423,8 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi (* check if the class contains a member of type std::mutex *) List.exists class_str.Typ.Struct.fields ~f:(fun (_, ft, _) -> Option.exists (Typ.name ft) ~f:(fun name -> - QualifiedCppName.Match.match_qualifiers matcher (Typ.Name.qual_name name) ) ) ) + QualifiedCppName.Match.match_qualifiers matcher (Typ.Name.qual_name name) ) ) + ) in let should_report pdesc tenv = match Procdesc.get_proc_name pdesc with @@ -1443,7 +1450,7 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi in List.iter ~f:(fun access -> report_unsafe_access access reportable_accesses) - reportable_accesses) + reportable_accesses ) aggregated_access_map |> ignore @@ -1484,7 +1491,6 @@ module SyntacticQuotientedAccessListMap : QuotientedAccessListMap = struct [%compare : (var_ * Typ.t) * AccessPath.access list] ap1 ap2 | (InterfaceCall _ | Read _ | Write _ | ContainerRead _ | ContainerWrite _), _ -> RacerDDomain.Access.compare x y - end) type t = reported_access list M.t @@ -1583,7 +1589,7 @@ module MayAliasQuotientedAccessListMap : QuotientedAccessListMap = struct , (ContainerRead (ap2, _) | ContainerWrite (ap2, _)) ) -> syntactic_equal_access_path tenv ap1 ap2 | _ -> - RacerDDomain.Access.equal k k') + RacerDDomain.Access.equal k k' ) m in if AccessListMap.is_empty k_part then L.(die InternalError) "may_alias is not reflexive!" ; @@ -1592,7 +1598,6 @@ module MayAliasQuotientedAccessListMap : QuotientedAccessListMap = struct aux new_acc non_k_part in aux AccessListMap.empty acc_map - end (* decide if we should throw away a path before doing safety analysis @@ -1615,7 +1620,7 @@ let should_filter_access access = (* create a map from [abstraction of a memory loc] -> accesses that may touch that memory loc. for now, our abstraction is an access path like x.f.g whose concretization is the set of memory cells that x.f.g may point to during execution *) -let make_results_table (module AccessListMap: QuotientedAccessListMap) file_env = +let make_results_table (module AccessListMap : QuotientedAccessListMap) file_env = let open RacerDDomain in let aggregate_post {threads; accesses} tenv procdesc acc = AccessDomain.fold @@ -1626,8 +1631,8 @@ let make_results_table (module AccessListMap: QuotientedAccessListMap) file_env if should_filter_access access_kind then acc else let reported_access = {access; precondition; threads; tenv; procdesc} in - AccessListMap.add access_kind reported_access acc) - (PathDomain.sinks accesses) acc) + AccessListMap.add access_kind reported_access acc ) + (PathDomain.sinks accesses) acc ) accesses acc in let aggregate_posts acc (tenv, proc_desc) = @@ -1654,7 +1659,7 @@ let aggregate_by_class file_env = "unknown" in let bucket = try String.Map.find_exn acc classname with Not_found -> [] in - String.Map.add ~key:classname ~data:(proc :: bucket) acc) + String.Map.set ~key:classname ~data:(proc :: bucket) acc ) ~init:String.Map.empty @@ -1668,6 +1673,5 @@ let file_analysis {Callbacks.procedures} = (make_results_table ( if Tenv.language_is tenv Clang then (module SyntacticQuotientedAccessListMap) else (module MayAliasQuotientedAccessListMap) ) - class_env)) + class_env) ) (aggregate_by_class procedures) - diff --git a/infer/src/concurrency/RacerDConfig.ml b/infer/src/concurrency/RacerDConfig.ml index d0f4ae192..5b5204793 100644 --- a/infer/src/concurrency/RacerDConfig.ml +++ b/infer/src/concurrency/RacerDConfig.ml @@ -18,7 +18,6 @@ module AnnotationAliases = struct | _ -> L.(die UserError) "Couldn't parse thread-safety annotation aliases; expected list of strings" - end module Models = struct @@ -113,17 +112,20 @@ module Models = struct match (Typ.Procname.java_get_class_name java_pname, Typ.Procname.java_get_method java_pname) with - | ( ( "java.util.concurrent.locks.Lock" | "java.util.concurrent.locks.ReentrantLock" + | ( ( "java.util.concurrent.locks.Lock" + | "java.util.concurrent.locks.ReentrantLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$ReadLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$WriteLock" ) , ("lock" | "lockInterruptibly") ) -> Lock - | ( ( "java.util.concurrent.locks.Lock" | "java.util.concurrent.locks.ReentrantLock" + | ( ( "java.util.concurrent.locks.Lock" + | "java.util.concurrent.locks.ReentrantLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$ReadLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$WriteLock" ) , "unlock" ) -> Unlock - | ( ( "java.util.concurrent.locks.Lock" | "java.util.concurrent.locks.ReentrantLock" + | ( ( "java.util.concurrent.locks.Lock" + | "java.util.concurrent.locks.ReentrantLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$ReadLock" | "java.util.concurrent.locks.ReentrantReadWriteLock$WriteLock" ) , "tryLock" ) -> @@ -133,11 +135,11 @@ module Models = struct Lock | _ -> NoEffect ) - | Typ.Procname.ObjC_Cpp _ | C _ as pname when is_cpp_lock pname actuals -> + | (Typ.Procname.ObjC_Cpp _ | C _) as pname when is_cpp_lock pname actuals -> Lock - | Typ.Procname.ObjC_Cpp _ | C _ as pname when is_cpp_unlock pname -> + | (Typ.Procname.ObjC_Cpp _ | C _) as pname when is_cpp_unlock pname -> Unlock - | Typ.Procname.ObjC_Cpp _ | C _ as pname when is_cpp_trylock pname -> + | (Typ.Procname.ObjC_Cpp _ | C _) as pname when is_cpp_trylock pname -> LockedIfTrue | pname when Typ.Procname.equal pname BuiltinDecl.__set_locked_attribute -> Lock @@ -175,33 +177,69 @@ module Models = struct let get_container_access_ typename = match (Typ.Name.name typename, Typ.Procname.java_get_method java_pname) with | ( ("android.util.SparseArray" | "android.support.v4.util.SparseArrayCompat") - , ( "append" | "clear" | "delete" | "put" | "remove" | "removeAt" | "removeAtRange" + , ( "append" + | "clear" + | "delete" + | "put" + | "remove" + | "removeAt" + | "removeAtRange" | "setValueAt" ) ) -> Some ContainerWrite | ( ("android.util.SparseArray" | "android.support.v4.util.SparseArrayCompat") , ("clone" | "get" | "indexOfKey" | "indexOfValue" | "keyAt" | "size" | "valueAt") ) -> Some ContainerRead | ( "android.support.v4.util.SimpleArrayMap" - , ( "clear" | "ensureCapacity" | "put" | "putAll" | "remove" | "removeAt" + , ( "clear" + | "ensureCapacity" + | "put" + | "putAll" + | "remove" + | "removeAt" | "setValueAt" ) ) -> Some ContainerWrite | ( "android.support.v4.util.SimpleArrayMap" - , ( "containsKey" | "containsValue" | "get" | "hashCode" | "indexOfKey" | "isEmpty" - | "keyAt" | "size" | "valueAt" ) ) -> + , ( "containsKey" + | "containsValue" + | "get" + | "hashCode" + | "indexOfKey" + | "isEmpty" + | "keyAt" + | "size" + | "valueAt" ) ) -> Some ContainerRead | "android.support.v4.util.Pools$SimplePool", ("acquire" | "release") -> Some ContainerWrite | "java.util.List", ("add" | "addAll" | "clear" | "remove" | "set") -> Some ContainerWrite | ( "java.util.List" - , ( "contains" | "containsAll" | "equals" | "get" | "hashCode" | "indexOf" - | "isEmpty" | "iterator" | "lastIndexOf" | "listIterator" | "size" | "toArray" ) ) -> + , ( "contains" + | "containsAll" + | "equals" + | "get" + | "hashCode" + | "indexOf" + | "isEmpty" + | "iterator" + | "lastIndexOf" + | "listIterator" + | "size" + | "toArray" ) ) -> Some ContainerRead | "java.util.Map", ("clear" | "put" | "putAll" | "remove") -> Some ContainerWrite | ( "java.util.Map" - , ( "containsKey" | "containsValue" | "entrySet" | "equals" | "get" | "hashCode" - | "isEmpty" | "keySet" | "size" | "values" ) ) -> + , ( "containsKey" + | "containsValue" + | "entrySet" + | "equals" + | "get" + | "hashCode" + | "isEmpty" + | "keySet" + | "size" + | "values" ) ) -> Some ContainerRead | _ -> None @@ -210,10 +248,10 @@ module Models = struct (* The following order matters: we want to check if pname is a container write before we check if pname is a container read. This is due to a different treatment between std::map::operator[] and all other operator[]. *) - | Typ.Procname.ObjC_Cpp _ | C _ as pname + | (Typ.Procname.ObjC_Cpp _ | C _) as pname when is_cpp_container_write pname -> Some ContainerWrite - | Typ.Procname.ObjC_Cpp _ | C _ as pname when is_cpp_container_read pname -> + | (Typ.Procname.ObjC_Cpp _ | C _) as pname when is_cpp_container_read pname -> Some ContainerRead | _ -> None @@ -236,11 +274,10 @@ module Models = struct ; "std::vector" ]) in function - | Typ.Procname.ObjC_Cpp _ | C _ as pname -> + | (Typ.Procname.ObjC_Cpp _ | C _) as pname -> Typ.Procname.is_destructor pname || QualifiedCppName.Match.match_qualifiers (Lazy.force matcher) (Typ.Procname.get_qualifiers pname) | _ -> false - end diff --git a/infer/src/concurrency/RacerDDomain.ml b/infer/src/concurrency/RacerDDomain.ml index 5dce692b3..0f83a94d7 100644 --- a/infer/src/concurrency/RacerDDomain.ml +++ b/infer/src/concurrency/RacerDDomain.ml @@ -81,7 +81,6 @@ module Access = struct pname | InterfaceCall pname -> F.fprintf fmt "Call to un-annotated interface method %a" Typ.Procname.pp pname - end module TraceElem = struct @@ -150,7 +149,6 @@ module TraceElem = struct let make_unannotated_call_access pname loc = let site = make_dummy_site loc in make (Access.InterfaceCall pname) site - end (* In this domain true<=false. The intended denotations [[.]] are @@ -222,7 +220,6 @@ module Choice = struct F.fprintf fmt "OnMainThread" | LockHeld -> F.fprintf fmt "LockHeld" - end module Attribute = struct @@ -294,7 +291,6 @@ module OwnershipAbstractValue = struct (IntSet.elements s) | Owned -> F.fprintf fmt "Owned" - end module OwnershipDomain = struct @@ -363,7 +359,6 @@ module AttributeMapDomain = struct |> AttributeSetDomain.add attribute in add access_path attribute_set t - end module Excluder = struct @@ -376,7 +371,6 @@ module Excluder = struct F.fprintf fmt "Lock" | Both -> F.fprintf fmt "both Thread and Lock" - end module AccessPrecondition = struct @@ -449,7 +443,8 @@ let is_empty {threads; locks; accesses; ownership; attribute_map} = let ( <= ) ~lhs ~rhs = if phys_equal lhs rhs then true - else ThreadsDomain.( <= ) ~lhs:lhs.threads ~rhs:rhs.threads + else + ThreadsDomain.( <= ) ~lhs:lhs.threads ~rhs:rhs.threads && LocksDomain.( <= ) ~lhs:lhs.locks ~rhs:rhs.locks && AccessDomain.( <= ) ~lhs:lhs.accesses ~rhs:rhs.accesses && AttributeMapDomain.( <= ) ~lhs:lhs.attribute_map ~rhs:rhs.attribute_map @@ -497,4 +492,3 @@ let pp fmt {threads; locks; accesses; ownership; attribute_map} = F.fprintf fmt "Threads: %a, Locks: %a @\nAccesses %a @\n Ownership: %a @\nAttributes: %a @\n" ThreadsDomain.pp threads LocksDomain.pp locks AccessDomain.pp accesses OwnershipDomain.pp ownership AttributeMapDomain.pp attribute_map - diff --git a/infer/src/eradicate/AnnotatedSignature.ml b/infer/src/eradicate/AnnotatedSignature.ml index fa6efca4e..0c80c7a84 100644 --- a/infer/src/eradicate/AnnotatedSignature.ml +++ b/infer/src/eradicate/AnnotatedSignature.ml @@ -50,14 +50,14 @@ let get proc_attributes : t = let param_is_nullable pvar ann_sig = List.exists ~f:(fun (param, annot, _) -> - Mangled.equal param (Pvar.get_name pvar) && Annotations.ia_is_nullable annot) + Mangled.equal param (Pvar.get_name pvar) && Annotations.ia_is_nullable annot ) ann_sig.params let param_has_annot predicate pvar ann_sig = List.exists ~f:(fun (param, param_annot, _) -> - Mangled.equal param (Pvar.get_name pvar) && predicate param_annot) + Mangled.equal param (Pvar.get_name pvar) && predicate param_annot ) ann_sig.params @@ -153,4 +153,3 @@ let mark_return ann asig = let ia, t = asig.ret in let ret' = (mark_ia ann ia true, t) in {asig with ret= ret'} - diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index eaa7d20d3..9abb03fbc 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -294,7 +294,6 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct && equal_class_opt (get_class pname) (get_class curr_pname) ) in final_typestates constructors_current_class) - end (* Initializers *) in let do_final_typestate typestate_opt calls_this = @@ -348,7 +347,6 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct L.result "%a@." (AnnotatedSignature.pp proc_name) annotated_signature ; callback2 calls_this checks callback_args annotated_signature linereader loc ) ; summary - end (* MkCallback *) @@ -390,4 +388,3 @@ let callback_check_return_type check_return_type callback_args = {TypeCheck.eradicate= false; check_extension= false; check_ret_type= [check_return_type]} in Main.callback checks callback_args - diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 36d796844..cc5ac6e93 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -416,7 +416,8 @@ let check_call_parameters tenv find_canonical_duplicate curr_pdesc node callee_s in let should_check_parameters = if check_library_calls then true - else Models.is_modelled_nullable callee_pname || callee_attributes.ProcAttributes.is_defined + else + Models.is_modelled_nullable callee_pname || callee_attributes.ProcAttributes.is_defined || Option.is_some callee_summary_opt in if should_check_parameters then diff --git a/infer/src/eradicate/modelTables.ml b/infer/src/eradicate/modelTables.ml index 3ea1c8e07..6aafb4ed7 100644 --- a/infer/src/eradicate/modelTables.ml +++ b/infer/src/eradicate/modelTables.ml @@ -127,7 +127,8 @@ let check_state_list = , "com.facebook.infer.annotation.Assertions.assertCondition(boolean,java.lang.String):void" ) ; ((o, [n]), "com.facebook.infer.annotation.Assertions.assumeCondition(boolean):void") ; ( (o, [n; o]) - , "com.facebook.infer.annotation.Assertions.assumeCondition(boolean,java.lang.String):void" ) ] + , "com.facebook.infer.annotation.Assertions.assumeCondition(boolean,java.lang.String):void" ) + ] let check_argument_list = @@ -258,7 +259,8 @@ let annotated_list_nullable = , "javax.lang.model.element.Element.getAnnotation(java.lang.Class):java.lang.annotation.Annotation" ) ; ( ng - , "javax.lang.model.element.Element.getEnclosingElement():javax.lang.model.element.Element" ) + , "javax.lang.model.element.Element.getEnclosingElement():javax.lang.model.element.Element" + ) ; ( ng , "javax.lang.model.element.ExecutableElement.getDefaultValue():javax.lang.model.element.AnnotationValue" ) diff --git a/infer/src/eradicate/models.ml b/infer/src/eradicate/models.ml index 3e6aadb5e..62d001632 100644 --- a/infer/src/eradicate/models.ml +++ b/infer/src/eradicate/models.ml @@ -52,9 +52,9 @@ module Inference = struct let update_boolvec_str s_ size index bval = - let s = if String.is_empty s_ then String.make size '0' else s_ in - s.[index] <- (if bval then '1' else '0') ; - s + let s = if String.is_empty s_ then Bytes.make size '0' else Bytes.of_string s_ in + Bytes.set s index (if bval then '1' else '0') ; + Bytes.to_string s let mark_file update_str dir fname = @@ -103,7 +103,6 @@ module Inference = struct let boolvec = ref [] in String.iter ~f:(fun c -> boolvec := Char.equal c '1' :: !boolvec) buf ; Some (List.rev !boolvec) - end (* Inference *) diff --git a/infer/src/eradicate/typeAnnotation.ml b/infer/src/eradicate/typeAnnotation.ml index c0fb87f84..b47c252c2 100644 --- a/infer/src/eradicate/typeAnnotation.ml +++ b/infer/src/eradicate/typeAnnotation.ml @@ -91,4 +91,3 @@ let with_origin ta o = {ta with origin= o} let from_item_annotation ia origin = let ta = const Nullable (Annotations.ia_is_nullable ia) origin in set_value Present (Annotations.ia_is_present ia) ta - diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index e37a8fee2..0f7542e7f 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -130,7 +130,6 @@ module ComplexExpressions = struct let exp_to_string tenv node' exp = let map_dexp de_opt = de_opt in exp_to_string_map_dexp tenv map_dexp node' exp - end (* ComplexExpressions *) @@ -550,7 +549,7 @@ let typecheck_instr tenv ext calls_this checks (node: Procdesc.Node.t) idenv get if Int.equal i 0 && not (Typ.Procname.java_is_static callee_pname) then "this" else Printf.sprintf "arg%d" i in - (Mangled.from_string arg, typ)) + (Mangled.from_string arg, typ) ) etl_ in let ret_type = Typ.java_proc_return_typ callee_pname_java in @@ -818,7 +817,7 @@ let typecheck_instr tenv ext calls_this checks (node: Procdesc.Node.t) idenv get String.equal (Mangled.to_string s) "this" || String.is_prefix ~prefix:"this$" (Mangled.to_string s) in - not param_is_this) + not param_is_this ) (List.zip_exn sig_slice call_slice) in let resolved_params = List.mapi ~f:resolve_param sig_call_params in @@ -1140,4 +1139,3 @@ let typecheck_node tenv ext calls_this checks idenv get_proc_desc curr_pname cur in if dont_propagate then ([], []) (* don't propagate to exit node *) else ([typestate_succ], !typestates_exn) - diff --git a/infer/src/eradicate/typeErr.ml b/infer/src/eradicate/typeErr.ml index 01e86ca3b..05fdbbd74 100644 --- a/infer/src/eradicate/typeErr.ml +++ b/infer/src/eradicate/typeErr.ml @@ -55,7 +55,6 @@ module InstrRef : InstrRefT = struct let gen instr_ref_gen = let node, ir = instr_ref_gen in incr ir ; (node, !ir) - end (* InstrRef *) @@ -137,7 +136,6 @@ module H = Hashtbl.Make (struct in let y = err_instance_hash err_inst in Hashtbl.hash (x, y) - end (* H *)) @@ -265,7 +263,6 @@ module Strict = struct origin_descr_get_strict tenv origin_descr | _ -> None - end (* Strict *) diff --git a/infer/src/eradicate/typeOrigin.ml b/infer/src/eradicate/typeOrigin.ml index f98024e46..3b8b23103 100644 --- a/infer/src/eradicate/typeOrigin.ml +++ b/infer/src/eradicate/typeOrigin.ml @@ -96,4 +96,3 @@ let join o1 o2 = o2 | _ -> o1 - diff --git a/infer/src/integration/Buck.ml b/infer/src/integration/Buck.ml index 6f35190db..b118d98b0 100644 --- a/infer/src/integration/Buck.ml +++ b/infer/src/integration/Buck.ml @@ -47,7 +47,6 @@ module Target = struct L.(die UserError) "Analyzer %s is Java-only; not supported with Buck flavors" (Config.string_of_analyzer Config.analyzer) - end let parse_target_string = @@ -124,7 +123,6 @@ module Query = struct let tmp_prefix = "buck_query_" in let debug = L.(debug Capture Medium) in Utils.with_process_lines ~debug ~cmd ~tmp_prefix ~f:Fn.id - end let accepted_buck_commands = ["build"] diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index 920711d3c..f329a1886 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -176,4 +176,3 @@ let capture_files_in_database ~changed_files compilation_database = let capture_file_in_database compilation_database source_file = run_compilation_database compilation_database (SourceFile.equal source_file) - diff --git a/infer/src/integration/Clang.ml b/infer/src/integration/Clang.ml index ecdd1a3f4..d79eacd37 100644 --- a/infer/src/integration/Clang.ml +++ b/infer/src/integration/Clang.ml @@ -64,4 +64,3 @@ let capture compiler ~prog ~args = "*** capture command failed:@\n*** %s@\n*** %s@." (String.concat ~sep:" " (prog :: args)) (Unix.Exit_or_signal.to_string_hum status) - diff --git a/infer/src/integration/ClangQuotes.ml b/infer/src/integration/ClangQuotes.ml index c9944948d..cdec7af3c 100644 --- a/infer/src/integration/ClangQuotes.ml +++ b/infer/src/integration/ClangQuotes.ml @@ -38,4 +38,3 @@ let mk_arg_file prefix style args = Utils.with_file_out file ~f:write_args |> ignore ; L.(debug Capture Medium) "Clang options stored in file %s@\n" file ; file - diff --git a/infer/src/integration/CompilationDatabase.ml b/infer/src/integration/CompilationDatabase.ml index 00c545f8a..f2105f918 100644 --- a/infer/src/integration/CompilationDatabase.ml +++ b/infer/src/integration/CompilationDatabase.ml @@ -153,4 +153,3 @@ let from_json_files db_json_files = List.iter ~f:(decode_json_file db) db_json_files ; L.(debug Capture Quiet) "created database with %d entries@\n" (get_size db) ; db - diff --git a/infer/src/integration/Diff.ml b/infer/src/integration/Diff.ml index f3ef6a0f1..64a366c03 100644 --- a/infer/src/integration/Diff.ml +++ b/infer/src/integration/Diff.ml @@ -83,4 +83,3 @@ let diff driver_mode = ReportDiff.reportdiff ~current_report ~previous_report ; Driver.run_epilogue driver_mode ; () - diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 67d6dd413..319fdc132 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -514,7 +514,7 @@ let mode_of_build_command build_cmd = Python args | BXcode when Config.xcpretty -> XcodeXcpretty (prog, args) - | BAnt | BBuck | BGradle | BNdk | BXcode as build_system -> + | (BAnt | BBuck | BGradle | BNdk | BXcode) as build_system -> PythonCapture (build_system, build_cmd) @@ -574,4 +574,3 @@ let read_config_changed_files () = | Error error -> L.external_error "Error reading the changed files index '%s': %s@." index error ; None - diff --git a/infer/src/integration/ReportDiff.ml b/infer/src/integration/ReportDiff.ml index a5563423e..f276e6cc3 100644 --- a/infer/src/integration/ReportDiff.ml +++ b/infer/src/integration/ReportDiff.ml @@ -30,7 +30,7 @@ let reportdiff ~current_report:current_report_fname ~previous_report:previous_re let interesting_paths = Option.map ~f:(fun fname -> - List.map ~f:(SourceFile.create ~warn_on_error:false) (In_channel.read_lines fname)) + List.map ~f:(SourceFile.create ~warn_on_error:false) (In_channel.read_lines fname) ) Config.differential_filter_files in DifferentialFilters.do_filter unfiltered_diff file_renamings @@ -40,4 +40,3 @@ let reportdiff ~current_report:current_report_fname ~previous_report:previous_re let out_path = Config.results_dir ^/ "differential" in Unix.mkdir_p out_path ; Differential.to_files diff out_path - diff --git a/infer/src/istd/IList.ml b/infer/src/istd/IList.ml index 5cd8af36a..f036863fc 100644 --- a/infer/src/istd/IList.ml +++ b/infer/src/istd/IList.ml @@ -13,7 +13,7 @@ let map_changed (f: 'a -> 'a) l = List.fold_left (fun (l_acc, changed) e -> let e' = f e in - (e' :: l_acc, changed || e' != e)) + (e' :: l_acc, changed || e' != e) ) ([], false) l in if changed then List.rev l' else l @@ -106,4 +106,3 @@ let uncons_exn = function [] -> failwith "uncons_exn" | hd :: tl -> (hd, tl) let append_no_duplicates eq list1 list2 = let list2_no_dup = List.filter (fun x2 -> List.for_all (fun x1 -> not (eq x2 x1)) list1) list2 in list1 @ list2_no_dup - diff --git a/infer/src/istd/IStd.ml b/infer/src/istd/IStd.ml index c597247d3..d9b8689f3 100644 --- a/infer/src/istd/IStd.ml +++ b/infer/src/istd/IStd.ml @@ -28,16 +28,16 @@ module Unix_ = struct improve (fun () -> let prog_args = Array.of_list (prog :: args) in - Caml.UnixLabels.create_process ~prog ~args:prog_args ~stdin ~stdout ~stderr |> Pid.of_int) + Caml.UnixLabels.create_process ~prog ~args:prog_args ~stdin ~stdout ~stderr |> Pid.of_int + ) (fun () -> [("prog", Sexp.Atom prog); ("args", Sexplib.Conv.sexp_of_list (fun a -> Sexp.Atom a) args)] - ) + ) let fork_redirect_exec_wait ~prog ~args ?stdin ?stdout ?stderr () = Unix.waitpid (create_process_redirect ~prog ~args ?stdin ?stdout ?stderr ()) |> Unix.Exit_or_signal.or_error |> ok_exn - end module List_ = struct @@ -63,7 +63,6 @@ module List_ = struct else loop (h2 :: acc) l1 t2 in loop [] l1 l2 - end (* Use Caml.Set since they are serialized using Marshal, and Core.Std.Set includes the comparison diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index 9fdb2a56c..7efadf087 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -49,4 +49,3 @@ let translate_method ann : Annot.Method.t = let ret_item = translate_item global_ann in let param_items = List.map ~f:translate_item param_ann in (ret_item, param_items) - diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index 9aab9b095..44f16fe87 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -135,7 +135,7 @@ let add_source_file path map = (* Most common case: there is no conflict with the base name of the source file *) Singleton current_source_file in - String.Map.add ~key:basename ~data:entry map + String.Map.set ~key:basename ~data:entry map let add_root_path path roots = String.Set.add roots path @@ -226,7 +226,7 @@ let search_classes path = if Filename.check_suffix p "class" then add_class paths classes p else if Filename.check_suffix p "jar" then (add_root_path p paths, collect_classnames classes p) - else accu) + else accu ) (String.Set.empty, JBasics.ClassSet.empty) path @@ -305,4 +305,3 @@ let load_program classpath classes = JBasics.ClassSet.iter (fun cn -> ignore (lookup_node cn program)) classes ; L.(debug Capture Medium) "done@." ; program - diff --git a/infer/src/java/jContext.ml b/infer/src/java/jContext.ml index 9f90809cc..72526c7bc 100644 --- a/infer/src/java/jContext.ml +++ b/infer/src/java/jContext.ml @@ -118,4 +118,3 @@ let add_exn_node procname (exn_node: Procdesc.Node.t) = let get_exn_node procdesc = try Some (Typ.Procname.Hash.find exn_node_table (Procdesc.get_proc_name procdesc)) with Not_found -> None - diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index feaa1467b..f8d7a5b6e 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -215,4 +215,3 @@ let compute_class_icfg source_file linereader program tenv node = ( try create_icfg source_file linereader program icfg (Javalib.get_name node) node with Bir.Subroutine -> () ) ; (icfg.JContext.cg, icfg.JContext.cfg) - diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 540e52df0..b4d30cd71 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -121,8 +121,8 @@ let do_all_files classpath sources classes = | JClasspath.Duplicate source_files -> List.iter ~f:(fun (package, source_file) -> - translate_source_file basename (Some package, source_file) source_file) - source_files) + translate_source_file basename (Some package, source_file) source_file ) + source_files ) sources ; if Config.dependency_mode then capture_libs linereader program tenv ; save_tenv tenv ; diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index b6ffb26cb..f888fa012 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -85,8 +85,7 @@ let get_field_name program static tenv cn fs = let {Typ.Struct.fields; statics} = JTransType.get_class_struct_typ program tenv cn in match List.find - ~f:(fun (fieldname, _, _) -> - String.equal (retrieve_fieldname fieldname) (JBasics.fs_name fs)) + ~f:(fun (fieldname, _, _) -> String.equal (retrieve_fieldname fieldname) (JBasics.fs_name fs)) (if static then statics else fields) with | Some (fieldname, _, _) -> @@ -150,7 +149,7 @@ let translate_locals program tenv formals bytecode jbir_code = ~f:(fun accu (_, _, var_name, var_type, _) -> let var = Mangled.from_string var_name and typ = JTransType.value_type program tenv var_type in - collect accu (var, typ)) + collect accu (var, typ) ) ~init variable_table in (* TODO (#4040807): Needs to add the JBir temporary variables since other parts of the @@ -159,7 +158,7 @@ let translate_locals program tenv formals bytecode jbir_code = Array.fold ~f:(fun accu jbir_var -> let var = Mangled.from_string (JBir.var_name_g jbir_var) in - collect accu (var, Typ.mk Tvoid)) + collect accu (var, Typ.mk Tvoid) ) ~init:with_bytecode_vars (JBir.vars jbir_code) in snd with_jbir_vars @@ -617,7 +616,7 @@ let method_invocation (context: JContext.t) loc pc var_opt cn ms sil_obj_opt exp List.fold ~f:(fun (instrs_accu, args_accu) expr -> let instrs, sil_expr, sil_expr_type = expression context pc expr in - (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)])) + (instrs_accu @ instrs, args_accu @ [(sil_expr, sil_expr_type)]) ) ~init expr_list in let callee_procname = diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index 6f0695d17..9bee5936e 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -162,4 +162,3 @@ let create_exception_handlers context exit_nodes get_body_nodes impl = let handler_list = Hashtbl.find handler_table pc in Hashtbl.find catch_block_table handler_list with Not_found -> exit_nodes - diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 34c93556a..9986cca76 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -338,7 +338,7 @@ let rec get_all_fields program tenv cn = List.fold ~f:(fun (statics, fields) interface_name -> let interface_statics, interface_fields = extract_class_fields interface_name in - (interface_statics @ statics, interface_fields @ fields)) + (interface_statics @ statics, interface_fields @ fields) ) ~init:(rev_pair superclass_fields) jclass.Javalib.c_interfaces |> rev_pair in @@ -452,7 +452,8 @@ let get_var_type_from_sig (context: JContext.t) var = let tenv = JContext.get_tenv context in List.find_map ~f:(fun (vt', var') -> - if JBir.var_equal var var' then Some (param_type program tenv context.cn var' vt') else None) + if JBir.var_equal var var' then Some (param_type program tenv context.cn var' vt') else None + ) (JBir.params context.impl) @@ -497,4 +498,3 @@ let add_models_types tenv = if not (Tenv.mem t typename) then Tenv.add tenv typename struct_typ in Tenv.iter (add_type tenv) !JClasspath.models_tenv - diff --git a/infer/src/jbuild.common.in b/infer/src/jbuild.common.in index 125ed50bb..4d80fc2f5 100644 --- a/infer/src/jbuild.common.in +++ b/infer/src/jbuild.common.in @@ -68,4 +68,3 @@ let common_libraries = ; "xmlm" ; "yojson" ; "zip" ] - diff --git a/infer/src/jbuild.in b/infer/src/jbuild.in index c71721bda..3d06e03f5 100644 --- a/infer/src/jbuild.in +++ b/infer/src/jbuild.in @@ -86,7 +86,7 @@ let stanzas = [ Printf.sprintf "(copy_files# %s/*.ml{,i,l})" source_dir ; (* menhir doesn't support '# 1 ""' directives at the start of the file inserted by copy# actions *) - Printf.sprintf "(copy_files %s/*.mly)" source_dir ]) + Printf.sprintf "(copy_files %s/*.mly)" source_dir ] ) source_dirs |> List.concat ) diff --git a/infer/src/labs/ResourceLeaks.ml b/infer/src/labs/ResourceLeaks.ml index b9432e617..d84df86c2 100644 --- a/infer/src/labs/ResourceLeaks.ml +++ b/infer/src/labs/ResourceLeaks.ml @@ -88,7 +88,6 @@ module TransferFunctions (CFG : ProcCfg.S) = struct | Call (_, Indirect _, _, _, _) -> (* This should never happen in Java. Fail if it does. *) L.(die InternalError) "Unexpected indirect call %a" HilInstr.pp instr - end (* Create an intraprocedural abstract interpreter from the transfer functions we defined *) diff --git a/infer/src/quandary/ClangTaintAnalysis.ml b/infer/src/quandary/ClangTaintAnalysis.ml index 53906d5dc..bfb71a278 100644 --- a/infer/src/quandary/ClangTaintAnalysis.ml +++ b/infer/src/quandary/ClangTaintAnalysis.ml @@ -98,5 +98,6 @@ include TaintAnalysis.Make (struct | _ -> None + let is_taintable_type _ = true end) diff --git a/infer/src/quandary/ClangTrace.ml b/infer/src/quandary/ClangTrace.ml index e6aa18792..43f8dcc34 100644 --- a/infer/src/quandary/ClangTrace.ml +++ b/infer/src/quandary/ClangTrace.ml @@ -42,7 +42,7 @@ module SourceKind = struct let external_sources = List.map ~f:(fun {QuandaryConfig.Source.procedure; kind; index} -> - (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kind, index)) + (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kind, index) ) (QuandaryConfig.Source.of_json Config.quandary_sources) @@ -56,7 +56,7 @@ module SourceKind = struct if QualifiedCppName.Match.match_qualifiers qualifiers qualified_pname then let source_index = try Some (int_of_string index) with Failure _ -> return in Some (of_string kind, source_index) - else None) + else None ) external_sources @@ -142,7 +142,7 @@ module SourceKind = struct | _ -> Some (make_source name typ.Typ.desc) in - (name, typ, taint)) + (name, typ, taint) ) (Procdesc.get_formals pdesc) in match Procdesc.get_proc_name pdesc with @@ -174,7 +174,6 @@ module SourceKind = struct F.fprintf fmt "Other" | UserControlledEndpoint (formal_name, _) -> F.fprintf fmt "UserControlledEndpoint[%s]" (Mangled.to_string formal_name) - end module CppSource = Source.Make (SourceKind) @@ -215,7 +214,7 @@ module SinkKind = struct let external_sinks = List.map ~f:(fun {QuandaryConfig.Sink.procedure; kind; index} -> - (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kind, index)) + (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kind, index) ) (QuandaryConfig.Sink.of_json Config.quandary_sinks) @@ -252,7 +251,7 @@ module SinkKind = struct with Failure _ -> (* couldn't parse the index, just taint everything *) taint_all kind actuals - else None) + else None ) external_sinks @@ -328,12 +327,7 @@ module SinkKind = struct | "strcpy" when Config.developer_mode -> (* warn if source array is tainted *) taint_nth 1 BufferAccess actuals - | "memcpy" - | "memmove" - | "memset" - | "strncpy" - | "wmemcpy" - | "wmemmove" + | ("memcpy" | "memmove" | "memset" | "strncpy" | "wmemcpy" | "wmemmove") when Config.developer_mode -> (* warn if count argument is tainted *) taint_nth 2 BufferAccess actuals @@ -364,7 +358,6 @@ module SinkKind = struct "StackAllocation" | Other -> "Other" ) - end module CppSink = Sink.Make (SinkKind) @@ -382,7 +375,7 @@ module CppSanitizer = struct let external_sanitizers = List.map ~f:(fun {QuandaryConfig.Sanitizer.procedure; kind} -> - (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], of_string kind)) + (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], of_string kind) ) (QuandaryConfig.Sanitizer.of_json Config.quandary_sanitizers) @@ -391,7 +384,7 @@ module CppSanitizer = struct List.find_map ~f:(fun (qualifiers, kind) -> if QualifiedCppName.Match.match_qualifiers qualifiers qualified_pname then Some kind - else None) + else None ) external_sanitizers @@ -480,5 +473,4 @@ include Trace.Make (struct Some IssueType.quandary_taint_error | _, Other -> Some IssueType.quandary_taint_error - end) diff --git a/infer/src/quandary/JavaTaintAnalysis.ml b/infer/src/quandary/JavaTaintAnalysis.ml index 5069f7adc..b2d9731c5 100644 --- a/infer/src/quandary/JavaTaintAnalysis.ml +++ b/infer/src/quandary/JavaTaintAnalysis.ml @@ -89,5 +89,4 @@ include TaintAnalysis.Make (struct false ) | _ -> false - end) diff --git a/infer/src/quandary/JavaTrace.ml b/infer/src/quandary/JavaTrace.ml index bfe6f4199..174d6bbe6 100644 --- a/infer/src/quandary/JavaTrace.ml +++ b/infer/src/quandary/JavaTrace.ml @@ -67,14 +67,20 @@ module SourceKind = struct (* taint the [this] parameter passed to the constructor *) Some (IntentFromURI, Some 0) | ( "android.content.Intent" - , ( "parseUri" | "setData" | "setDataAndNormalize" | "setDataAndType" + , ( "parseUri" + | "setData" + | "setDataAndNormalize" + | "setDataAndType" | "setDataAndTypeAndNormalize" ) ) -> Some (IntentFromURI, return) | ( "android.location.Location" , ("getAltitude" | "getBearing" | "getLatitude" | "getLongitude" | "getSpeed") ) -> Some (PrivateData, return) | ( "android.telephony.TelephonyManager" - , ( "getDeviceId" | "getLine1Number" | "getSimSerialNumber" | "getSubscriberId" + , ( "getDeviceId" + | "getLine1Number" + | "getSimSerialNumber" + | "getSubscriberId" | "getVoiceMailNumber" ) ) -> Some (PrivateData, return) | "com.facebook.infer.builtins.InferTaint", "inferSecretSource" -> @@ -109,7 +115,7 @@ module SourceKind = struct List.find_map ~f:(fun (procedure_regex, kind) -> if Str.string_match procedure_regex procedure 0 then Some (of_string kind, return) - else None) + else None ) external_sources ) | Typ.Procname.C _ when Typ.Procname.equal pname BuiltinDecl.__global_access -> ( match (* accessed global will be passed to us as the only parameter *) @@ -158,14 +164,27 @@ module SourceKind = struct | "android.app.Activity", ("onActivityResult" | "onNewIntent") -> Some (taint_formals_with_types ["android.content.Intent"] Intent formals) | ( "android.app.Service" - , ( "onBind" | "onRebind" | "onStart" | "onStartCommand" | "onTaskRemoved" + , ( "onBind" + | "onRebind" + | "onStart" + | "onStartCommand" + | "onTaskRemoved" | "onUnbind" ) ) -> Some (taint_formals_with_types ["android.content.Intent"] Intent formals) | "android.content.BroadcastReceiver", "onReceive" -> Some (taint_formals_with_types ["android.content.Intent"] Intent formals) | ( "android.content.ContentProvider" - , ( "bulkInsert" | "call" | "delete" | "insert" | "getType" | "openAssetFile" - | "openFile" | "openPipeHelper" | "openTypedAssetFile" | "query" | "refresh" + , ( "bulkInsert" + | "call" + | "delete" + | "insert" + | "getType" + | "openAssetFile" + | "openFile" + | "openPipeHelper" + | "openTypedAssetFile" + | "query" + | "refresh" | "update" ) ) -> Some (taint_formals_with_types ["android.net.Uri"; "java.lang.String"] @@ -212,7 +231,6 @@ module SourceKind = struct "UserControlledString" | UserControlledURI -> "UserControlledURI" ) - end module JavaSource = Source.Make (SourceKind) @@ -304,24 +322,44 @@ module SinkKind = struct | "android.app.Activity", "startIntentSenderFromChild" -> taint_nth 3 StartComponent | ( "android.content.Context" - , ( "bindService" | "sendBroadcast" | "sendBroadcastAsUser" | "sendOrderedBroadcast" - | "sendOrderedBroadcastAsUser" | "sendStickyBroadcast" - | "sendStickyBroadcastAsUser" | "sendStickyOrderedBroadcast" - | "sendStickyOrderedBroadcastAsUser" | "startActivities" | "startActivity" - | "startActivityForResult" | "startActivityIfNeeded" | "startNextMatchingActivity" - | "startService" | "stopService" ) ) -> + , ( "bindService" + | "sendBroadcast" + | "sendBroadcastAsUser" + | "sendOrderedBroadcast" + | "sendOrderedBroadcastAsUser" + | "sendStickyBroadcast" + | "sendStickyBroadcastAsUser" + | "sendStickyOrderedBroadcast" + | "sendStickyOrderedBroadcastAsUser" + | "startActivities" + | "startActivity" + | "startActivityForResult" + | "startActivityIfNeeded" + | "startNextMatchingActivity" + | "startService" + | "stopService" ) ) -> taint_nth 0 StartComponent | "android.content.Context", "startIntentSender" -> taint_nth 1 StartComponent | ( "android.content.Intent" - , ( "parseUri" | "getIntent" | "getIntentOld" | "setComponent" | "setData" - | "setDataAndNormalize" | "setDataAndType" | "setDataAndTypeAndNormalize" + , ( "parseUri" + | "getIntent" + | "getIntentOld" + | "setComponent" + | "setData" + | "setDataAndNormalize" + | "setDataAndType" + | "setDataAndTypeAndNormalize" | "setPackage" ) ) -> taint_nth 0 CreateIntent | "android.content.Intent", "setClassName" -> taint_all CreateIntent | ( "android.webkit.WebView" - , ( "evaluateJavascript" | "loadData" | "loadDataWithBaseURL" | "loadUrl" | "postUrl" + , ( "evaluateJavascript" + | "loadData" + | "loadDataWithBaseURL" + | "loadUrl" + | "postUrl" | "postWebMessage" ) ) -> taint_all JavaScript | class_name, method_name -> @@ -337,7 +375,7 @@ module SinkKind = struct with Failure _ -> (* couldn't parse the index, just taint everything *) taint_all kind - else None) + else None ) external_sinks in PatternMatch.supertype_find_map_opt tenv taint_matching_supertype @@ -369,7 +407,6 @@ module SinkKind = struct "StartComponent" | Other -> "Other" ) - end module JavaSink = Sink.Make (SinkKind) @@ -392,7 +429,7 @@ module JavaSanitizer = struct in List.find_map ~f:(fun procedure_regex -> - if Str.string_match procedure_regex procedure_string 0 then Some All else None) + if Str.string_match procedure_regex procedure_string 0 then Some All else None ) external_sanitizers | _ -> None @@ -445,5 +482,4 @@ include Trace.Make (struct | _, OpenDrawableResource | _, StartComponent -> None - end) diff --git a/infer/src/quandary/QuandaryConfig.ml b/infer/src/quandary/QuandaryConfig.ml index 488ed5a42..5d75a69fe 100644 --- a/infer/src/quandary/QuandaryConfig.ml +++ b/infer/src/quandary/QuandaryConfig.ml @@ -29,7 +29,6 @@ module Source = struct List.map ~f:parse_source sources | _ -> [] - end module Sink = struct @@ -49,7 +48,6 @@ module Sink = struct List.map ~f:parse_sink sinks | _ -> [] - end module Sanitizer = struct @@ -68,7 +66,6 @@ module Sanitizer = struct List.map ~f:parse_sanitizer sinks | _ -> [] - end module Endpoint = struct @@ -80,5 +77,4 @@ module Endpoint = struct List.map ~f:parse_endpoint endpoints | _ -> [] - end diff --git a/infer/src/quandary/QuandarySummary.ml b/infer/src/quandary/QuandarySummary.ml index 67d39ef7e..5e66eb3f0 100644 --- a/infer/src/quandary/QuandarySummary.ml +++ b/infer/src/quandary/QuandarySummary.ml @@ -23,7 +23,6 @@ module AccessTree = struct Java.pp fmt access_tree | Clang access_tree -> Clang.pp fmt access_tree - end type t = AccessTree.t diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index e0d4682a7..51bb720a7 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -195,13 +195,13 @@ module Make (TaintSpecification : TaintSpec.S) = struct List.find ~f:(fun source -> [%compare.equal : Source.Kind.t] kind (Source.kind source) - && not (is_recursive source)) + && not (is_recursive source) ) (Sources.Known.elements (sources trace).Sources.known) with | Some matching_source -> (Some access_path, matching_source) :: acc | None -> - acc) + acc ) (get_summary (CallSite.pname call_site)) [] in @@ -223,7 +223,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct List.find ~f:(fun sink -> [%compare.equal : Sink.Kind.t] kind (Sink.kind sink) - && not (is_recursive sink)) + && not (is_recursive sink) ) (Sinks.elements (sinks trace)) with | Some matching_sink -> @@ -232,7 +232,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct in (matching_sink, indexes_match) :: acc | None -> - acc) + acc ) (get_summary (CallSite.pname call_site)) [] in @@ -277,7 +277,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct pp_access_path_opt access_path_opt , CallSite.loc call_site ) in - Errlog.make_trace_element 0 loc desc []) + Errlog.make_trace_element 0 loc desc [] ) expanded_sources in let sink_trace = @@ -285,7 +285,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct ~f:(fun sink -> let call_site = Sink.call_site sink in let desc = Format.asprintf "Call to %a" Typ.Procname.pp (CallSite.pname call_site) in - Errlog.make_trace_element 0 (CallSite.loc call_site) desc []) + Errlog.make_trace_element 0 (CallSite.loc call_site) desc [] ) expanded_sinks in let _, initial_source = List.hd_exn expanded_sources in @@ -534,7 +534,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct (AccessPath.get_typ (AccessPath.Abs.extract access_path) proc_data.tenv) ~f:should_taint_typ then TraceDomain.Sources.Footprint.add_trace access_path true acc - else acc) + else acc ) sources.footprint TraceDomain.Sources.Footprint.empty in let filtered_sources = {sources with footprint= filtered_footprint} in @@ -679,7 +679,6 @@ module Make (TaintSpecification : TaintSpec.S) = struct analyze_call Domain.empty called_pname | _ -> astate - end module HilConfig : LowerHil.HilConfig = struct @@ -721,12 +720,12 @@ module Make (TaintSpecification : TaintSpec.S) = struct && Sources.Footprint.mem access_path footprint_sources && Sources.Footprint.exists (fun footprint_access_path (is_mem, _) -> - is_mem && AccessPath.Abs.equal access_path footprint_access_path) + is_mem && AccessPath.Abs.equal access_path footprint_access_path ) footprint_sources then Logging.die InternalError "The trace associated with %a consists only of its footprint source: %a" - AccessPath.Abs.pp access_path pp trace) + AccessPath.Abs.pp access_path pp trace ) access_tree @@ -751,8 +750,8 @@ module Make (TaintSpecification : TaintSpec.S) = struct node in TaintDomain.add_node footprint_access_path node' acc - else acc) - (TraceDomain.sources trace).TraceDomain.Sources.footprint access_tree_acc) + else acc ) + (TraceDomain.sources trace).TraceDomain.Sources.footprint access_tree_acc ) access_tree access_tree in (* should only be used on nodes associated with a footprint base *) @@ -798,7 +797,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct else AccessPath.BaseMap.add base' joined_node acc | None -> (* base is a local var *) - acc) + acc ) access_tree' TaintDomain.empty in if Config.developer_mode then check_invariants with_footprint_vars ; @@ -818,7 +817,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct in TaintDomain.add_trace base_ap (TraceDomain.of_source source) acc | None -> - acc) + acc ) ~init:TaintDomain.empty (TraceDomain.Source.get_tainted_formals pdesc tenv) in @@ -837,5 +836,4 @@ module Make (TaintSpecification : TaintSpec.S) = struct (Procdesc.get_proc_name proc_desc) ; summary ) else summary - end diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index be0b0e18d..dbacdc486 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -289,4 +289,3 @@ let () = Arg.parse (Arg.align speclist) add_file_to_check usage_msg ; List.iter ~f:check_copyright (List.rev !to_check) ; Pervasives.exit 0 - diff --git a/infer/src/unit/BoundedCallTreeTests.ml b/infer/src/unit/BoundedCallTreeTests.ml index 95f4b0e5a..06715ff0f 100644 --- a/infer/src/unit/BoundedCallTreeTests.ml +++ b/infer/src/unit/BoundedCallTreeTests.ml @@ -88,4 +88,3 @@ let tests = @ test_list_multiple_traces_from_foo @ test_list_multiple_traces_from_bar in "bounded_calltree_test_suite" >::: test_list - diff --git a/infer/src/unit/DifferentialFiltersTests.ml b/infer/src/unit/DifferentialFiltersTests.ml index 70a079acd..8676d6fdb 100644 --- a/infer/src/unit/DifferentialFiltersTests.ml +++ b/infer/src/unit/DifferentialFiltersTests.ml @@ -379,4 +379,3 @@ let tests = @ test_relative_complements @ test_skip_anonymous_class_renamings @ test_interesting_paths_filter @ [test_skip_duplicated_types_on_filenames; test_value_of_qualifier_tag] - diff --git a/infer/src/unit/DifferentialTestsUtils.ml b/infer/src/unit/DifferentialTestsUtils.ml index 01eb9bced..a11429b28 100644 --- a/infer/src/unit/DifferentialTestsUtils.ml +++ b/infer/src/unit/DifferentialTestsUtils.ml @@ -54,4 +54,3 @@ let pp_diff_of_int_list = pp_diff_of_list ~pp:Format.pp_print_int let sorted_hashes_of_issues issues = let hash i = i.Jsonbug_t.hash in List.sort ~cmp:String.compare (List.rev_map ~f:hash issues) - diff --git a/infer/src/unit/TaintTests.ml b/infer/src/unit/TaintTests.ml index 07ed31fd9..46988ebfe 100644 --- a/infer/src/unit/TaintTests.ml +++ b/infer/src/unit/TaintTests.ml @@ -36,7 +36,6 @@ module MockTrace = Trace.Make (struct if String.is_prefix ~prefix:"SINK" (Typ.Procname.to_string pname) then Some (CallSite.make pname Location.dummy, IntSet.singleton 0) else None - end) module Sanitizer = Sanitizer.Dummy @@ -164,4 +163,3 @@ let tests = ~initial:(MockTaintAnalysis.Domain.empty, IdAccessPathMapDomain.empty) in "taint_test_suite" >::: test_list - diff --git a/infer/src/unit/TraceTests.ml b/infer/src/unit/TraceTests.ml index 07c2414c3..79a0e9e50 100644 --- a/infer/src/unit/TraceTests.ml +++ b/infer/src/unit/TraceTests.ml @@ -85,14 +85,12 @@ module MockTrace = Trace.Make (struct if [%compare.equal : MockTraceElem.t] (Source.kind source) (Sink.kind sink) then Some IssueType.quandary_taint_error else None - end) let trace_equal t1 t2 = MockTrace.( <= ) ~lhs:t1 ~rhs:t2 && MockTrace.( <= ) ~lhs:t2 ~rhs:t1 let source_equal s source = MockSource.equal s source - let tests = let source1 = MockSource.make MockTraceElem.Kind1 CallSite.dummy in let source2 = MockSource.make MockTraceElem.Kind2 CallSite.dummy in @@ -110,12 +108,12 @@ let tests = assert_bool "Reports should contain source1 -> sink1" (List.exists ~f:(fun {MockTrace.path_source; path_sink} -> - source_equal path_source source1 && MockSink.equal path_sink sink1) + source_equal path_source source1 && MockSink.equal path_sink sink1 ) reports) ; assert_bool "Reports should contain source2 -> sink2" (List.exists ~f:(fun {MockTrace.path_source; path_sink} -> - source_equal path_source source2 && MockSink.equal path_sink sink2) + source_equal path_source source2 && MockSink.equal path_sink sink2 ) reports) in "get_reports" >:: get_reports_ diff --git a/infer/src/unit/abstractInterpreterTests.ml b/infer/src/unit/abstractInterpreterTests.ml index 46fc62825..cf1ba533d 100644 --- a/infer/src/unit/abstractInterpreterTests.ml +++ b/infer/src/unit/abstractInterpreterTests.ml @@ -131,4 +131,3 @@ let tests = |> ExceptionalTestInterpreter.create_tests ProcData.empty_extras ~initial in "analyzer_tests_suite" >::: normal_test_list @ exceptional_test_list - diff --git a/infer/src/unit/accessPathTestUtils.ml b/infer/src/unit/accessPathTestUtils.ml index 345ecacb9..ebdd2f6fe 100644 --- a/infer/src/unit/accessPathTestUtils.ml +++ b/infer/src/unit/accessPathTestUtils.ml @@ -21,4 +21,3 @@ let make_array_access typ = AccessPath.ArrayAccess (typ, []) let make_access_path base_str access_strs = (make_base base_str, List.map ~f:make_field_access access_strs) - diff --git a/infer/src/unit/accessPathTests.ml b/infer/src/unit/accessPathTests.ml index c21cc1f4b..71995d252 100644 --- a/infer/src/unit/accessPathTests.ml +++ b/infer/src/unit/accessPathTests.ml @@ -180,4 +180,3 @@ let tests = in "all_tests_suite" >::: [equal_test; append_test; prefix_test; of_exp_test; abstraction_test; domain_test] - diff --git a/infer/src/unit/accessTreeTests.ml b/infer/src/unit/accessTreeTests.ml index 260e1d3ea..f491c5e8f 100644 --- a/infer/src/unit/accessTreeTests.ml +++ b/infer/src/unit/accessTreeTests.ml @@ -59,7 +59,6 @@ module MakeTree (Config : AccessTree.Config) = struct F.fprintf fmt "Expected to get tree %a but got %a" pp expected pp actual in OUnit2.assert_equal ~cmp:base_tree_equal ~pp_diff tree1 tree2 - end module Domain = MakeTree (AccessTree.DefaultConfig) @@ -406,7 +405,7 @@ let tests = let has_ap_trace_pair ap_in trace_in = List.exists ~f:(fun (ap, trace) -> - AccessPath.Abs.equal ap ap_in && MockTraceDomain.equal trace trace_in) + AccessPath.Abs.equal ap ap_in && MockTraceDomain.equal trace trace_in ) ap_traces in assert_bool "Should have six ap/trace pairs" (Int.equal (List.length ap_traces) 6) ; @@ -528,4 +527,3 @@ let tests = ; depth_test ; max_depth_test ; max_width_test ] - diff --git a/infer/src/unit/addressTakenTests.ml b/infer/src/unit/addressTakenTests.ml index ef260cd18..6d496afdb 100644 --- a/infer/src/unit/addressTakenTests.ml +++ b/infer/src/unit/addressTakenTests.ml @@ -64,4 +64,3 @@ let tests = |> TestInterpreter.create_tests ProcData.empty_extras ~initial:AddressTaken.Domain.empty in "address_taken_suite" >::: test_list - diff --git a/infer/src/unit/analyzerTester.ml b/infer/src/unit/analyzerTester.ml index 3bbe6b833..f296203c4 100644 --- a/infer/src/unit/analyzerTester.ml +++ b/infer/src/unit/analyzerTester.ml @@ -296,7 +296,6 @@ struct let open OUnit2 in List.map ~f:(fun (name, test_program) -> - name >:: create_test test_program extras ~initial pp_opt test_pname) + name >:: create_test test_program extras ~initial pp_opt test_pname ) tests - end diff --git a/infer/src/unit/clang/ClangTests.ml b/infer/src/unit/clang/ClangTests.ml index 8a4094e3d..9cb4d4c19 100644 --- a/infer/src/unit/clang/ClangTests.ml +++ b/infer/src/unit/clang/ClangTests.ml @@ -10,4 +10,3 @@ open! IStd let tests = [CiOSVersionNumbersTests.tests; QualifiedCppNameTests.tests; CFrontend_errorsTests.tests] - diff --git a/infer/src/unit/inferunit.ml b/infer/src/unit/inferunit.ml index 360322c4a..719f521ff 100644 --- a/infer/src/unit/inferunit.ml +++ b/infer/src/unit/inferunit.ml @@ -45,4 +45,3 @@ let () = in let test_suite = "all" >::: tests in OUnit2.run_test_tt_main test_suite - diff --git a/infer/src/unit/livenessTests.ml b/infer/src/unit/livenessTests.ml index f2d97dc9b..05aeb7a47 100644 --- a/infer/src/unit/livenessTests.ml +++ b/infer/src/unit/livenessTests.ml @@ -104,4 +104,3 @@ let tests = |> TestInterpreter.create_tests ProcData.empty_extras ~initial:Liveness.Domain.empty in "liveness_test_suite" >::: test_list - diff --git a/infer/src/unit/procCfgTests.ml b/infer/src/unit/procCfgTests.ml index 567f182fe..00848f16f 100644 --- a/infer/src/unit/procCfgTests.ml +++ b/infer/src/unit/procCfgTests.ml @@ -161,4 +161,3 @@ let tests = in let tests = instr_test :: graph_tests in "procCfgSuite" >::: tests - diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index ab2c8f549..d8dc83be4 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -127,4 +127,3 @@ let tests = |> List.map ~f:(fun (name, test, expected) -> name >:: create_test test expected) in "scheduler_suite" >::: test_list - diff --git a/infer/src/unit/stacktraceTests.ml b/infer/src/unit/stacktraceTests.ml index 39cc82386..b9cf0e2e0 100644 --- a/infer/src/unit/stacktraceTests.ml +++ b/infer/src/unit/stacktraceTests.ml @@ -82,4 +82,3 @@ let tests = ; one_frame_trace_test ; multi_frame_trace_test ; missing_line_info_test ] - diff --git a/opam.lock b/opam.lock index bde3446fa..94dd127b7 100644 --- a/opam.lock +++ b/opam.lock @@ -1,9 +1,9 @@ -ANSITerminal = 0.7 +ANSITerminal = 0.8 atd = 1.12.0 atdgen = 1.12.0 -base = v0.9.3 +base = v0.10.0 base64 = 2.2.0 -bin_prot = v0.9.1 +bin_prot = v0.10.0 biniou = 1.2.0 camlp4 = 4.05+1 camlzip = 1.07 @@ -13,72 +13,72 @@ conf-autoconf = 0.1 conf-m4 = 1 conf-pkg-config = 1.0 conf-which = 1 -configurator = v0.9.1 -core = v0.9.1 -core_kernel = v0.9.0 +configurator = v0.10.0 +core = v0.10.0 +core_kernel = v0.10.0 cppo = 1.6.0 cppo_ocamlbuild = 1.6.0 -ctypes = 0.13.0 +ctypes = 0.13.1 easy-format = 1.3.0 extlib-compat = 1.7.2 -fieldslib = v0.9.0 +fieldslib = v0.10.0 integers = 0.2.2 -jane-street-headers = v0.9.0 +jane-street-headers = v0.10.0 javalib = 2.3.4 -jbuilder = 1.0+beta14 -menhir = 20170712 +jbuilder = 1.0+beta16 +menhir = 20171206 mtime = 1.1.0 num = 0 -ocaml-compiler-libs = v0.9.0 -ocaml-migrate-parsetree = 1.0.6 -ocamlbuild = 0.11.0 +ocaml-compiler-libs = v0.10.0 +ocaml-migrate-parsetree = 1.0.7 +ocamlbuild = 0.12.0 ocamlfind = 1.7.3 -octavius = 1.1.0 +octavius = 1.2.0 ounit = 2.0.5 parmap = 1.0-rc8 -ppx_assert = v0.9.0 -ppx_ast = v0.9.1 -ppx_base = v0.9.0 -ppx_bench = v0.9.1 -ppx_bin_prot = v0.9.0 -ppx_compare = v0.9.0 -ppx_core = v0.9.0 -ppx_custom_printf = v0.9.0 +ppx_assert = v0.10.0 +ppx_ast = v0.10.0 +ppx_base = v0.10.0 +ppx_bench = v0.10.0 +ppx_bin_prot = v0.10.0 +ppx_compare = v0.10.0 +ppx_core = v0.10.0 +ppx_custom_printf = v0.10.0 ppx_derivers = 1.0 -ppx_deriving = 4.2 -ppx_driver = v0.9.1 -ppx_enumerate = v0.9.0 -ppx_expect = v0.9.0 -ppx_fail = v0.9.0 -ppx_fields_conv = v0.9.0 -ppx_hash = v0.9.0 -ppx_here = v0.9.1 -ppx_inline_test = v0.9.2 -ppx_jane = v0.9.0 -ppx_js_style = v0.9.0 -ppx_let = v0.9.0 -ppx_metaquot = v0.9.0 -ppx_optcomp = v0.9.0 -ppx_optional = v0.9.0 -ppx_pipebang = v0.9.0 -ppx_sexp_conv = v0.9.0 -ppx_sexp_message = v0.9.0 -ppx_sexp_value = v0.9.0 +ppx_deriving = 4.2.1 +ppx_driver = v0.10.1 +ppx_enumerate = v0.10.0 +ppx_expect = v0.10.0 +ppx_fail = v0.10.0 +ppx_fields_conv = v0.10.0 +ppx_hash = v0.10.0 +ppx_here = v0.10.0 +ppx_inline_test = v0.10.0 +ppx_jane = v0.10.0 +ppx_js_style = v0.10.0 +ppx_let = v0.10.0 +ppx_metaquot = v0.10.0 +ppx_optcomp = v0.10.0 +ppx_optional = v0.10.0 +ppx_pipebang = v0.10.0 +ppx_sexp_conv = v0.10.0 +ppx_sexp_message = v0.10.0 +ppx_sexp_value = v0.10.0 ppx_tools = 5.0+4.05.0 -ppx_traverse = v0.9.0 -ppx_traverse_builtins = v0.9.0 -ppx_type_conv = v0.9.0 -ppx_typerep_conv = v0.9.0 -ppx_variants_conv = v0.9.0 +ppx_traverse = v0.10.0 +ppx_traverse_builtins = v0.10.0 +ppx_type_conv = v0.10.0 +ppx_typerep_conv = v0.10.0 +ppx_variants_conv = v0.10.0 re = 1.7.1 result = 1.2 sawja = 1.5.2 -sexplib = v0.9.2 -spawn = v0.9.0 -sqlite3 = 4.2.0 -stdio = v0.9.0 -topkg = 0.9.0 -typerep = v0.9.0 -variantslib = v0.9.0 +sexplib = v0.10.0 +spawn = v0.10.1 +sqlite3 = 4.3.2 +stdio = v0.10.0 +topkg = 0.9.1 +typerep = v0.10.0 +variantslib = v0.10.0 xmlm = 1.3.0 yojson = 1.4.0 diff --git a/scripts/ocamlformat.sh b/scripts/ocamlformat.sh deleted file mode 100755 index ff4502ffd..000000000 --- a/scripts/ocamlformat.sh +++ /dev/null @@ -1,24 +0,0 @@ -#!/bin/bash - -# Copyright (c) 2016 - present Facebook, Inc. -# All rights reserved. -# -# This source code is licensed under the BSD style license found in the -# LICENSE file in the root directory of this source tree. An additional grant -# of patent rights can be found in the PATENTS file in the same directory. - - -# ocamlformat wrapper to appease ArcanistExternalLinter - -set -e -set -o pipefail - -SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" - -OCAMLFORMAT=ocamlformat - -TMPFILE=$(mktemp) - -"$OCAMLFORMAT" -o "$TMPFILE" "$@" - -cat "$TMPFILE"