diff --git a/.ocamlformat b/.ocamlformat index e4b3bac91..c7e7d3a96 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ +profile = ocamlformat let-binding-spacing = sparse -break-cases = nested margin = 100 -version = 0.8 +version = 0.9 diff --git a/.ocamlformat.hash b/.ocamlformat.hash index b82d648e7..1eaca48e0 100644 --- a/.ocamlformat.hash +++ b/.ocamlformat.hash @@ -1 +1 @@ -e2cf2fd21fdc2f79840ddf994403a0c2469b6bfd +9006560863e9323b8ee3e4d78fd0e799fe10259c diff --git a/Makefile b/Makefile index 2d51a50d9..b044ff0fb 100644 --- a/Makefile +++ b/Makefile @@ -803,7 +803,7 @@ endif # This is a magical version number that doesn't reinstall the world when added on top of what we # have in opam.locked. To upgrade this version number, manually try to install several utop versions # until you find one that doesn't recompile the world. TODO(t20828442): get rid of magic -OPAM_DEV_DEPS = ocamlformat.0.8 ocp-indent merlin utop.2.2.0 webbrowser +OPAM_DEV_DEPS = ocamlformat.$$(grep version .ocamlformat | cut -d ' ' -f 3) ocp-indent merlin utop.2.2.0 webbrowser ifneq ($(EMACS),no) OPAM_DEV_DEPS += tuareg diff --git a/infer/src/IR/Errlog.ml b/infer/src/IR/Errlog.ml index eb6579c4d..ed0f51a2b 100644 --- a/infer/src/IR/Errlog.ml +++ b/infer/src/IR/Errlog.ml @@ -101,8 +101,8 @@ type err_data = ; linters_def_file: string option ; doc_url: string option ; access: string option - ; extras: Jsonbug_t.extra option - (* NOTE: Please consider adding new fields as part of extras *) } + ; extras: Jsonbug_t.extra option (* NOTE: Please consider adding new fields as part of extras *) + } let compare_err_data err_data1 err_data2 = Location.compare err_data1.loc err_data2.loc diff --git a/infer/src/IR/Ident.ml b/infer/src/IR/Ident.ml index f5544ba0f..19abf4e96 100644 --- a/infer/src/IR/Ident.ml +++ b/infer/src/IR/Ident.ml @@ -251,7 +251,7 @@ end) let hashqueue_of_sequence ?init s = let q = match init with None -> HashQueue.create () | Some q0 -> q0 in Sequence.iter s ~f:(fun id -> - let _ : [`Key_already_present | `Ok] = HashQueue.enqueue q id () in + let (_ : [`Key_already_present | `Ok]) = HashQueue.enqueue q id () in () ) ; q diff --git a/infer/src/IR/IssueLog.ml b/infer/src/IR/IssueLog.ml index 6044ff60d..7134b40c3 100644 --- a/infer/src/IR/IssueLog.ml +++ b/infer/src/IR/IssueLog.ml @@ -12,7 +12,8 @@ open! IStd let errLogMap = ref Typ.Procname.Map.empty let get_errlog procname = - try Typ.Procname.Map.find procname !errLogMap with Caml.Not_found -> + try Typ.Procname.Map.find procname !errLogMap + with Caml.Not_found -> let errlog = Errlog.empty () in errLogMap := Typ.Procname.Map.add procname errlog !errLogMap ; errlog diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index 69a3682e8..55ae063e8 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -105,9 +105,7 @@ let get_value_line_tag tags = let value = snd (List.find_exn ~f:(fun (tag, _) -> String.equal tag Tags.value) tags) in let line = snd (List.find_exn ~f:(fun (tag, _) -> String.equal tag Tags.line) tags) in Some [value; line] - with - | Not_found_s _ | Caml.Not_found -> - None + with Not_found_s _ | Caml.Not_found -> None (** extract from desc a value on which to apply polymorphic hash and equality *) @@ -630,7 +628,8 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc match bucket_opt with Some bucket when Config.show_buckets -> bucket | _ -> "" in { no_desc with - descriptions= (bucket_str :: xxx_allocated_to) @ by_call_to @ is_not_rxxx_after; tags= !tags } + descriptions= (bucket_str :: xxx_allocated_to) @ by_call_to @ is_not_rxxx_after + ; tags= !tags } (** kind of precondition not met *) diff --git a/infer/src/IR/Procdesc.ml b/infer/src/IR/Procdesc.ml index 1e6c75eee..57c944ce1 100644 --- a/infer/src/IR/Procdesc.ml +++ b/infer/src/IR/Procdesc.ml @@ -447,7 +447,7 @@ let compute_distance_to_exit_node pdesc = (** check or indicate if we have performed preanalysis on the CFG *) let did_preanalysis pdesc = pdesc.attributes.did_preanalysis -let signal_did_preanalysis pdesc = (pdesc.attributes).did_preanalysis <- true +let signal_did_preanalysis pdesc = pdesc.attributes.did_preanalysis <- true let get_attributes pdesc = pdesc.attributes @@ -546,7 +546,7 @@ let set_start_node pdesc node = pdesc.start_node <- node (** Append the locals to the list of local variables *) let append_locals pdesc new_locals = - (pdesc.attributes).locals <- pdesc.attributes.locals @ new_locals + pdesc.attributes.locals <- pdesc.attributes.locals @ new_locals let set_succs_exn_only (node : Node.t) exn = node.exn <- exn @@ -622,7 +622,7 @@ let get_wto pdesc = wto | None -> let wto = WTO.make pdesc in - let _ : int = + let (_ : int) = WeakTopologicalOrder.Partition.fold_nodes wto ~init:0 ~f:(fun idx node -> node.Node.wto_index <- idx ; idx + 1 ) diff --git a/infer/src/IR/ProcnameDispatcher.ml b/infer/src/IR/ProcnameDispatcher.ml index 389cae900..694632dcf 100644 --- a/infer/src/IR/ProcnameDispatcher.ml +++ b/infer/src/IR/ProcnameDispatcher.ml @@ -76,14 +76,21 @@ type ( 'f_in , 'captured_types_out , 'markers_in , 'markers_out - , 'list_constraint ) template_arg = + , 'list_constraint ) + template_arg = { eat_template_arg: 'f_in * 'captured_types_in capt * Typ.template_arg list -> ('f_out * 'captured_types_out capt * Typ.template_arg list) option ; add_marker: 'markers_in -> 'markers_out } -type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher - = +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher = { on_objc_cpp: 'context -> 'f_in diff --git a/infer/src/IR/ProcnameDispatcher.mli b/infer/src/IR/ProcnameDispatcher.mli index d2cdb4d80..cf01439cd 100644 --- a/infer/src/IR/ProcnameDispatcher.mli +++ b/infer/src/IR/ProcnameDispatcher.mli @@ -33,9 +33,17 @@ type ( 'f_in , 'captured_types_out , 'markers_in , 'markers_out - , 'list_constraint ) template_arg + , 'list_constraint ) + template_arg -type ('context, 'f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, 'list_constraint) templ_matcher +type ( 'context + , 'f_in + , 'f_out + , 'captured_types + , 'markers_in + , 'markers_out + , 'list_constraint ) + templ_matcher (* A matcher is a rule associating a function [f] to a [C/C++ function/method]: - [C/C++ function/method] --> [f] diff --git a/infer/src/IR/Sil.ml b/infer/src/IR/Sil.ml index 2f996cbe9..16551e018 100644 --- a/infer/src/IR/Sil.ml +++ b/infer/src/IR/Sil.ml @@ -1408,7 +1408,8 @@ let hpred_compact_ sh hpred = let hpred_compact sh hpred = - try HpredInstHash.find sh.hpredh hpred with Caml.Not_found -> + try HpredInstHash.find sh.hpredh hpred + with Caml.Not_found -> let hpred' = hpred_compact_ sh hpred in HpredInstHash.add sh.hpredh hpred' hpred' ; hpred' diff --git a/infer/src/IR/SpecializeProcdesc.ml b/infer/src/IR/SpecializeProcdesc.ml index 7a7e8b066..dc0e3c29b 100644 --- a/infer/src/IR/SpecializeProcdesc.ml +++ b/infer/src/IR/SpecializeProcdesc.ml @@ -23,7 +23,8 @@ let convert_cfg ~callee_pdesc ~resolved_pdesc ~f_instr_list = [] | node :: other_node -> let converted_node = - try Procdesc.NodeMap.find node !node_map with Caml.Not_found -> + try Procdesc.NodeMap.find node !node_map + with Caml.Not_found -> let new_node = convert_node node and successors = Procdesc.Node.get_succs node and exn_nodes = Procdesc.Node.get_exn node in @@ -67,8 +68,8 @@ let with_formals_types_proc callee_pdesc resolved_pdesc substitutions = , {Typ.desc= Tptr ({desc= Tstruct origin_typename}, Pk_pointer)} , loc ) -> let specialized_typname = - try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions with Caml.Not_found -> - origin_typename + try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions + with Caml.Not_found -> origin_typename in subst_map := Ident.Map.add id specialized_typname !subst_map ; Some (Sil.Load (id, convert_exp origin_exp, mk_ptr_typ specialized_typname, loc)) diff --git a/infer/src/IR/Subtype.ml b/infer/src/IR/Subtype.ml index 63741e3b1..99712b8c5 100644 --- a/infer/src/IR/Subtype.ml +++ b/infer/src/IR/Subtype.ml @@ -84,7 +84,8 @@ end) let check_subtype = let subtMap = ref SubtypesMap.empty in fun tenv c1 c2 -> - ( try SubtypesMap.find (c1, c2) !subtMap with Caml.Not_found -> + ( try SubtypesMap.find (c1, c2) !subtMap + with Caml.Not_found -> let is_subt = check_subclass_tenv tenv c1 c2 in subtMap := SubtypesMap.add (c1, c2) is_subt !subtMap ; is_subt diff --git a/infer/src/IR/Tenv.ml b/infer/src/IR/Tenv.ml index 6a25032df..44638b105 100644 --- a/infer/src/IR/Tenv.ml +++ b/infer/src/IR/Tenv.ml @@ -45,7 +45,8 @@ let mk_struct tenv ?default ?fields ?statics ?methods ?exported_objc_methods ?su (** Look up a name in the global type environment. *) let lookup tenv name : Typ.Struct.t option = - try Some (TypenameHash.find tenv name) with Caml.Not_found -> ( + try Some (TypenameHash.find tenv name) + with Caml.Not_found -> ( (* ToDo: remove the following additional lookups once C/C++ interop is resolved *) match (name : Typ.Name.t) with | CStruct m -> ( diff --git a/infer/src/absint/AbstractDomain.ml b/infer/src/absint/AbstractDomain.ml index cd2f8430e..d2b30cc42 100644 --- a/infer/src/absint/AbstractDomain.ml +++ b/infer/src/absint/AbstractDomain.ml @@ -567,7 +567,7 @@ struct None | Some s -> let s' = S.remove v s in - if S.is_empty s' then None else Some s') + if S.is_empty s' then None else Some s' ) m end diff --git a/infer/src/backend/InferPrint.ml b/infer/src/backend/InferPrint.ml index 420ebe146..9720b9f96 100644 --- a/infer/src/backend/InferPrint.ml +++ b/infer/src/backend/InferPrint.ml @@ -499,8 +499,8 @@ module Stats = struct let process_loc loc stats = - try Hashtbl.find stats.files loc.Location.file with Caml.Not_found -> - Hashtbl.add stats.files loc.Location.file () + try Hashtbl.find stats.files loc.Location.file + with Caml.Not_found -> Hashtbl.add stats.files loc.Location.file () let loc_trace_to_string_list linereader indent_num ltr = diff --git a/infer/src/backend/Summary.ml b/infer/src/backend/Summary.ml index c10976480..2a8d4daf3 100644 --- a/infer/src/backend/Summary.ml +++ b/infer/src/backend/Summary.ml @@ -190,8 +190,8 @@ let load_summary_to_spec_table = let get proc_name = - try Some (Typ.Procname.Hash.find cache proc_name) with Caml.Not_found -> - load_summary_to_spec_table proc_name + try Some (Typ.Procname.Hash.find cache proc_name) + with Caml.Not_found -> load_summary_to_spec_table proc_name (** Check if the procedure is from a library: diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index 53c2cdd53..b0d6e4f36 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -47,7 +47,7 @@ module Runner = struct ProcessPool.create ~jobs ~f ~child_prelude: ((* hack: run post-fork bookkeeping stuff by passing a dummy function to [fork_protect] *) - fork_protect ~f:(fun () -> () )) + fork_protect ~f:(fun () -> ())) in ResultsDatabase.new_database_connection () ; PerfEvent.(log (fun logger -> log_end_event logger ())) ; diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 8df473c0e..a63ca0b10 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -112,7 +112,8 @@ let strip_special_chars b = let replace st c c' = 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 _ -> + try Bytes.set st idx c' ; st + with Invalid_argument _ -> L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ; assert false ) else st diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 3c6e8181d..8f5f117b7 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -41,7 +41,8 @@ type t = ; file_map: file_data SourceFile.Hash.t (** map from source files to file data *) } let get_file_data exe_env pname = - try Some (Typ.Procname.Hash.find exe_env.proc_map pname) with Caml.Not_found -> + try Some (Typ.Procname.Hash.find exe_env.proc_map pname) + with Caml.Not_found -> let source_file_opt = match Attributes.load pname with | None -> diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index 9abb6ded5..26b8ce608 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -73,7 +73,8 @@ module FileContainsStringMatcher = struct let source_map = ref SourceFile.Map.empty in let regexp = Str.regexp (String.concat ~sep:"\\|" s_patterns) in fun source_file -> - try SourceFile.Map.find source_file !source_map with Caml.Not_found -> ( + try SourceFile.Map.find source_file !source_map + with Caml.Not_found -> ( try let file_in = In_channel.create (SourceFile.to_abs_path source_file) in let pattern_found = file_contains regexp file_in in @@ -102,9 +103,8 @@ module FileOrProcMatcher = struct List.fold ~f:(fun map pattern -> let previous = - try String.Map.find_exn map pattern.class_name with - | Not_found_s _ | Caml.Not_found -> - [] + try String.Map.find_exn map pattern.class_name + with Not_found_s _ | Caml.Not_found -> [] in String.Map.set ~key:pattern.class_name ~data:(pattern :: previous) map ) ~init:String.Map.empty m_patterns @@ -118,9 +118,7 @@ module FileOrProcMatcher = struct ~f:(fun p -> match p.method_name with None -> true | Some m -> String.equal m method_name ) class_patterns - with - | Not_found_s _ | Caml.Not_found -> - false + with Not_found_s _ | Caml.Not_found -> false in fun _ proc_name -> match proc_name with Typ.Procname.Java pname_java -> do_java pname_java | _ -> false diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index a13ec0da2..03714bb4a 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -248,7 +248,8 @@ let analyze_proc_desc ~caller_pdesc callee_pdesc = if is_active callee_pname then None else let cache = Lazy.force cached_results in - try Typ.Procname.Hash.find cache callee_pname with Caml.Not_found -> + try Typ.Procname.Hash.find cache callee_pname + with Caml.Not_found -> let summary_option, update_memcached = match memcache_get callee_pname with | Some summ_opt -> @@ -279,7 +280,8 @@ let analyze_proc_name ?caller_pdesc callee_pname = if is_active callee_pname then None else let cache = Lazy.force cached_results in - try Typ.Procname.Hash.find cache callee_pname with Caml.Not_found -> + try Typ.Procname.Hash.find cache callee_pname + with Caml.Not_found -> let summary_option, update_memcached = match memcache_get callee_pname with | Some summ_opt -> diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index 96d920325..fea014c5f 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -43,7 +43,8 @@ module LineReader = struct let file_data (hash : t) fname = - try Some (Hashtbl.find hash fname) with Caml.Not_found -> ( + try Some (Hashtbl.find hash fname) + with Caml.Not_found -> ( try let lines_arr = read_file (SourceFile.to_abs_path fname) in Hashtbl.add hash fname lines_arr ; Some lines_arr diff --git a/infer/src/base/CommandLineOption.ml b/infer/src/base/CommandLineOption.ml index e27e7b850..305546b46 100644 --- a/infer/src/base/CommandLineOption.ml +++ b/infer/src/base/CommandLineOption.ml @@ -281,7 +281,8 @@ let mk ?(deprecated = []) ?(parse_mode = InferCommand) ?(in_help = []) ~long ?sh let variable = ref default in let closure = mk_setter variable in let setter str = - try closure str with exc -> + try closure str + with exc -> raise (Arg.Bad (F.sprintf "bad value %s for flag %s (%s)" str long (Exn.to_string exc))) in let spec = mk_spec setter in @@ -1000,8 +1001,8 @@ let wrap_line indent_string wrap_length line0 = 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 *) - - 1 (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *) + len - 4 (* length of formatting tag prefix *) - 1 + (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *) else len in let new_length = line_length + String.length word_sep_str + word_length in @@ -1045,8 +1046,7 @@ let show_manual ?internal_section format default_doc command_opt = blocks, so we do a bit of formatting by hand *) let indent_string = " " in let width = - 77 (* Cmdliner.Manpage width limit it seems *) - - 7 + 77 (* Cmdliner.Manpage width limit it seems *) - 7 (* base indentation of documentation strings *) in `I (Format.asprintf "$(b,%s)%a%a" (dashdash long) pp_short short pp_meta meta, doc_first_line) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 9a55ff4f6..2defff0b2 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -108,19 +108,19 @@ let string_of_build_system build_system = let build_system_of_exe_name name = - try List.Assoc.find_exn ~equal:String.equal (List.Assoc.inverse build_system_exe_assoc) name with - | Not_found_s _ | Caml.Not_found -> - L.(die UserError) - "Unsupported build command '%s'.@\n\ - If this is an alias for another build system that infer supports, you can use@\n\ - `--force-integration ` where is one of the following supported build \ - systems:@\n\ - @[ %a@]" - name - (Pp.seq ~print_env:Pp.text_break ~sep:"" F.pp_print_string) - ( List.map ~f:fst build_system_exe_assoc - |> List.map ~f:string_of_build_system - |> List.dedup_and_sort ~compare:String.compare ) + try List.Assoc.find_exn ~equal:String.equal (List.Assoc.inverse build_system_exe_assoc) name + with Not_found_s _ | Caml.Not_found -> + L.(die UserError) + "Unsupported build command '%s'.@\n\ + If this is an alias for another build system that infer supports, you can use@\n\ + `--force-integration ` where is one of the following supported build \ + systems:@\n\ + @[ %a@]" + name + (Pp.seq ~print_env:Pp.text_break ~sep:"" F.pp_print_string) + ( List.map ~f:fst build_system_exe_assoc + |> List.map ~f:string_of_build_system + |> List.dedup_and_sort ~compare:String.compare ) (** Constant configuration values *) @@ -682,7 +682,7 @@ and ( annotation_reachability and starvation = mk_checker ~long:"starvation" ~default:false "starvation analysis" and uninit = mk_checker ~long:"uninit" "checker for use of uninitialized values" ~default:true in let mk_only (var, long, doc, _) = - let _ : bool ref = + let (_ : bool ref) = CLOpt.mk_bool_group ~long:(long ^ "-only") ~in_help:InferCommand.[(Analyze, manual_generic)] ~f:(fun b -> @@ -691,8 +691,7 @@ and ( annotation_reachability b ) ( if String.equal doc "" then "" else Printf.sprintf "Enable $(b,--%s) and disable all other checkers" long ) - [] (* do all the work in ~f *) - [] + [] (* do all the work in ~f *) [] (* do all the work in ~f *) in () @@ -714,8 +713,7 @@ and ( annotation_reachability var := if b then default || !var else (not default) && !var ) !all_checkers ; b ) - [] (* do all the work in ~f *) - [] + [] (* do all the work in ~f *) [] (* do all the work in ~f *) in ( annotation_reachability @@ -1099,7 +1097,7 @@ and ( bo_debug ; write_html ; write_dotty ] [filtering; only_cheap_debug] - and _ : int option ref = + and (_ : int option ref) = CLOpt.mk_int_opt ~long:"debug-level" ~in_help:all_generic_manuals ~meta:"level" ~f:(fun level -> set_debug_level level ; level) {|Debug level (sets $(b,--bo-debug) $(i,level), $(b,--debug-level-analysis) $(i,level), $(b,--debug-level-capture) $(i,level), $(b,--debug-level-linters) $(i,level)): @@ -1196,7 +1194,7 @@ and differential_filter_set = and () = let mk b ?deprecated ~long ?default doc = - let _ : string list ref = + let (_ : string list ref) = CLOpt.mk_string_list ?deprecated ~long ~f:(fun issue_id -> let issue = IssueType.from_string issue_id in @@ -2074,7 +2072,7 @@ and specs_library = CLOpt.mk_path_list ~deprecated:["lib"] ~long:"specs-library" ~short:'L' ~meta:"dir|jar" "Search for .spec files in given directory or jar file" in - let _ : string ref = + let (_ : string ref) = (* Given a filename with a list of paths, convert it into a list of string iff they are absolute *) let read_specs_dir_list_file fname = diff --git a/infer/src/base/Epilogues.ml b/infer/src/base/Epilogues.ml index 90e6f66c2..54898d310 100644 --- a/infer/src/base/Epilogues.ml +++ b/infer/src/base/Epilogues.ml @@ -13,7 +13,8 @@ let late_callback = ref (fun () -> ()) let register callback_ref ~f ~description = let f_no_exn () = - try f () with exn -> + try f () + with exn -> F.eprintf "%a: Error while running epilogue \"%s\":@ %a.@ Powering through...@." Pid.pp (Unix.getpid ()) description Exn.pp exn in diff --git a/infer/src/base/Memcached.ml b/infer/src/base/Memcached.ml index 5888a6a35..7e143ccaa 100644 --- a/infer/src/base/Memcached.ml +++ b/infer/src/base/Memcached.ml @@ -152,7 +152,8 @@ module Make (V : Value) : Server with module Value = V = struct let set_ = let buffer = ref (Bytes.create 1024) in let rec try_to_buffer value = - try Marshal.to_buffer !buffer 0 (Bytes.length !buffer) value [] with Failure _ -> + try Marshal.to_buffer !buffer 0 (Bytes.length !buffer) value [] + with Failure _ -> (* double buffer length *) buffer := Bytes.create (2 * Bytes.length !buffer) ; try_to_buffer value diff --git a/infer/src/base/Multilinks.ml b/infer/src/base/Multilinks.ml index a80decc3c..bb2487a81 100644 --- a/infer/src/base/Multilinks.ml +++ b/infer/src/base/Multilinks.ml @@ -48,9 +48,8 @@ let write multilinks ~dir = let lookup ~dir = - try Some (String.Table.find_exn multilink_files_cache dir) with - | Not_found_s _ | Caml.Not_found -> - read ~dir + try Some (String.Table.find_exn multilink_files_cache dir) + with Not_found_s _ | Caml.Not_found -> read ~dir let resolve fname = @@ -63,6 +62,5 @@ let resolve fname = | None -> fname | Some links -> ( - try DB.filename_from_string (String.Table.find_exn links base) with - | Not_found_s _ | Caml.Not_found -> - fname ) + try DB.filename_from_string (String.Table.find_exn links base) + with Not_found_s _ | Caml.Not_found -> fname ) diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index 9c1d899ad..645800bbe 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -124,7 +124,8 @@ let killall pool ~slot status = Array.iter pool.slots ~f:(fun {pid} -> match Signal.send Signal.term (`Pid pid) with `Ok | `No_such_process -> () ) ; Array.iter pool.slots ~f:(fun {pid} -> - try Unix.wait (`Pid pid) |> ignore with Unix.Unix_error (ECHILD, _, _) -> + try Unix.wait (`Pid pid) |> ignore + with Unix.Unix_error (ECHILD, _, _) -> (* some children may have died already, it's fine *) () ) ; L.die InternalError "Subprocess %d: %s" slot status @@ -197,7 +198,8 @@ let rec child_loop ~slot send_to_parent receive_from_parent ~f = | GoHome -> () | Do stuff -> - ( try f stuff with e -> + ( try f stuff + with e -> IExn.reraise_if e ~f:(fun () -> if Config.keep_going then ( L.internal_error "Error in subprocess %d: %a@." slot Exn.pp e ; diff --git a/infer/src/base/ResultsDatabase.ml b/infer/src/base/ResultsDatabase.ml index fe70ec0cd..78d6014fb 100644 --- a/infer/src/base/ResultsDatabase.ml +++ b/infer/src/base/ResultsDatabase.ml @@ -59,8 +59,8 @@ let create_db () = (* Can't use WAL with custom VFS *) () ) ; SqliteUtils.db_close db ; - try Sys.rename temp_db database_fullpath with Sys_error _ -> - (* lost the race, doesn't matter *) () + try Sys.rename temp_db database_fullpath + with Sys_error _ -> (* lost the race, doesn't matter *) () let new_db_callbacks = ref [] @@ -78,7 +78,8 @@ let register_statement = let stmt_ref = ref None in let new_statement db = let stmt = - try Sqlite3.prepare db stmt0 with Sqlite3.Error error -> + try Sqlite3.prepare db stmt0 + with Sqlite3.Error error -> L.die InternalError "Could not prepare the following statement:@\n%s@\nReason: %s" stmt0 error in diff --git a/infer/src/base/SourceFile.ml b/infer/src/base/SourceFile.ml index 20bcee77d..9a5778a57 100644 --- a/infer/src/base/SourceFile.ml +++ b/infer/src/base/SourceFile.ml @@ -139,11 +139,11 @@ let is_under_project_root = function let exists_cache = String.Table.create ~size:256 () let path_exists abs_path = - try String.Table.find_exn exists_cache abs_path with - | Not_found_s _ | Caml.Not_found -> - let result = Sys.file_exists abs_path = `Yes in - String.Table.set exists_cache ~key:abs_path ~data:result ; - result + try String.Table.find_exn exists_cache abs_path + with Not_found_s _ | Caml.Not_found -> + let result = Sys.file_exists abs_path = `Yes in + String.Table.set exists_cache ~key:abs_path ~data:result ; + result let of_header ?(warn_on_error = true) header_file = diff --git a/infer/src/base/SqliteUtils.ml b/infer/src/base/SqliteUtils.ml index 1d5ce15e9..d7c2c2c2b 100644 --- a/infer/src/base/SqliteUtils.ml +++ b/infer/src/base/SqliteUtils.ml @@ -27,8 +27,8 @@ let exec db ~log ~stmt = PerfEvent.log_begin_event logger ~name:"sql exec" ~arguments:[("stmt", `String log)] () ) ; let rc = Sqlite3.exec db stmt in PerfEvent.(log (fun logger -> log_end_event logger ())) ; - try check_result_code ~fatal:true db ~log rc with Error err -> - error ~fatal:true "exec: %s (%s)" err (Sqlite3.errmsg db) + try check_result_code ~fatal:true db ~log rc + with Error err -> error ~fatal:true "exec: %s (%s)" err (Sqlite3.errmsg db) let finalize db ~log stmt = diff --git a/infer/src/base/SymOp.ml b/infer/src/base/SymOp.ml index af937a275..31c520ed2 100644 --- a/infer/src/base/SymOp.ml +++ b/infer/src/base/SymOp.ml @@ -36,7 +36,8 @@ let try_finally ~f ~finally = | finally_exn when (* do not swallow Analysis_failure_exe thrown from finally *) match finally_exn with Analysis_failure_exe _ -> false | _ -> true - -> () ) + -> + () ) let pp_failure_kind fmt = function diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index 337b4081f..80f43577b 100644 --- a/infer/src/base/Utils.ml +++ b/infer/src/base/Utils.ml @@ -163,7 +163,8 @@ let read_json_file path = let do_finally_swallow_timeout ~f ~finally = let res = - try f () with exc -> + try f () + with exc -> IExn.reraise_after exc ~f:(fun () -> try finally () |> ignore with _ -> (* swallow in favor of the original exception *) () ) in @@ -252,7 +253,8 @@ let create_dir dir = if (Unix.stat dir).Unix.st_kind <> Unix.S_DIR then L.(die ExternalError) "file '%s' already exists and is not a directory" dir with Unix.Unix_error _ -> ( - try Unix.mkdir dir ~perm:0o700 with Unix.Unix_error _ -> + try Unix.mkdir dir ~perm:0o700 + with Unix.Unix_error _ -> let created_concurrently = (* check if another process created it meanwhile *) try Polymorphic_compare.( = ) (Unix.stat dir).Unix.st_kind Unix.S_DIR diff --git a/infer/src/biabduction/Attribute.ml b/infer/src/biabduction/Attribute.ml index 0f5e3a0ae..1e4b7e906 100644 --- a/infer/src/biabduction/Attribute.ml +++ b/infer/src/biabduction/Attribute.ml @@ -80,7 +80,7 @@ let get tenv prop exp category = | Sil.Apred (att, _) | Anpred (att, _) -> PredSymb.equal_category (PredSymb.to_category att) category | _ -> - false) + false ) atts @@ -300,7 +300,7 @@ let deallocate_stack_vars tenv (p : 'a Prop.t) pvars = fresh_address_vars := (v, freshv) :: !fresh_address_vars ; (Exp.Lvar v, Exp.Var freshv) | _ -> - assert false) + assert false ) sigma_stack in let pi1 = List.map ~f:(fun (id, e) -> Sil.Aeq (Exp.Var id, e)) (Sil.sub_to_list p.sub) in diff --git a/infer/src/biabduction/Builtin.ml b/infer/src/biabduction/Builtin.ml index 71ec118ef..37559e005 100644 --- a/infer/src/biabduction/Builtin.ml +++ b/infer/src/biabduction/Builtin.ml @@ -39,8 +39,8 @@ let check_register_populated () = (** get the symbolic execution handler associated to the builtin function name *) let get name : t option = - try Some (Typ.Procname.Hash.find builtin_functions name) with Caml.Not_found -> - check_register_populated () ; None + try Some (Typ.Procname.Hash.find builtin_functions name) + with Caml.Not_found -> check_register_populated () ; None (** register a builtin [Typ.Procname.t] and symbolic execution handler *) diff --git a/infer/src/biabduction/BuiltinDefn.ml b/infer/src/biabduction/BuiltinDefn.ml index 65224f0ad..2a76c402b 100644 --- a/infer/src/biabduction/BuiltinDefn.ml +++ b/infer/src/biabduction/BuiltinDefn.ml @@ -221,7 +221,7 @@ let execute___get_type_of {Builtin.pdesc; tenv; prop_; path; ret_id_typ; args} : let hpred_opt = List.find_map ~f:(function - | Sil.Hpointsto (e, _, texp) when Exp.equal e n_lexp -> Some texp | _ -> None) + | Sil.Hpointsto (e, _, texp) when Exp.equal e n_lexp -> Some texp | _ -> None ) prop.Prop.sigma in match hpred_opt with diff --git a/infer/src/biabduction/Dom.ml b/infer/src/biabduction/Dom.ml index f2a12d772..e5ada3a3a 100644 --- a/infer/src/biabduction/Dom.ml +++ b/infer/src/biabduction/Dom.ml @@ -526,6 +526,7 @@ module Rename : sig val get_unify_eqs : unit -> (Exp.t * Exp.t) list val to_subst_emb : side -> Sil.subst + (* val get : Exp.t -> Exp.t -> Exp.t option val pp : printenv -> Format.formatter -> (Exp.t * Exp.t * Exp.t) list -> unit @@ -687,8 +688,8 @@ end = struct in List.iter ~f:handle_triple !tbl ; let rep x = - try H.find rep_cache (get x) with Caml.Not_found -> - L.die L.InternalError "Dom.Rename.get_unify_eqs broken" + try H.find rep_cache (get x) + with Caml.Not_found -> L.die L.InternalError "Dom.Rename.get_unify_eqs broken" in rep in diff --git a/infer/src/biabduction/Match.ml b/infer/src/biabduction/Match.ml index 07602e490..61b9aa5b6 100644 --- a/infer/src/biabduction/Match.ml +++ b/infer/src/biabduction/Match.ml @@ -242,8 +242,9 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = in let do_empty_hpats iter_cur _ = let sub_new, vars_leftover = - match Prop.prop_iter_current tenv iter_cur with _, (sub_new, vars_leftover) -> - (sub_new, vars_leftover) + match Prop.prop_iter_current tenv iter_cur with + | _, (sub_new, vars_leftover) -> + (sub_new, vars_leftover) in let sub_res = sub_extend_with_ren sub_new vars_leftover in let p_leftover = Prop.prop_iter_remove_curr_then_to_prop tenv iter_cur in @@ -256,8 +257,9 @@ let rec iter_match_with_impl tenv iter condition sub vars hpat hpats = in let do_nonempty_hpats iter_cur _ = let sub_new, vars_leftover = - match Prop.prop_iter_current tenv iter_cur with _, (sub_new, vars_leftover) -> - (sub_new, vars_leftover) + match Prop.prop_iter_current tenv iter_cur with + | _, (sub_new, vars_leftover) -> + (sub_new, vars_leftover) in let hpat_next, hpats_rest = match hpats with [] -> assert false | hpat_next :: hpats_rest -> (hpat_next, hpats_rest) diff --git a/infer/src/biabduction/Paths.ml b/infer/src/biabduction/Paths.ml index a0810ff1d..47ada725b 100644 --- a/infer/src/biabduction/Paths.ml +++ b/infer/src/biabduction/Paths.ml @@ -385,7 +385,8 @@ end = struct let delayed_num = ref 0 in let delayed = ref PathMap.empty in let add_path p = - try ignore (PathMap.find p !delayed) with Caml.Not_found -> + try ignore (PathMap.find p !delayed) + with Caml.Not_found -> incr delayed_num ; delayed := PathMap.add p !delayed_num !delayed in diff --git a/infer/src/biabduction/Prop.ml b/infer/src/biabduction/Prop.ml index 85a4c1eb8..70ac1c844 100644 --- a/infer/src/biabduction/Prop.ml +++ b/infer/src/biabduction/Prop.ml @@ -971,8 +971,8 @@ module Normalize = struct else match (e1, e2) with | Const (Cint n), Const (Cint m) -> ( - try Exp.int (IntLit.shift_left n m) with IntLit.OversizedShift -> - BinOp (Shiftlt, eval e1, eval e2) ) + try Exp.int (IntLit.shift_left n m) + with IntLit.OversizedShift -> BinOp (Shiftlt, eval e1, eval e2) ) | _, Const (Cint m) when IntLit.iszero m -> eval e1 | _, Const (Cint m) when IntLit.isone m -> @@ -986,8 +986,8 @@ module Normalize = struct else match (e1, e2) with | Const (Cint n), Const (Cint m) -> ( - try Exp.int (IntLit.shift_right n m) with IntLit.OversizedShift -> - BinOp (Shiftrt, eval e1, eval e2) ) + try Exp.int (IntLit.shift_right n m) + with IntLit.OversizedShift -> BinOp (Shiftrt, eval e1, eval e2) ) | _, Const (Cint m) when IntLit.iszero m -> eval e1 | Const (Cint m), _ when IntLit.iszero m -> @@ -2411,7 +2411,10 @@ let prop_iter_next iter = | hpred' :: new' -> Some { iter with - pit_old= iter.pit_curr :: iter.pit_old; pit_curr= hpred'; pit_state= (); pit_new= new' } + pit_old= iter.pit_curr :: iter.pit_old + ; pit_curr= hpred' + ; pit_state= () + ; pit_new= new' } (** Insert before the current element of the iterator. *) diff --git a/infer/src/biabduction/PropUtil.ml b/infer/src/biabduction/PropUtil.ml index f0ef7db11..186ce2ebd 100644 --- a/infer/src/biabduction/PropUtil.ml +++ b/infer/src/biabduction/PropUtil.ml @@ -105,7 +105,7 @@ let remove_abduced_retvars tenv p = | Sil.Aeq (lhs, rhs) | Sil.Aneq (lhs, rhs) -> exp_contains lhs || exp_contains rhs | Sil.Apred (_, es) | Sil.Anpred (_, es) -> - List.exists ~f:exp_contains es) + List.exists ~f:exp_contains es ) pi in (Sil.HpredSet.elements reach_hpreds, reach_pi) diff --git a/infer/src/biabduction/Prover.ml b/infer/src/biabduction/Prover.ml index da4d2305c..1a7ba044b 100644 --- a/infer/src/biabduction/Prover.ml +++ b/infer/src/biabduction/Prover.ml @@ -14,7 +14,8 @@ module L = Logging module F = Format let decrease_indent_when_exception thunk = - try thunk () with exn when SymOp.exn_not_failure exn -> + try thunk () + with exn when SymOp.exn_not_failure exn -> IExn.reraise_after exn ~f:(fun () -> L.d_decrease_indent ()) @@ -489,7 +490,7 @@ end = struct (* [e <= n' <= n |- e <= n] *) List.exists ~f:(function - | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' n | _, _ -> false) + | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' n | _, _ -> false ) leqs | Exp.Const (Const.Cint n), e -> (* [ n-1 <= n' < e |- n <= e] *) @@ -498,7 +499,7 @@ end = struct | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq (n -- IntLit.one) n' | _, _ -> - false) + false ) lts | _ -> Exp.equal e1 e2 @@ -514,7 +515,7 @@ end = struct (* [n <= n' < e |- n < e] *) List.exists ~f:(function - | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq n n' | _, _ -> false) + | Exp.Const (Const.Cint n'), e' -> Exp.equal e e' && IntLit.leq n n' | _, _ -> false ) lts | e, Exp.Const (Const.Cint n) -> (* [e <= n' <= n-1 |- e < n] *) @@ -523,7 +524,7 @@ end = struct | e', Exp.Const (Const.Cint n') -> Exp.equal e e' && IntLit.leq n' (n -- IntLit.one) | _, _ -> - false) + false ) leqs | _ -> false @@ -1459,8 +1460,8 @@ let array_len_imply tenv calc_missing subs len1 len2 indices2 = | _, Exp.BinOp (Binop.PlusA _, Exp.Var _, _) | _, Exp.BinOp (Binop.PlusA _, _, Exp.Var _) | Exp.BinOp (Binop.Mult _, _, _), _ -> ( - try exp_imply tenv calc_missing subs len1 len2 with IMPL_EXC (s, subs', x) -> - raise (IMPL_EXC ("array len:" ^ s, subs', x)) ) + try exp_imply tenv calc_missing subs len1 len2 + with IMPL_EXC (s, subs', x) -> raise (IMPL_EXC ("array len:" ^ s, subs', x)) ) | _ -> ProverState.add_bounds_check (ProverState.BClen_imply (len1, len2, indices2)) ; subs @@ -2175,10 +2176,11 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 let subs' = exp_list_imply tenv calc_missing subs (f2 :: elist2) (f2 :: elist2) in let prop1' = Prop.prop_iter_remove_curr_then_to_prop tenv iter1' in let hpred1 = - match Prop.prop_iter_current tenv iter1' with hpred1, b -> - if b then ProverState.add_missing_pi (Sil.Aneq (e2_, f2_)) ; - (* for PE |- NE *) - hpred1 + match Prop.prop_iter_current tenv iter1' with + | hpred1, b -> + if b then ProverState.add_missing_pi (Sil.Aneq (e2_, f2_)) ; + (* for PE |- NE *) + hpred1 in match hpred1 with | Sil.Hlseg _ -> diff --git a/infer/src/biabduction/Rearrange.ml b/infer/src/biabduction/Rearrange.ml index 4d7569a52..52092ac91 100644 --- a/infer/src/biabduction/Rearrange.ml +++ b/infer/src/biabduction/Rearrange.ml @@ -616,7 +616,7 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = | Sil.Hlseg (_, _, e1, _, _) -> Exp.equal e e1 | Sil.Hdllseg (_, _, e_iF, _, _, e_iB, _) -> - Exp.equal e e_iF || Exp.equal e e_iB) + Exp.equal e e_iF || Exp.equal e e_iB ) footprint_sigma in let atoms_sigma_list = @@ -829,7 +829,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = when Exp.equal lhs_exp matching_exp -> get_fld_strexp_and_typ fld_typ (is_guarded_by_fld field_part) matching_flds | _ -> - None) + None ) sigma | _ -> None ) @@ -954,7 +954,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = false ) flds | _ -> - false) + false ) prop.Prop.sigma in Procdesc.get_access pdesc <> PredSymb.Private @@ -1502,9 +1502,8 @@ let attr_has_annot is_annotation tenv prop exp = | _ -> None in - try List.find_map ~f:attr_has_annot (Attribute.get_for_exp tenv prop exp) with - | Not_found_s _ | Caml.Not_found -> - None + try List.find_map ~f:attr_has_annot (Attribute.get_for_exp tenv prop exp) + with Not_found_s _ | Caml.Not_found -> None let is_strexp_pt_fld_with_annot tenv obj_str is_annotation typ deref_exp (fld, strexp) = diff --git a/infer/src/biabduction/State.ml b/infer/src/biabduction/State.ml index d15ae786e..131be7a3d 100644 --- a/infer/src/biabduction/State.ml +++ b/infer/src/biabduction/State.ml @@ -21,7 +21,7 @@ type failure_stats = mutable node_ok: int ; (* number of node successes (i.e. no instruction failures) *) mutable first_failure: (Location.t * Procdesc.Node.t * int * Errlog.loc_trace * exn) option - (* exception at the first failure *) } + (* exception at the first failure *) } module NodeHash = Procdesc.NodeHash @@ -67,7 +67,8 @@ let reset_diverging_states_node () = !gs.diverging_states_node <- Paths.PathSet. let reset () = gs := initial () let get_failure_stats node = - try NodeHash.find !gs.failure_map node with Caml.Not_found -> + try NodeHash.find !gs.failure_map node + with Caml.Not_found -> let fs = {instr_fail= 0; instr_ok= 0; node_fail= 0; node_ok= 0; first_failure= None} in NodeHash.add !gs.failure_map node fs ; fs diff --git a/infer/src/biabduction/SymExec.ml b/infer/src/biabduction/SymExec.ml index 4b953af0e..2912e60d5 100644 --- a/infer/src/biabduction/SymExec.ml +++ b/infer/src/biabduction/SymExec.ml @@ -1484,8 +1484,7 @@ let rec sym_exec exe_env tenv current_pdesc instr_ (prop_ : Prop.normal Prop.t) let eprop = Prop.expose prop_ in match List.partition_tf - ~f:(function - | Sil.Hpointsto (Exp.Lvar pvar', _, _) -> Pvar.equal pvar pvar' | _ -> false) + ~f:(function Sil.Hpointsto (Exp.Lvar pvar', _, _) -> Pvar.equal pvar pvar' | _ -> false) eprop.Prop.sigma with | [Sil.Hpointsto (e, se, typ)], sigma' -> @@ -1525,7 +1524,8 @@ and instrs ?(mask_errors = false) exe_env tenv pdesc instrs ppl = L.d_str "Executing Generated Instruction " ; Sil.d_instr instr ; L.d_ln () ; - try sym_exec exe_env tenv pdesc instr p path with exn -> + try sym_exec exe_env tenv pdesc instr p path + with exn -> IExn.reraise_if exn ~f:(fun () -> (not mask_errors) || not (SymOp.exn_not_failure exn)) ; let error = Exceptions.recognize_exception exn in let loc = @@ -1587,7 +1587,7 @@ and add_constraints_on_actuals_by_ref tenv caller_pdesc prop actuals_by_ref call | Sil.Hpointsto (lhs, _, typ_exp) when Exp.equal lhs actual -> Sil.Hpointsto (lhs, abduced_strexp, typ_exp) | hpred -> - hpred) + hpred ) prop'.Prop.sigma in Prop.normalize tenv (Prop.set prop' ~sigma:filtered_sigma) @@ -1596,8 +1596,7 @@ and add_constraints_on_actuals_by_ref tenv caller_pdesc prop actuals_by_ref call let prop' = let filtered_sigma = List.filter - ~f:(function - | Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual -> false | _ -> true) + ~f:(function Sil.Hpointsto (lhs, _, _) when Exp.equal lhs actual -> false | _ -> true) prop.Prop.sigma in Prop.normalize tenv (Prop.set prop ~sigma:filtered_sigma) diff --git a/infer/src/biabduction/SymExecBlocks.ml b/infer/src/biabduction/SymExecBlocks.ml index 511915869..6454cf34b 100644 --- a/infer/src/biabduction/SymExecBlocks.ml +++ b/infer/src/biabduction/SymExecBlocks.ml @@ -56,7 +56,7 @@ let resolve_method_with_block_args_and_analyze ~caller_pdesc pname act_params = when Procdesc.is_defined pdesc && Int.equal (List.length (Procdesc.get_formals pdesc)) (List.length act_params) (* only specialize defined methods, and when formals and actuals have the same length *) - -> ( + -> ( (* a list with the same length of the actual params of the function, containing either a Closure or None. *) let block_args = diff --git a/infer/src/biabduction/Tabulation.ml b/infer/src/biabduction/Tabulation.ml index ce89a25f3..188b9e8af 100644 --- a/infer/src/biabduction/Tabulation.ml +++ b/infer/src/biabduction/Tabulation.ml @@ -117,8 +117,7 @@ let log_call_trace ~caller_name ~callee_name ?callee_attributes ?reason ?dynamic (***************) let get_specs_from_payload summary = - Option.map summary.Summary.payloads.biabduction ~f:(fun BiabductionSummary.({preposts}) -> - preposts ) + Option.map summary.Summary.payloads.biabduction ~f:(fun BiabductionSummary.{preposts} -> preposts) |> BiabductionSummary.get_specs_from_preposts @@ -650,7 +649,8 @@ let sigma_star_fld tenv (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Si | _ -> star sg1 sigma2' ) in - try star sigma1 sigma2 with exn when SymOp.exn_not_failure exn -> + try star sigma1 sigma2 + with exn when SymOp.exn_not_failure exn -> L.d_str "cannot star " ; Prop.d_sigma sigma1 ; L.d_str " and " ; @@ -691,7 +691,8 @@ let sigma_star_typ (sigma1 : Sil.hpred list) (typings2 : (Exp.t * Exp.t) list) : | _ -> star sg1 typings2' ) in - try star sigma1 typings2 with exn when SymOp.exn_not_failure exn -> + try star sigma1 typings2 + with exn when SymOp.exn_not_failure exn -> L.d_str "cannot star " ; Prop.d_sigma sigma1 ; L.d_str " and " ; @@ -1021,7 +1022,7 @@ let mk_posts tenv prop callee_pname posts = | Sil.Apred (Aretval (pname, _), [exp]) when Typ.Procname.equal callee_pname pname -> Prover.check_disequal tenv prop exp Exp.zero | _ -> - false) + false ) (Attribute.get_all prop) in if last_call_ret_non_null then @@ -1031,7 +1032,7 @@ let mk_posts tenv prop callee_pname posts = | Sil.Hpointsto (Exp.Lvar pvar, Sil.Eexp (e, _), _) when Pvar.is_return pvar -> Prover.check_equal tenv (Prop.normalize tenv prop) e Exp.zero | _ -> - false) + false ) prop.Prop.sigma in List.filter ~f:(fun (prop, _) -> not (returns_null prop)) posts @@ -1115,7 +1116,8 @@ let add_missing_field_to_tenv ~missing_sigma exe_env caller_tenv callee_pname hp (* if the callee is a model, then we don't have a tenv for it *) if (not callee_attributes.ProcAttributes.is_model) && add_fields then let callee_tenv_opt = - try Some (Exe_env.get_tenv exe_env callee_pname) with _ -> + try Some (Exe_env.get_tenv exe_env callee_pname) + with _ -> let source_file = callee_attributes.ProcAttributes.loc.Location.file in Tenv.load source_file in @@ -1378,7 +1380,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re let exn = get_check_exn tenv check callee_pname loc __POS__ in raise exn | _ -> - false) + false ) invalid_res then call_desc (Some Localise.Pnm_bounds) else call_desc None diff --git a/infer/src/biabduction/interproc.ml b/infer/src/biabduction/interproc.ml index 190cab3bb..f005404e8 100644 --- a/infer/src/biabduction/interproc.ml +++ b/infer/src/biabduction/interproc.ml @@ -131,7 +131,8 @@ let path_set_create_worklist proc_cfg = let htable_retrieve (htable : (Procdesc.Node.id, Paths.PathSet.t) Hashtbl.t) (key : Procdesc.Node.id) : Paths.PathSet.t = - try Hashtbl.find htable key with Caml.Not_found -> + try Hashtbl.find htable key + with Caml.Not_found -> Hashtbl.replace htable key Paths.PathSet.empty ; Paths.PathSet.empty @@ -605,8 +606,8 @@ let extract_specs tenv pdesc pathset : Prop.normal BiabductionSummary.spec list let pre_post_map = let add map (pre, post, visited) = let current_posts, current_visited = - try Pmap.find pre map with Caml.Not_found -> - (Paths.PathSet.empty, BiabductionSummary.Visitedset.empty) + try Pmap.find pre map + with Caml.Not_found -> (Paths.PathSet.empty, BiabductionSummary.Visitedset.empty) in let new_posts = match post with @@ -1258,7 +1259,8 @@ let analyze_procedure {Callbacks.summary; proc_desc; tenv; exe_env} : Summary.t (* make sure models have been registered *) BuiltinDefn.init () ; if not (List.is_empty Config.topl_properties) then Topl.init () ; - try analyze_procedure_aux summary exe_env tenv proc_desc with exn -> + try analyze_procedure_aux summary exe_env tenv proc_desc + with exn -> IExn.reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ; Reporting.log_error_using_state summary exn ; summary diff --git a/infer/src/bufferoverrun/bufferOverrunChecker.ml b/infer/src/bufferoverrun/bufferOverrunChecker.ml index 53debbcbd..ae7e567de 100644 --- a/infer/src/bufferoverrun/bufferOverrunChecker.ml +++ b/infer/src/bufferoverrun/bufferOverrunChecker.ml @@ -418,9 +418,10 @@ let report_errors : Tenv.t -> checks -> Summary.t -> unit = let get_checks_summary : BufferOverrunAnalysis.local_decls -> checks -> checks_summary = fun locals - Checks.({ cond_set - ; unused_branches= _ (* intra-procedural *) - ; unreachable_statements= _ (* intra-procedural *) }) -> + Checks. + { cond_set + ; unused_branches= _ (* intra-procedural *) + ; unreachable_statements= _ (* intra-procedural *) } -> PO.ConditionSet.for_summary ~forget_locs:locals cond_set diff --git a/infer/src/bufferoverrun/bufferOverrunDomainRelation.ml b/infer/src/bufferoverrun/bufferOverrunDomainRelation.ml index 6e9055be1..fe193f0f9 100644 --- a/infer/src/bufferoverrun/bufferOverrunDomainRelation.ml +++ b/infer/src/bufferoverrun/bufferOverrunDomainRelation.ml @@ -798,7 +798,7 @@ module Make (Manager : Manager_S) = struct Texpr1.Unop (uop, re', typ, round) ) | Texpr1.Binop (bop, re1, re2, typ, round) -> Option.map2 (symexp_raw_subst subst_map re1) (symexp_raw_subst subst_map re2) - ~f:(fun re1' re2' -> Texpr1.Binop (bop, re1', re2', typ, round) ) + ~f:(fun re1' re2' -> Texpr1.Binop (bop, re1', re2', typ, round)) let symexp_subst subst_map x = diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index 141342039..90ae73ff6 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -136,7 +136,7 @@ let rec must_alias_cmp : Exp.t -> Mem.t -> bool = let set_array_stride integer_type_widths typ v = match typ with - | Typ.({desc= Tptr ({desc= Tint ikind}, Pk_pointer)}) -> + | Typ.{desc= Tptr ({desc= Tint ikind}, Pk_pointer)} -> let width = Typ.width_of_ikind integer_type_widths ikind in Val.set_array_stride (Z.of_int (width / 8)) v | _ -> @@ -379,7 +379,8 @@ type eval_mode = EvalNormal | EvalPOCond | EvalPOReachability let rec eval_sympath_partial ~mode params p mem = match p with | Symb.SymbolPath.Pvar x -> ( - try ParamBindings.find x params with Caml.Not_found -> + try ParamBindings.find x params + with Caml.Not_found -> L.d_printfln_escaped "Symbol %a is not found in parameters." (Pvar.pp Pp.text) x ; Val.Itv.top ) | Symb.SymbolPath.Callsite {cs} -> ( diff --git a/infer/src/checkers/Bindings.ml b/infer/src/checkers/Bindings.ml index c37c182a3..7cc771724 100644 --- a/infer/src/checkers/Bindings.ml +++ b/infer/src/checkers/Bindings.ml @@ -23,7 +23,7 @@ module Reverse = struct let add k v rm = M.update k (function - | None -> Some (false, VarSet.singleton v) | Some (_, s) -> Some (false, VarSet.add v s)) + | None -> Some (false, VarSet.singleton v) | Some (_, s) -> Some (false, VarSet.add v s) ) rm diff --git a/infer/src/checkers/Litho.ml b/infer/src/checkers/Litho.ml index 5c5034d34..a843f2502 100644 --- a/infer/src/checkers/Litho.ml +++ b/infer/src/checkers/Litho.ml @@ -238,8 +238,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct then let return_access_path = Domain.LocalAccessPath.make (return_base, []) caller_pname in let return_calls = - ( try Domain.find return_access_path astate with Caml.Not_found -> Domain.CallSet.empty - ) + ( try Domain.find return_access_path astate + with Caml.Not_found -> Domain.CallSet.empty ) |> Domain.CallSet.add (Domain.MethodCall.make receiver callee_procname) in Domain.add return_access_path return_calls astate diff --git a/infer/src/checkers/Siof.ml b/infer/src/checkers/Siof.ml index 911448e80..577ec0986 100644 --- a/infer/src/checkers/Siof.ml +++ b/infer/src/checkers/Siof.ml @@ -138,7 +138,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let exec_instr astate {ProcData.pdesc} _ (instr : Sil.instr) = match instr with - | Store (Lvar global, Typ.({desc= Tptr _}), Lvar _, loc) + | Store (Lvar global, Typ.{desc= Tptr _}, Lvar _, loc) when (Option.equal Typ.Procname.equal) (Pvar.get_initializer_pname global) (Some (Procdesc.get_proc_name pdesc)) -> diff --git a/infer/src/checkers/accessTree.ml b/infer/src/checkers/accessTree.ml index 215d3a4dc..11d72fda0 100644 --- a/infer/src/checkers/accessTree.ml +++ b/infer/src/checkers/accessTree.ml @@ -321,7 +321,8 @@ module Make (TraceDomain : AbstractDomain.WithBottom) (Config : Config) = struct let base, accesses = AccessPath.Abs.extract ap in let is_exact = AccessPath.Abs.is_exact ap in let base_node = - try BaseMap.find base tree with Caml.Not_found -> + try BaseMap.find base tree + with Caml.Not_found -> (* note: we interpret max_depth <= 0 as max_depth = 1 *) if Config.max_depth > 1 then empty_normal_leaf else empty_starred_leaf in diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index 66ccebbf1..e8c5ac066 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -23,8 +23,8 @@ module Domain = struct astate | NonBottom _ -> let sink_map = - try AnnotReachabilityDomain.find annot annot_map with Caml.Not_found -> - AnnotReachabilityDomain.SinkMap.empty + try AnnotReachabilityDomain.find annot annot_map + with Caml.Not_found -> AnnotReachabilityDomain.SinkMap.empty in let sink_map' = if AnnotReachabilityDomain.SinkMap.mem sink sink_map then sink_map @@ -117,8 +117,8 @@ let method_overrides_annot annot tenv pname = method_overrides (method_has_annot let lookup_annotation_calls ~caller_pdesc annot pname = match Ondemand.analyze_proc_name ~caller_pdesc pname with | Some {Summary.payloads= {Payloads.annot_map= Some annot_map}} -> ( - try AnnotReachabilityDomain.find annot annot_map with Caml.Not_found -> - AnnotReachabilityDomain.SinkMap.empty ) + try AnnotReachabilityDomain.find annot annot_map + with Caml.Not_found -> AnnotReachabilityDomain.SinkMap.empty ) | _ -> AnnotReachabilityDomain.SinkMap.empty diff --git a/infer/src/checkers/cost.ml b/infer/src/checkers/cost.ml index 7857f75ef..5d16536e1 100644 --- a/infer/src/checkers/cost.ml +++ b/infer/src/checkers/cost.ml @@ -435,7 +435,7 @@ module ConstraintSolver = struct let union ~debug equalities e1 e2 = - let _ : bool = log_union ~debug equalities e1 e2 in + let (_ : bool) = log_union ~debug equalities e1 e2 in () @@ -642,7 +642,7 @@ module ThresholdReports = struct let config = List.fold ReportConfig.as_list ~init:none ~f:(fun acc -> function - | k, ReportConfig.({threshold= Some threshold}) -> + | k, ReportConfig.{threshold= Some threshold} -> CostDomain.CostKindMap.add k (Threshold (BasicCost.of_int_exn threshold)) acc | _ -> acc ) @@ -766,16 +766,16 @@ module Check = struct else if BasicCost.is_zero cost then report IssueType.zero_execution_time_call "is zero" - let check_and_report WorstCaseCost.({costs; reports}) proc_desc summary = + let check_and_report WorstCaseCost.{costs; reports} proc_desc summary = CostDomain.CostKindMap.iter2 ReportConfig.as_map reports - ~f:(fun kind ReportConfig.({name; threshold}) -> function + ~f:(fun kind ReportConfig.{name; threshold} -> function | ThresholdReports.Threshold _ -> () | ThresholdReports.ReportOn {location; cost} -> report_threshold summary ~name ~location ~cost ~threshold:(Option.value_exn threshold) ~kind ) ; CostDomain.CostKindMap.iter2 ReportConfig.as_map costs - ~f:(fun _kind ReportConfig.({name; top_and_bottom}) cost -> + ~f:(fun _kind ReportConfig.{name; top_and_bottom} cost -> if top_and_bottom then report_top_and_bottom proc_desc summary ~name ~cost ) end diff --git a/infer/src/checkers/costDomain.ml b/infer/src/checkers/costDomain.ml index 7a5ec90e9..0ebace6d7 100644 --- a/infer/src/checkers/costDomain.ml +++ b/infer/src/checkers/costDomain.ml @@ -33,7 +33,7 @@ module CostKindMap = struct type no_value = | let iter2 map1 map2 ~f = - let _ : no_value t = + let (_ : no_value t) = merge (fun k v1_opt v2_opt -> (match (v1_opt, v2_opt) with Some v1, Some v2 -> f k v1 v2 | _ -> ()) ; @@ -58,7 +58,7 @@ module VariantCostMap = struct let increase_by kind cost_to_add record = update kind (function - | None -> Some cost_to_add | Some existing -> Some (BasicCost.plus cost_to_add existing)) + | None -> Some cost_to_add | Some existing -> Some (BasicCost.plus cost_to_add existing) ) record diff --git a/infer/src/checkers/functionPointers.ml b/infer/src/checkers/functionPointers.ml index b289f4066..9de4d863f 100644 --- a/infer/src/checkers/functionPointers.ml +++ b/infer/src/checkers/functionPointers.ml @@ -26,9 +26,10 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let exec_instr astate _ _ = function | Sil.Load (lhs_id, _, _, _) when Ident.is_none lhs_id -> astate - | Sil.Load (lhs_id, Exp.Lvar rhs_pvar, Typ.({desc= Tptr ({desc= Tfun _}, _)}), _) -> + | Sil.Load (lhs_id, Exp.Lvar rhs_pvar, Typ.{desc= Tptr ({desc= Tfun _}, _)}, _) -> let fun_ptr = - try Domain.find (Pvar.to_string rhs_pvar) astate with Caml.Not_found -> ProcnameSet.empty + try Domain.find (Pvar.to_string rhs_pvar) astate + with Caml.Not_found -> ProcnameSet.empty in Domain.add (Ident.to_string lhs_id) fun_ptr astate | Sil.Store (Lvar lhs_pvar, _, Exp.Const (Const.Cfun pn), _) -> diff --git a/infer/src/checkers/hoisting.ml b/infer/src/checkers/hoisting.ml index e603df9ba..338eb5cb5 100644 --- a/infer/src/checkers/hoisting.ml +++ b/infer/src/checkers/hoisting.ml @@ -65,7 +65,7 @@ let get_hoist_inv_map tenv ~get_callee_purity reaching_defs_invariant_map loop_h loop_head_to_source_nodes LoopHeadToHoistInstrs.empty -let do_report summary Call.({pname; loc}) ~issue loop_head_loc = +let do_report summary Call.{pname; loc} ~issue loop_head_loc = let exp_desc = F.asprintf "The call to %a at %a is loop-invariant" Typ.Procname.pp pname Location.pp loc in @@ -81,10 +81,10 @@ let model_satisfies ~f tenv pname = let is_call_expensive integer_type_widths get_callee_cost_summary_and_formals inferbo_invariant_map - Call.({pname; node; params}) = + Call.{pname; node; params} = (* only report if function call has expensive/symbolic cost *) match get_callee_cost_summary_and_formals pname with - | Some (CostDomain.({post= cost_record}), callee_formals) + | Some (CostDomain.{post= cost_record}, callee_formals) when CostDomain.BasicCost.is_symbolic (CostDomain.get_operation_cost cost_record) -> let last_node = InstrCFG.last_of_underlying_node node in let instr_node_id = InstrCFG.Node.id last_node in @@ -107,7 +107,7 @@ let is_call_variant_for_hoisting tenv call = model_satisfies ~f:InvariantModels.is_variant_for_hoisting tenv call.Call.pname -let get_issue_to_report tenv should_report_invariant (Call.({pname}) as call) = +let get_issue_to_report tenv should_report_invariant (Call.{pname} as call) = if should_report_invariant call then if model_satisfies ~f:InvariantModels.is_invariant tenv pname then Some IssueType.loop_invariant_call @@ -138,7 +138,7 @@ let report_errors proc_desc tenv get_callee_purity reaching_defs_invariant_map loop_head_to_inv_instrs -let checker Callbacks.({tenv; summary; proc_desc; integer_type_widths}) : Summary.t = +let checker Callbacks.{tenv; summary; proc_desc; integer_type_widths} : Summary.t = let cfg = InstrCFG.from_pdesc proc_desc in (* computes reaching defs: node -> (var -> node set) *) let reaching_defs_invariant_map = ReachingDefs.compute_invariant_map proc_desc tenv in diff --git a/infer/src/checkers/liveness.ml b/infer/src/checkers/liveness.ml index 0447fbaa1..b35bf6719 100644 --- a/infer/src/checkers/liveness.ml +++ b/infer/src/checkers/liveness.ml @@ -111,7 +111,8 @@ module TransferFunctions (LConfig : LivenessConfig) (CFG : ProcCfg.S) = struct in let actuals = List.map actuals ~f:(fun (e, _) -> Exp.ignore_cast e) in match Exp.ignore_cast call_exp with - | Exp.Const (Cfun (Typ.Procname.ObjC_Cpp _ as pname)) when Typ.Procname.is_constructor pname -> ( + | Exp.Const (Cfun (Typ.Procname.ObjC_Cpp _ as pname)) when Typ.Procname.is_constructor pname + -> ( (* first actual passed to a C++ constructor is actually written, not read *) match actuals with | Exp.Lvar pvar :: exps -> diff --git a/infer/src/checkers/loop_control.ml b/infer/src/checkers/loop_control.ml index 3cc9f335a..a2354cd6e 100644 --- a/infer/src/checkers/loop_control.ml +++ b/infer/src/checkers/loop_control.ml @@ -134,7 +134,7 @@ let get_loop_head_to_source_nodes cfg = let get_control_maps loop_head_to_source_nodes_map = Procdesc.NodeMap.fold (fun loop_head source_list - (Control.({exit_map; loop_head_to_guard_nodes}), loop_head_to_loop_nodes) -> + (Control.{exit_map; loop_head_to_guard_nodes}, loop_head_to_loop_nodes) -> L.(debug Analysis Medium) "Back-edge source list : [%a] --> loop_head: %i \n" (Pp.comma_seq Procdesc.Node.pp) source_list (nid_int loop_head) ; @@ -154,7 +154,7 @@ let get_control_maps loop_head_to_source_nodes_map = | Some existing_loop_heads -> Some (Control.LoopHeads.add loop_head existing_loop_heads) | None -> - Some (Control.LoopHeads.singleton loop_head)) + Some (Control.LoopHeads.singleton loop_head) ) exit_map_acc )) exit_nodes in @@ -164,7 +164,7 @@ let get_control_maps loop_head_to_source_nodes_map = | Some existing_guard_nodes -> Some (Control.GuardNodes.union existing_guard_nodes guard_prune_nodes) | None -> - Some guard_prune_nodes) + Some guard_prune_nodes ) loop_head_to_guard_nodes in let loop_head_to_loop_nodes' = @@ -173,7 +173,7 @@ let get_control_maps loop_head_to_source_nodes_map = | Some existing_loop_nodes -> Some (LoopInvariant.LoopNodes.union existing_loop_nodes loop_nodes) | None -> - Some loop_nodes) + Some loop_nodes ) loop_head_to_loop_nodes in let open Control in diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index b80177a4a..4b9fc4ba3 100644 --- a/infer/src/clang/Capture.ml +++ b/infer/src/clang/Capture.ml @@ -115,7 +115,8 @@ let run_clang_frontend ast_source = let run_and_validate_clang_frontend ast_source = - try run_clang_frontend ast_source with exc -> + try run_clang_frontend ast_source + with exc -> IExn.reraise_if exc ~f:(fun () -> not Config.keep_going) ; L.internal_error "ERROR RUNNING CAPTURE: %a@\n%s@\n" Exn.pp exc (Printexc.get_backtrace ()) diff --git a/infer/src/clang/ClangCommand.ml b/infer/src/clang/ClangCommand.ml index 5d1ca2500..45441650d 100644 --- a/infer/src/clang/ClangCommand.ml +++ b/infer/src/clang/ClangCommand.ml @@ -102,7 +102,7 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) aux in_argfiles (false, res_rev, true) tl | at_argfile :: tl when String.is_prefix at_argfile ~prefix:"@" && not (String.Set.mem in_argfiles at_argfile) - -> ( + -> ( let in_argfiles' = String.Set.add in_argfiles at_argfile in let argfile = String.slice at_argfile 1 (String.length at_argfile) in match In_channel.read_lines argfile with @@ -135,9 +135,10 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) let arg' = replace_options_arg res_rev arg in aux in_argfiles (false, arg' :: res_rev, changed || not (phys_equal arg arg')) tl in - match aux String.Set.empty (false, [], false) args with _, res_rev, _ -> - (* return non-reversed list *) - List.rev_append res_rev post_args + match aux String.Set.empty (false, [], false) args with + | _, res_rev, _ -> + (* return non-reversed list *) + List.rev_append res_rev post_args (* Work around various path or library issues occurring when one tries to substitute Apple's version diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index c82877568..f377adef9 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -14,7 +14,6 @@ include struct [@@@warning "-60"] module rec CTransImpl : CModule_type.CTranslation = CTrans.CTrans_funct (CFrontend_declImpl) - and CFrontend_declImpl : CModule_type.CFrontend = CFrontend_decl.CFrontend_decl_funct (CTransImpl) end diff --git a/infer/src/clang/cFrontend_errors.ml b/infer/src/clang/cFrontend_errors.ml index bfb841151..9e4d83a35 100644 --- a/infer/src/clang/cFrontend_errors.ml +++ b/infer/src/clang/cFrontend_errors.ml @@ -273,9 +273,8 @@ let create_parsed_linters linters_def_file checkers : linter list = let rec apply_substitution f sub = let sub_param p = - try snd (List.find_exn sub ~f:(fun (a, _) -> ALVar.equal p a)) with - | Not_found_s _ | Caml.Not_found -> - p + try snd (List.find_exn sub ~f:(fun (a, _) -> ALVar.equal p a)) + with Not_found_s _ | Caml.Not_found -> p in let sub_list_param ps = List.map ps ~f:sub_param in let open CTL in @@ -423,10 +422,11 @@ let build_paths_map paths = let paths_map = List.fold ~f:(fun map' data -> - 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' ) + 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' ) ~init:init_map paths in paths_map diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index e7efd7bd6..8f7cbb664 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -297,7 +297,9 @@ let create_external_procdesc trans_unit_ctx cfg proc_name clang_method_kind type in let proc_attributes = { (ProcAttributes.default trans_unit_ctx.CFrontend_config.source_file proc_name) with - ProcAttributes.formals; clang_method_kind; ret_type } + ProcAttributes.formals + ; clang_method_kind + ; ret_type } in ignore (Cfg.create_proc_desc cfg proc_attributes) diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index cc59c0109..0ec543025 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -427,21 +427,22 @@ module Debug = struct if Stack.is_empty t.eval_stack then raise (Empty_stack "Unbalanced number of eval_begin/eval_end invocations") ; let evaluated_tree, eval_node, ast_node_to_display = - match Stack.pop_exn t.eval_stack - with Tree (({id= _; content} as eval_node), children), ast_node_to_display -> - let content' = - {content with eval_result= eval_result_of_bool result_bool; witness= result} - in - let eval_node' = {eval_node with content= content'} in - (Tree (eval_node', children), eval_node', ast_node_to_display) + match Stack.pop_exn t.eval_stack with + | Tree (({id= _; content} as eval_node), children), ast_node_to_display -> + let content' = + {content with eval_result= eval_result_of_bool result_bool; witness= result} + in + let eval_node' = {eval_node with content= content'} in + (Tree (eval_node', children), eval_node', ast_node_to_display) in let t' = explain t ~eval_node ~ast_node_to_display in let forest' = if Stack.is_empty t'.eval_stack then evaluated_tree :: t'.forest else let parent = - match Stack.pop_exn t'.eval_stack with Tree (node, children), ntd -> - (Tree (node, evaluated_tree :: children), ntd) + match Stack.pop_exn t'.eval_stack with + | Tree (node, children), ntd -> + (Tree (node, evaluated_tree :: children), ntd) in Stack.push t'.eval_stack parent ; t'.forest in @@ -1217,7 +1218,7 @@ and eval_EF phi an lcxt trans = if Option.is_some witness_opt then witness_opt else 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 ) + ~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 diff --git a/infer/src/clang/cTL.mli b/infer/src/clang/cTL.mli index ac3ac3132..4b873d9ac 100644 --- a/infer/src/clang/cTL.mli +++ b/infer/src/clang/cTL.mli @@ -29,6 +29,7 @@ type transitions = | PointerToDecl (** stmt to decl *) | Protocol (** decl to decl *) [@@deriving compare] + (* In formulas below prefix "E" means "exists a path" "A" means "for all path" *) diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 755378e85..3263e1645 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -579,7 +579,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s in let instrs = pre_trans_result.control.instrs @ deref_instrs in { pre_trans_result with - control= {pre_trans_result.control with instrs}; return= (exp, field_typ) } + control= {pre_trans_result.control with instrs} + ; return= (exp, field_typ) } type decl_ref_context = MemberOrIvar of trans_result | DeclRefExpr @@ -1121,7 +1122,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s let sil_method = Exp.Const (Const.Cfun callee_pname) in let call_flags = { CallFlags.default with - cf_virtual= is_cpp_call_virtual; cf_injected_destructor= is_injected_destructor } + cf_virtual= is_cpp_call_virtual + ; cf_injected_destructor= is_injected_destructor } in let res_trans_call = create_call_instr trans_state_pri function_type sil_method actual_params sil_loc @@ -1466,7 +1468,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s qual_type.Clang_ast_t.qt_type_ptr ~is_injected_destructor:true ~is_inner_destructor:false | _ -> - assert false) + assert false ) vars_to_destroy with Caml.Not_found -> L.(debug Capture Verbose) "@\n Variables that go out of scope are not found...@\n@." ; @@ -1571,10 +1573,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s (cond_trans ~if_kind:Sil.Ik_bexp ~negate_cond:false) in (* Note: by contruction prune nodes are leafs_nodes_cond *) - let _ : trans_result = + let (_ : trans_result) = do_branch true exp1 var_typ res_trans_cond.control.leaf_nodes join_node pvar in - let _ : trans_result = + let (_ : trans_result) = do_branch false exp2 var_typ res_trans_cond.control.leaf_nodes join_node pvar in let id = Ident.create_fresh Ident.knormal in @@ -1789,7 +1791,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s do_branch false stmt2 res_trans_cond.control.leaf_nodes ; mk_trans_result (mk_fresh_void_exp_typ ()) { empty_control with - root_nodes= res_trans_decl.control.root_nodes; leaf_nodes= [join_node] } + root_nodes= res_trans_decl.control.root_nodes + ; leaf_nodes= [join_node] } | _ -> assert false @@ -3224,7 +3227,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s (Pp.to_string ~f:Clang_ast_proj.get_stmt_kind_string) instr pp_pointer instr ; let trans_result = - try instruction_aux trans_state instr with e -> + try instruction_aux trans_state instr + with e -> IExn.reraise_after e ~f:(fun () -> let should_log_error = not !logged_error in if should_log_error then ( @@ -3680,7 +3684,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s exec_trans_instrs_rev trans_state (List.rev trans_stmt_fun_list) in ( { rev_control with - instrs= List.rev rev_control.instrs; initd_exps= List.rev rev_control.initd_exps } + instrs= List.rev rev_control.instrs + ; initd_exps= List.rev rev_control.initd_exps } , List.rev rev_returns ) diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index c01a7be92..72075e1c4 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -90,7 +90,8 @@ end module GotoLabel = struct let find_goto_label context label sil_loc = - try Hashtbl.find context.CContext.label_map label with Caml.Not_found -> + try Hashtbl.find context.CContext.label_map label + with Caml.Not_found -> let node_name = Format.sprintf "GotoLabel_%s" label in let new_node = Procdesc.create_node context.CContext.procdesc sil_loc (Procdesc.Node.Skip_node node_name) @@ -104,7 +105,7 @@ type continuation = { break: Procdesc.Node.t list ; continue: Procdesc.Node.t list ; return_temp: bool - (* true if temps should not be removed in the node but returned to ancestors *) } + (* true if temps should not be removed in the node but returned to ancestors *) } let is_return_temp continuation = match continuation with Some cont -> cont.return_temp | _ -> false diff --git a/infer/src/clang/tableaux.ml b/infer/src/clang/tableaux.ml index cc03b55a9..7d8b0ce35 100644 --- a/infer/src/clang/tableaux.ml +++ b/infer/src/clang/tableaux.ml @@ -47,8 +47,8 @@ let add_formula_to_valuation k s = let get_node_valuation k = - try NodesValuationHashtbl.find k !global_nodes_valuation with Caml.Not_found -> - CTLFormulaSet.empty + try NodesValuationHashtbl.find k !global_nodes_valuation + with Caml.Not_found -> CTLFormulaSet.empty let is_decl_allowed lcxt decl = @@ -305,7 +305,8 @@ let report_issue an lcxt linter (*npo_condition*) = let check_linter_map linter_map_contex phi = - try ClosureHashtbl.find phi linter_map_contex with Caml.Not_found -> + try ClosureHashtbl.find phi linter_map_contex + with Caml.Not_found -> Logging.die InternalError "@\n ERROR: linter_map must have an entry for each formula" @@ -329,7 +330,8 @@ let build_valuation parsed_linters an lcxt linter_map_context = build_transition_set npo_condition ; *) let normalized_condition = normalize linter.condition in let is_state_only, cl = - try ClosureHashtbl.find normalized_condition !closure_map with Caml.Not_found -> + try ClosureHashtbl.find normalized_condition !closure_map + with Caml.Not_found -> let cl' = formula_closure normalized_condition in let is_state_only = is_state_only_formula normalized_condition in (*print_closure cl' ; *) diff --git a/infer/src/concurrency/ConcurrencyModels.ml b/infer/src/concurrency/ConcurrencyModels.ml index 0468787dd..d1f16f043 100644 --- a/infer/src/concurrency/ConcurrencyModels.ml +++ b/infer/src/concurrency/ConcurrencyModels.ml @@ -82,9 +82,11 @@ end = struct ; unlock= ["release"] } in [ { def with - classname= "apache::thrift::concurrency::Monitor"; trylock= "timedlock" :: def.trylock } + classname= "apache::thrift::concurrency::Monitor" + ; trylock= "timedlock" :: def.trylock } ; { def with - classname= "apache::thrift::concurrency::Mutex"; trylock= "timedlock" :: def.trylock } + classname= "apache::thrift::concurrency::Mutex" + ; trylock= "timedlock" :: def.trylock } ; {rwm with classname= "apache::thrift::concurrency::NoStarveReadWriteMutex"} ; {rwm with classname= "apache::thrift::concurrency::ReadWriteMutex"} ; {shd with classname= "boost::shared_mutex"} diff --git a/infer/src/concurrency/RacerD.ml b/infer/src/concurrency/RacerD.ml index 489213b92..3c7b2b4d1 100644 --- a/infer/src/concurrency/RacerD.ml +++ b/infer/src/concurrency/RacerD.ml @@ -596,8 +596,8 @@ let analyze_procedure {Callbacks.proc_desc; tenv; summary} = in let return_ownership = OwnershipDomain.get_owned return_var_ap ownership in let return_attributes = - try AttributeMapDomain.find return_var_ap attribute_map with Caml.Not_found -> - AttributeSetDomain.empty + try AttributeMapDomain.find return_var_ap attribute_map + with Caml.Not_found -> AttributeSetDomain.empty in let post = {threads; locks; accesses; return_ownership; return_attributes} in Payload.update_summary post summary @@ -1140,7 +1140,8 @@ let report_unsafe_accesses classname (aggregated_access_map : ReportMap.t) = (* reset the reported reads and writes for each memory location *) let reported_acc = { reported_acc with - reported_writes= Typ.Procname.Set.empty; reported_reads= Typ.Procname.Set.empty } + reported_writes= Typ.Procname.Set.empty + ; reported_reads= Typ.Procname.Set.empty } in report_guardedby_violations_on_location grouped_accesses reported_acc |> report_accesses_on_location grouped_accesses diff --git a/infer/src/concurrency/RacerDDomain.ml b/infer/src/concurrency/RacerDDomain.ml index 88862733e..81a7d18ed 100644 --- a/infer/src/concurrency/RacerDDomain.ml +++ b/infer/src/concurrency/RacerDDomain.ml @@ -474,7 +474,7 @@ module AttributeMapDomain = struct | Some attrs -> Some (AttributeSetDomain.add attribute attrs) | None -> - Some (AttributeSetDomain.singleton attribute)) + Some (AttributeSetDomain.singleton attribute) ) t @@ -482,8 +482,8 @@ module AttributeMapDomain = struct let open HilExp in match e with | HilExp.AccessExpression access_expr -> ( - try find (AccessExpression.to_access_path access_expr) attribute_map with Caml.Not_found -> - AttributeSetDomain.empty ) + try find (AccessExpression.to_access_path access_expr) attribute_map + with Caml.Not_found -> AttributeSetDomain.empty ) | Constant _ -> AttributeSetDomain.singleton Attribute.Functional | Exception expr (* treat exceptions as transparent wrt attributes *) | Cast (_, expr) -> diff --git a/infer/src/concurrency/RacerDModels.ml b/infer/src/concurrency/RacerDModels.ml index 53494d54b..ffcf0bd9b 100644 --- a/infer/src/concurrency/RacerDModels.ml +++ b/infer/src/concurrency/RacerDModels.ml @@ -37,7 +37,8 @@ let is_java_container_write = @ make_android_support_template "SparseArrayCompat" array_methods @ [ {default with classname= "android.util.SparseArray"; methods= array_methods} ; { default with - classname= "java.util.List"; methods= ["add"; "addAll"; "clear"; "remove"; "set"] } + classname= "java.util.List" + ; methods= ["add"; "addAll"; "clear"; "remove"; "set"] } ; {default with classname= "java.util.Map"; methods= ["clear"; "put"; "putAll"; "remove"]} ] |> of_records diff --git a/infer/src/concurrency/StarvationModels.ml b/infer/src/concurrency/StarvationModels.ml index b913754c4..dc21148d2 100644 --- a/infer/src/concurrency/StarvationModels.ml +++ b/infer/src/concurrency/StarvationModels.ml @@ -95,8 +95,9 @@ let standard_matchers = let high_sev = [ {default with classname= "java.lang.Thread"; methods= ["sleep"]} ; { default with - classname= "java.lang.Object"; methods= ["wait"]; actuals_pred= empty_or_excessive_timeout - } + classname= "java.lang.Object" + ; methods= ["wait"] + ; actuals_pred= empty_or_excessive_timeout } ; { default with classname= "java.util.concurrent.CountDownLatch" ; methods= ["await"] @@ -141,9 +142,12 @@ let strict_mode_matcher = let dont_search_superclasses = {default with search_superclasses= false} in let matcher_records = [ { dont_search_superclasses with - classname= "dalvik.system.BlockGuard$Policy"; methods= ["on"]; method_prefix= true } + classname= "dalvik.system.BlockGuard$Policy" + ; methods= ["on"] + ; method_prefix= true } ; { dont_search_superclasses with - classname= "java.lang.System"; methods= ["gc"; "runFinalization"] } + classname= "java.lang.System" + ; methods= ["gc"; "runFinalization"] } ; {dont_search_superclasses with classname= "java.lang.Runtime"; methods= ["gc"]} ; {dont_search_superclasses with classname= "java.net.Socket"; methods= ["connect"]} (* all public constructors of Socket with two or more arguments call connect *) diff --git a/infer/src/integration/Buck.ml b/infer/src/integration/Buck.ml index 7d4fd03d7..58b4f41a0 100644 --- a/infer/src/integration/Buck.ml +++ b/infer/src/integration/Buck.ml @@ -200,7 +200,8 @@ let inline_argument_files buck_args = (* Arguments that start with @ could mean something different than an arguments file in buck. *) else let expanded_args = - try Utils.with_file_in file_name ~f:In_channel.input_lines with exn -> + try Utils.with_file_in file_name ~f:In_channel.input_lines + with exn -> Logging.die UserError "Could not read from file '%s': %a@." file_name Exn.pp exn in expanded_args diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 68ce6ad97..527f70260 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -286,7 +286,7 @@ let capture ~changed_files = function (* swallow infer.py argument parsing error *) Config.print_usage_exit () | status -> - command_error_handling ~always_die:true ~prog:infer_py ~args status) + command_error_handling ~always_die:true ~prog:infer_py ~args status ) () ; PerfStats.get_reporter PerfStats.TotalFrontend () | XcodeXcpretty (prog, args) -> diff --git a/infer/src/integration/Maven.ml b/infer/src/integration/Maven.ml index 2f7914a23..3cae2c604 100644 --- a/infer/src/integration/Maven.ml +++ b/infer/src/integration/Maven.ml @@ -133,7 +133,8 @@ let add_infer_profile mvn_pom infer_pom = in protect ~f:with_ic ~finally:(fun () -> In_channel.close ic) in - try Utils.with_file_out infer_pom ~f:with_oc with Xmlm.Error ((line, col), error) -> + try Utils.with_file_out infer_pom ~f:with_oc + with Xmlm.Error ((line, col), error) -> L.die ExternalError "%s:%d:%d: ERROR: %s" mvn_pom line col (Xmlm.error_message error) diff --git a/infer/src/istd/IContainer.ml b/infer/src/istd/IContainer.ml index 14f37901e..8825566f6 100644 --- a/infer/src/istd/IContainer.ml +++ b/infer/src/istd/IContainer.ml @@ -21,7 +21,7 @@ let is_singleton ~fold t = match singleton_or_more ~fold t with Singleton _ -> t let mem_nth ~fold t index = With_return.with_return (fun {return} -> - let _ : int = + let (_ : int) = fold t ~init:index ~f:(fun index _ -> if index <= 0 then return true else index - 1) in false ) @@ -50,7 +50,7 @@ let rev_filter_map_to_list ~fold t ~f = let iter_consecutive ~fold t ~f = - let _ : _ option = + let (_ : _ option) = fold t ~init:None ~f:(fun prev_opt curr -> (match prev_opt with Some prev -> f prev curr | None -> ()) ; Some curr ) diff --git a/infer/src/istd/Pp.ml b/infer/src/istd/Pp.ml index 480bffb89..9722602e6 100644 --- a/infer/src/istd/Pp.ml +++ b/infer/src/istd/Pp.ml @@ -61,8 +61,10 @@ let text_break = {text with break_lines= true} (** 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 *) diff --git a/infer/src/java/jClasspath.ml b/infer/src/java/jClasspath.ml index af23589dc..8480a4398 100644 --- a/infer/src/java/jClasspath.ml +++ b/infer/src/java/jClasspath.ml @@ -101,10 +101,9 @@ let add_source_file path map = (* Two or more source file with the same base name have been found *) let current_package = read_package_declaration current_source_file in Duplicate ((current_package, current_source_file) :: previous_source_files) - with - | Not_found_s _ | Caml.Not_found -> - (* Most common case: there is no conflict with the base name of the source file *) - Singleton current_source_file + with Not_found_s _ | Caml.Not_found -> + (* Most common case: there is no conflict with the base name of the source file *) + Singleton current_source_file in String.Map.set ~key:basename ~data:entry map @@ -141,7 +140,8 @@ let load_from_verbose_output javac_verbose_out = let path = if Version.is_jdk11 then Str.matched_group 1 line else - try Str.matched_group 5 line with Caml.Not_found -> + try Str.matched_group 5 line + with Caml.Not_found -> (* either matched group 5 is found, or matched group 2 is found, see doc for [class_filename_re] above *) Config.javac_classes_out ^/ Str.matched_group 2 line in @@ -274,7 +274,8 @@ let iter_missing_callees program ~f = let cleanup program = Javalib.close_class_path program.classpath.channel let lookup_node cn program = - try Some (JBasics.ClassMap.find cn (get_classmap program)) with Caml.Not_found -> ( + try Some (JBasics.ClassMap.find cn (get_classmap program)) + with Caml.Not_found -> ( try let jclass = javalib_get_class (get_classpath_channel program) cn in add_class cn jclass program ; Some jclass diff --git a/infer/src/java/jContext.ml b/infer/src/java/jContext.ml index 1b844c36a..114891a2f 100644 --- a/infer/src/java/jContext.ml +++ b/infer/src/java/jContext.ml @@ -68,8 +68,9 @@ let set_pvar context var typ = fst (get_or_set_pvar_type context var typ) let reset_pvar_type context = let var_map = context.var_map in let aux var item = - match item with pvar, otyp, _ -> - set_var_map context (JBir.VarMap.add var (pvar, otyp, otyp) var_map) + match item with + | pvar, otyp, _ -> + set_var_map context (JBir.VarMap.add var (pvar, otyp, otyp) var_map) in JBir.VarMap.iter aux var_map diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 5dd8a8e64..a70959074 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -258,7 +258,7 @@ let get_bytecode cm = | JCode.OpInvoke (`Dynamic _, ms) -> JCode.OpInvoke (`Static JBasics.java_lang_object, ms) | opcode -> - opcode) + opcode ) bytecode.JCode.c_code in {bytecode with JCode.c_code} @@ -306,7 +306,12 @@ let create_callee_attributes tenv program cn ms procname = let translation_unit = SourceFile.invalid __FILE__ in Some { (ProcAttributes.default translation_unit procname) with - ProcAttributes.access; exceptions; method_annotation; formals; ret_type; is_abstract } + ProcAttributes.access + ; exceptions + ; method_annotation + ; formals + ; ret_type + ; is_abstract } with Caml.Not_found -> None in Option.bind ~f (JClasspath.lookup_node cn program) @@ -738,8 +743,9 @@ let method_invocation (context : JContext.t) loc pc var_opt cn ms sil_obj_opt ex let get_array_length context pc expr_list content_type = let get_expr_instr expr other_instrs = let instrs, sil_len_expr, _ = expression context pc expr in - match other_instrs with other_instrs, other_exprs -> - (instrs @ other_instrs, sil_len_expr :: other_exprs) + match other_instrs with + | other_instrs, other_exprs -> + (instrs @ other_instrs, sil_len_expr :: other_exprs) in let instrs, sil_len_exprs = List.fold_right ~f:get_expr_instr expr_list ~init:([], []) in let get_array_type_len sil_len_expr (content_type, _) = diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index ff158774a..f336c6709 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -47,7 +47,8 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle [instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] in let create_entry_block handler_list = - try ignore (Hashtbl.find catch_block_table handler_list) with Caml.Not_found -> + try ignore (Hashtbl.find catch_block_table handler_list) + with Caml.Not_found -> let collect succ_nodes rethrow_exception handler = let catch_nodes = get_body_nodes handler.JBir.e_handler in let loc = diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 852b5967a..9a88a4138 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -296,7 +296,7 @@ let add_model_fields program classpath_fields cn = let rec get_method_procname program tenv cn ms method_kind = - let _ : Typ.Struct.t = get_class_struct_typ program tenv cn in + let (_ : Typ.Struct.t) = get_class_struct_typ program tenv cn in let return_type_name, method_name, args_type_name = method_signature_names ms in let class_name = Typ.Name.Java.from_string (JBasics.cn_name cn) in let proc_name_java = diff --git a/infer/src/nullsafe/AnnotatedSignature.ml b/infer/src/nullsafe/AnnotatedSignature.ml index f4e89ef8d..1b5f3ae12 100644 --- a/infer/src/nullsafe/AnnotatedSignature.ml +++ b/infer/src/nullsafe/AnnotatedSignature.ml @@ -25,7 +25,7 @@ let get proc_attributes : t = let method_annotation = proc_attributes.ProcAttributes.method_annotation in let formals = proc_attributes.ProcAttributes.formals in let ret_type = proc_attributes.ProcAttributes.ret_type in - let Annot.Method.({return; params}) = method_annotation in + let Annot.Method.{return; params} = method_annotation in let natl = let rec extract ial parl = match (ial, parl) with diff --git a/infer/src/nullsafe/NullabilityCheck.ml b/infer/src/nullsafe/NullabilityCheck.ml index cf824cc79..6f78cac89 100644 --- a/infer/src/nullsafe/NullabilityCheck.ml +++ b/infer/src/nullsafe/NullabilityCheck.ml @@ -104,7 +104,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let pname = Procdesc.get_proc_name pdesc in let annotation = Localise.nullable_annotation_name pname in let call_site = - try CallSites.min_elt call_sites with Caml.Not_found -> + try CallSites.min_elt call_sites + with Caml.Not_found -> L.(die InternalError) "Expecting a least one element in the set of call sites when analyzing %a" Typ.Procname.pp pname @@ -205,7 +206,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct let rec longest_nullable_prefix ap ((nullable_aps, _) as astate) = - try Some (ap, NullableAP.find ap nullable_aps) with Caml.Not_found -> ( + try Some (ap, NullableAP.find ap nullable_aps) + with Caml.Not_found -> ( match ap with | _, [] -> None diff --git a/infer/src/nullsafe/eradicateChecks.ml b/infer/src/nullsafe/eradicateChecks.ml index 1c17885bd..1a4edc0d2 100644 --- a/infer/src/nullsafe/eradicateChecks.ml +++ b/infer/src/nullsafe/eradicateChecks.ml @@ -246,7 +246,7 @@ let check_constructor_initialization tenv find_canonical_duplicate curr_pname cu let pvar = Pvar.mk (Mangled.from_string (Typ.Fieldname.to_string fn)) pname in - filter_range_opt (TypeState.lookup_pvar pvar typestate)) + filter_range_opt (TypeState.lookup_pvar pvar typestate) ) list in let may_be_assigned_in_final_typestate = diff --git a/infer/src/nullsafe/typeCheck.ml b/infer/src/nullsafe/typeCheck.ml index f325d534c..a210c16ab 100644 --- a/infer/src/nullsafe/typeCheck.ml +++ b/infer/src/nullsafe/typeCheck.ml @@ -516,7 +516,8 @@ let typecheck_instr tenv calls_this checks (node : Procdesc.Node.t) idenv curr_p let ret_type = Typ.Procname.Java.get_return_typ callee_pname_java in let proc_attributes = { (ProcAttributes.default (SourceFile.invalid __FILE__) callee_pname) with - ProcAttributes.formals; ret_type } + ProcAttributes.formals + ; ret_type } in proc_attributes in diff --git a/infer/src/nullsafe/typeState.ml b/infer/src/nullsafe/typeState.ml index b16964e88..66727bbb7 100644 --- a/infer/src/nullsafe/typeState.ml +++ b/infer/src/nullsafe/typeState.ml @@ -72,11 +72,13 @@ let map_join m1 m2 = if only_keep_intersection then tjoined := M.add exp2 range1 !tjoined | Some range' -> tjoined := M.add exp2 range' !tjoined - with Caml.Not_found -> if not only_keep_intersection then tjoined := M.add exp2 range2 !tjoined + with Caml.Not_found -> + if not only_keep_intersection then tjoined := M.add exp2 range2 !tjoined in let missing_rhs exp1 range1 = (* handle elements missing in the rhs *) - try ignore (M.find exp1 m2) with Caml.Not_found -> + try ignore (M.find exp1 m2) + with Caml.Not_found -> let t1, ta1, locs1 = range1 in let range1' = let ta1' = TypeAnnotation.with_origin ta1 TypeOrigin.Undef in diff --git a/infer/src/quandary/ClangTrace.ml b/infer/src/quandary/ClangTrace.ml index a81e23f0a..be7425e24 100644 --- a/infer/src/quandary/ClangTrace.ml +++ b/infer/src/quandary/ClangTrace.ml @@ -136,7 +136,7 @@ module SourceKind = struct in res | _ -> - false) + false ) tenv pname in (* taint all formals except for [this] *) diff --git a/infer/src/quandary/TaintAnalysis.ml b/infer/src/quandary/TaintAnalysis.ml index 90006f8ce..e0ee63b4c 100644 --- a/infer/src/quandary/TaintAnalysis.ml +++ b/infer/src/quandary/TaintAnalysis.ml @@ -240,8 +240,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct let matching_sink, _ = List.find_exn ~f:snd matching_sinks in expand_sink matching_sink (Sink.indexes matching_sink) (matching_sink :: report_acc, seen_acc') - with - | Not_found_s _ | Caml.Not_found -> ( + with Not_found_s _ | Caml.Not_found -> ( (* didn't find a sink whose indexes match; this can happen when taint flows in via a global. pick any sink whose kind matches *) match matching_sinks with diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index e2ad859fd..3510666e5 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -404,6 +404,6 @@ let () = let to_check = List.rev !to_check in let exit_code = ref 0 in List.iter to_check ~f:(fun file -> - try check_copyright file with CopyrightEvent event -> - if not !keep_going then exit_code := exit_code_of_event event ) ; + try check_copyright file + with CopyrightEvent event -> if not !keep_going then exit_code := exit_code_of_event event ) ; exit !exit_code diff --git a/infer/src/topl/Topl.ml b/infer/src/topl/Topl.ml index 0de60fc86..aaf393b00 100644 --- a/infer/src/topl/Topl.ml +++ b/infer/src/topl/Topl.ml @@ -15,13 +15,14 @@ let properties = ref [] let parse topl_file = let f ch = let lexbuf = Lexing.from_channel ch in - try ToplParser.properties (ToplLexer.token ()) lexbuf with ToplParser.Error -> - let Lexing.({pos_lnum; pos_bol; pos_cnum; _}) = Lexing.lexeme_start_p lexbuf in + try ToplParser.properties (ToplLexer.token ()) lexbuf + with ToplParser.Error -> + let Lexing.{pos_lnum; pos_bol; pos_cnum; _} = Lexing.lexeme_start_p lexbuf in let col = pos_cnum - pos_bol + 1 in L.(die UserError) "@[%s:%d:%d: topl parse error@]@\n@?" topl_file pos_lnum col in - try In_channel.with_file topl_file ~f with Sys_error msg -> - L.(die UserError) "@[topl:%s: %s@]@\n@?" topl_file msg + try In_channel.with_file topl_file ~f + with Sys_error msg -> L.(die UserError) "@[topl:%s: %s@]@\n@?" topl_file msg let init () = diff --git a/infer/src/unit/schedulerTests.ml b/infer/src/unit/schedulerTests.ml index a093eda98..6979a5a01 100644 --- a/infer/src/unit/schedulerTests.ml +++ b/infer/src/unit/schedulerTests.ml @@ -67,9 +67,7 @@ module MockProcCfg = struct ~f:(fun (_, succs) -> List.exists ~f:(fun node -> equal_id (Node.id node) node_id) succs) t |> List.map ~f:fst |> List.fold ~init ~f - with - | Not_found_s _ | Caml.Not_found -> - init + with Not_found_s _ | Caml.Not_found -> init let fold_nodes t ~init ~f = List.map ~f:fst t |> List.fold ~init ~f diff --git a/sledge/src/config.ml b/sledge/src/config.ml index 58d319d78..26e589776 100644 --- a/sledge/src/config.ml +++ b/sledge/src/config.ml @@ -29,22 +29,16 @@ let trace_conv = (parse, print) type t = - { compile_only: bool - [@aka ["c"]] + { compile_only: bool [@aka ["c"]] (** Do not analyze: terminate after translating input LLVM to LLAIR. *) - ; input: string - [@pos 0] [@docv "input.bc"] + ; input: string [@pos 0] [@docv "input.bc"] (** LLVM bitcode file to analyze, in either binary $(b,.bc) or textual $(b,.ll) form. *) - ; output: string option - [@aka ["o"]] [@docv "output.llair"] + ; output: string option [@aka ["o"]] [@docv "output.llair"] (** Dump $(i,input.bc) translated to LLAIR in human-readable form to $(i,output.llair), or $(b,-) for $(b,stdout). *) ; trace: Trace.config - [@aka ["t"]] - [@docv "spec"] - [@conv trace_conv] - [@default Trace.none] + [@aka ["t"]] [@docv "spec"] [@conv trace_conv] [@default Trace.none] (** Enable debug tracing according to $(i,spec), which is a sequence of module and function names separated by $(b,+) or $(b,-). For example, $(b,Control-Control.exec_inst) enables all tracing in diff --git a/sledge/src/control.ml b/sledge/src/control.ml index 25dc3208a..a5f13330a 100644 --- a/sledge/src/control.ml +++ b/sledge/src/control.ml @@ -302,7 +302,7 @@ let exec_term : Llair.t -> Stack.t -> Domain.t -> Llair.block -> Work.x = ( match Domain.assume state (Vector.fold tbl ~init:(Exp.bool true) - ~f:(fun b (case, _) -> Exp.and_ (Exp.dq key case) b )) + ~f:(fun b (case, _) -> Exp.and_ (Exp.dq key case) b)) with | Some state -> exec_jump stk state block els | None -> Work.skip ) diff --git a/sledge/src/import/import.ml b/sledge/src/import/import.ml index 1c5ee3f50..c1b87e23a 100644 --- a/sledge/src/import/import.ml +++ b/sledge/src/import/import.ml @@ -11,8 +11,7 @@ include ( Base : sig include - (module type of Base - (* extended below, remove *) + (module type of Base (* extended below, remove *) with module Invariant := Base.Invariant and module List := Base.List and module Map := Base.Map @@ -108,7 +107,8 @@ module Invariant = struct include Base.Invariant let invariant here t sexp_of_t f = - try f () with exn -> + try f () + with exn -> let bt = Caml.Printexc.get_raw_backtrace () in let exn = Error.to_exn diff --git a/sledge/src/import/import.mli b/sledge/src/import/import.mli index d108b84d1..ddd80c2b3 100644 --- a/sledge/src/import/import.mli +++ b/sledge/src/import/import.mli @@ -11,8 +11,7 @@ include module type of ( Base : sig include - (module type of Base - (* extended below, remove *) + (module type of Base (* extended below, remove *) with module Invariant := Base.Invariant and module List := Base.List and module Map := Base.Map diff --git a/sledge/src/import/qset.ml b/sledge/src/import/qset.ml index f1efde02a..e8dc444f7 100644 --- a/sledge/src/import/qset.ml +++ b/sledge/src/import/qset.ml @@ -41,7 +41,8 @@ let sexp_of_m__t (type elt) (module Elt : Sexp_of_m with type t = elt) t = let m__t_of_sexp (type elt cmp) (module Elt : M_of_sexp - with type t = elt and type comparator_witness = cmp) sexp = + with type t = elt + and type comparator_witness = cmp) sexp = Map.m__t_of_sexp (module Elt) q_of_sexp sexp let compare_m__t (module Elt : Compare_m) = Map.compare_direct Q.compare diff --git a/sledge/src/import/vector.mli b/sledge/src/import/vector.mli index 91037148f..a0f783610 100644 --- a/sledge/src/import/vector.mli +++ b/sledge/src/import/vector.mli @@ -180,5 +180,6 @@ val reduce_exn : 'a t -> f:('a -> 'a -> 'a) -> 'a (* val last : 'a t -> 'a *) val empty : 'a t + (* val to_sequence : 'a t -> 'a Sequence.t *) (* val to_sequence_mutable : 'a t -> 'a Sequence.t *) diff --git a/sledge/src/llair/exp.ml b/sledge/src/llair/exp.ml index 85681dfa7..cae4c05e9 100644 --- a/sledge/src/llair/exp.ml +++ b/sledge/src/llair/exp.ml @@ -117,8 +117,7 @@ module rec T : sig val comparator : (t, comparator_witness) Comparator.t end = struct - include T0 - include Comparator.Make (T0) + include T0 include Comparator.Make (T0) end (* auxiliary definition for safe recursive module initialization *) @@ -725,8 +724,7 @@ let rec sum_to_exp typ sum = | _ -> Add {typ; args= sum} ) | _ -> Add {typ; args= sum} -and rational Q.({num; den}) typ = - simp_div (integer num typ) (integer den typ) +and rational Q.{num; den} typ = simp_div (integer num typ) (integer den typ) and simp_div x y = match (x, y) with @@ -771,11 +769,10 @@ let simp_urem x y = | _, Integer {data; typ} when Z.equal Z.one data -> integer Z.zero typ | _ -> App {op= App {op= Urem; arg= x}; arg= y} -(* Sums of polynomial terms represented by multisets. A sum ∑ᵢ cᵢ × - Xᵢ of monomials Xᵢ with coefficients cᵢ is represented by a - multiset where the elements are Xᵢ with multiplicities cᵢ. A constant - is treated as the coefficient of the empty monomial, which is the unit of - multiplication 1. *) +(* Sums of polynomial terms represented by multisets. A sum ∑ᵢ cᵢ × Xᵢ of + monomials Xᵢ with coefficients cᵢ is represented by a multiset where the + elements are Xᵢ with multiplicities cᵢ. A constant is treated as the + coefficient of the empty monomial, which is the unit of multiplication 1. *) module Sum = struct let empty = empty_qset @@ -809,8 +806,7 @@ let rec simp_add_ typ es poly = rational Q.((coeff * of_z i) + of_z j) typ (* (c × ∑ᵢ cᵢ × Xᵢ) + s ==> (∑ᵢ (c × cᵢ) × Xᵢ) + s *) | Add {args}, _ -> simp_add_ typ (Sum.mul_const coeff args) poly - (* (c₀ × X₀) + (∑ᵢ₌₁ⁿ cᵢ × Xᵢ) ==> ∑ᵢ₌₀ⁿ - cᵢ × Xᵢ *) + (* (c₀ × X₀) + (∑ᵢ₌₁ⁿ cᵢ × Xᵢ) ==> ∑ᵢ₌₀ⁿ cᵢ × Xᵢ *) | _, Add {args} -> Sum.to_exp typ (Sum.add coeff exp args) (* (c₁ × X₁) + X₂ ==> ∑ᵢ₌₁² cᵢ × Xᵢ for c₂ = 1 *) | _ -> Sum.to_exp typ (Sum.add coeff exp (Sum.singleton poly)) @@ -820,9 +816,9 @@ let rec simp_add_ typ es poly = let simp_add typ es = simp_add_ typ es (integer Z.zero typ) let simp_add2 typ e f = simp_add_ typ (Sum.singleton e) f -(* Products of indeterminants represented by multisets. A product ∏ᵢ - xᵢ^nᵢ of indeterminates xᵢ is represented by a multiset where the - elements are xᵢ and the multiplicities are the exponents nᵢ. *) +(* Products of indeterminants represented by multisets. A product ∏ᵢ xᵢ^nᵢ + of indeterminates xᵢ is represented by a multiset where the elements are + xᵢ and the multiplicities are the exponents nᵢ. *) module Prod = struct let empty = empty_qset let add exp prod = Qset.add prod exp Q.one @@ -849,26 +845,22 @@ let rec simp_mul2 typ e f = | Integer {data}, _ when Z.equal Z.zero data -> e (* e × 0 ==> 0 *) | _, Integer {data} when Z.equal Z.zero data -> f - (* c × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ c × cᵤ × ∏ⱼ - yᵤⱼ *) + (* c × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ c × cᵤ × ∏ⱼ yᵤⱼ *) | Integer {data}, Add {args} | Add {args}, Integer {data} -> Sum.to_exp typ (Sum.mul_const (Q.of_z data) args) (* c₁ × x₁ ==> ∑ᵢ₌₁ cᵢ × xᵢ *) | Integer {data= c}, x | x, Integer {data= c} -> Sum.to_exp typ (Sum.singleton ~coeff:(Q.of_z c) x) - (* (∏ᵤ₌₀ⁱ xᵤ) × (∏ᵥ₌ᵢ₊₁ⁿ xᵥ) ==> - ∏ⱼ₌₀ⁿ xⱼ *) + (* (∏ᵤ₌₀ⁱ xᵤ) × (∏ᵥ₌ᵢ₊₁ⁿ xᵥ) ==> ∏ⱼ₌₀ⁿ xⱼ *) | Mul {typ; args= xs1}, Mul {args= xs2} -> Mul {typ; args= Prod.union xs1 xs2} - (* (∏ᵢ xᵢ) × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ cᵤ × - ∏ᵢ xᵢ × ∏ⱼ yᵤⱼ *) + (* (∏ᵢ xᵢ) × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ cᵤ × ∏ᵢ xᵢ × ∏ⱼ yᵤⱼ *) | Mul {args= prod}, (Add _ as poly) | (Add _ as poly), Mul {args= prod} -> poly_map_monos ~f:(Prod.union prod) poly (* x₀ × (∏ᵢ₌₁ⁿ xᵢ) ==> ∏ᵢ₌₀ⁿ xᵢ *) | Mul {typ; args= xs1}, x | x, Mul {typ; args= xs1} -> Mul {typ; args= Prod.add x xs1} - (* e × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ e × cᵤ × ∏ⱼ - yᵤⱼ *) + (* e × (∑ᵤ cᵤ × ∏ⱼ yᵤⱼ) ==> ∑ᵤ e × cᵤ × ∏ⱼ yᵤⱼ *) | Add {args}, e | e, Add {args} -> simp_add typ (Sum.map ~f:(fun m -> simp_mul2 typ e m) args) (* x₁ × x₂ ==> ∏ᵢ₌₁² xᵢ *) @@ -1355,7 +1347,7 @@ let solve e f = | Some p, Some q -> solve_uninterp e f >>= solve_ p q | _ -> solve_uninterp e f ) | Memory {siz= m}, Concat {args= ns} | Concat {args= ns}, Memory {siz= m} - -> ( + -> ( match concat_size ns with | Some p -> solve_uninterp e f >>= solve_ p m | _ -> solve_uninterp e f ) diff --git a/sledge/src/llair/llair.ml b/sledge/src/llair/llair.ml index 2e8e82ccd..fc0a35dbd 100644 --- a/sledge/src/llair/llair.ml +++ b/sledge/src/llair/llair.ml @@ -59,20 +59,20 @@ and func = {name: Global.t; entry: block; cfg: cfg} let rec sexp_of_jump ({dst; args; retreating} as jmp) = if retreating then - [%sexp {dst= (dst.lbl : label); args : Exp.t list; retreating : bool}] + [%sexp {dst: label = dst.lbl; args: Exp.t list; retreating: bool}] else [%sexp_of: jump] jmp and sexp_of_term t = [%sexp_of: term] t and sexp_of_block {lbl; params; locals; cmnd; term; parent; sort_index} = [%sexp - { lbl : label - ; params : Var.t list - ; locals : Var.Set.t - ; cmnd : cmnd - ; term : term - ; parent= (parent.name.var : Var.t) - ; sort_index : int }] + { lbl: label + ; params: Var.t list + ; locals: Var.Set.t + ; cmnd: cmnd + ; term: term + ; parent: Var.t = parent.name.var + ; sort_index: int }] and sexp_of_func f = [%sexp_of: func] f diff --git a/sledge/src/llair/llair.mli b/sledge/src/llair/llair.mli index d1d91eadd..471568313 100644 --- a/sledge/src/llair/llair.mli +++ b/sledge/src/llair/llair.mli @@ -17,8 +17,8 @@ instead of using ϕ-nodes. An analyzer will need good support for parameter passing anyhow, and ϕ-nodes make it hard to express program properties as predicates on states, since some execution history is - needed to evaluate ϕ instructions. An alternative view is that the - scope of variables [reg] assigned in instructions such as [Load] is the + needed to evaluate ϕ instructions. An alternative view is that the scope + of variables [reg] assigned in instructions such as [Load] is the successor block as well as all blocks the instruction dominates in the control-flow graph. This language is first-order, and a term structure for the code constituting the scope of variables is not needed, so SSA diff --git a/sledge/src/llair/typ.ml b/sledge/src/llair/typ.ml index b85fe5cde..3dbfbf9a2 100644 --- a/sledge/src/llair/typ.ml +++ b/sledge/src/llair/typ.ml @@ -17,7 +17,7 @@ type t = | Struct of { name: string ; elts: t vector (* possibly cyclic, name unique *) - [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] + [@compare.ignore] [@equal.ignore] [@sexp_drop_if fun _ -> true] ; packed: bool } | Opaque of {name: string} [@@deriving compare, equal, hash, sexp]