[ocamlformat] Upgrade ocamlformat to v0.2 from opam

Summary:
Change ocamlformat installation procedure to use opam instead of
pinning.

Reformat all code with v0.2, which has a few improvements.

Reviewed By: jvillard

Differential Revision: D6292057

fbshipit-source-id: 759967f
master
Josh Berdine 7 years ago committed by Facebook Github Bot
parent 794c8677fd
commit f62ab09e61

@ -1,3 +1,3 @@
margin 100
sparse true
version v0.1
version v0.2

@ -579,7 +579,7 @@ opam.lock: opam
# This is a magical version number that doesn't reinstall the world when added on top of what we
# have in opam.lock. 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 = ocp-indent merlin utop.2.0.1
OPAM_DEV_DEPS = ocamlformat.$$(grep version .ocamlformat | cut -d ' ' -f 2) ocp-indent merlin utop.2.0.1
ifneq ($(EMACS),no)
OPAM_DEV_DEPS += tuareg
@ -589,9 +589,8 @@ endif
devsetup: Makefile.autoconf
$(QUIET)[ $(OPAM) != "no" ] || (echo 'No `opam` found, aborting setup.' >&2; exit 1)
$(QUIET)$(call silent_on_success,installing $(OPAM_DEV_DEPS),\
OPAMSWITCH=$(OPAMSWITCH); $(OPAM) pin remove --yes ocamlformat $(OPAM_DEV_DEPS)\
OPAMSWITCH=$(OPAMSWITCH); $(OPAM) install --yes --no-checksum user-setup $(OPAM_DEV_DEPS))
$(QUIET)$(call silent_on_success,installing ocamlformat,\
OPAMSWITCH=$(OPAMSWITCH); $(OPAM) pin add --yes ocamlformat https://github.com/ocaml-ppx/ocamlformat.git#$$(grep version .ocamlformat | cut -d ' ' -f 2))
$(QUIET)echo '$(TERM_INFO)*** Running `opam config setup -a`$(TERM_RESET)' >&2
$(QUIET)OPAMSWITCH=$(OPAMSWITCH); $(OPAM) config --yes setup -a
$(QUIET)echo '$(TERM_INFO)*** Running `opam user-setup`$(TERM_RESET)' >&2

@ -25,8 +25,7 @@ let remove_proc_desc cfg pname = Typ.Procname.Hash.remove cfg.proc_desc_table pn
let iter_proc_desc cfg f = Typ.Procname.Hash.iter f cfg.proc_desc_table
let find_proc_desc_from_name cfg pname =
try Some (Typ.Procname.Hash.find cfg.proc_desc_table pname)
with Not_found -> None
try Some (Typ.Procname.Hash.find cfg.proc_desc_table pname) with Not_found -> None
(** Create a new procdesc *)
@ -253,8 +252,7 @@ let mark_unchanged_pdescs cfg_new cfg_old =
(Procdesc.Node.get_preds n2)
&& instrs_eq (Procdesc.Node.get_instrs n1) (Procdesc.Node.get_instrs n2)
in
try List.for_all2_exn ~f:node_eq n1s n2s
with Invalid_argument _ -> false
try List.for_all2_exn ~f:node_eq n1s n2s with Invalid_argument _ -> false
in
let att1 = Procdesc.get_attributes pd1 and att2 = Procdesc.get_attributes pd2 in
Bool.equal att1.is_defined att2.is_defined && Typ.equal att1.ret_type att2.ret_type
@ -318,8 +316,7 @@ let convert_cfg ~callee_pdesc ~resolved_pdesc convert_instr_list =
[]
| node :: other_node ->
let converted_node =
try Procdesc.NodeMap.find node !node_map
with Not_found ->
try Procdesc.NodeMap.find node !node_map with Not_found ->
let new_node = convert_node node
and successors = Procdesc.Node.get_succs node
and exn_nodes = Procdesc.Node.get_exn node in
@ -354,8 +351,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions =
in
let subst_map = ref Ident.IdentMap.empty in
let redirect_typename origin_id =
try Some (Ident.IdentMap.find origin_id !subst_map)
with Not_found -> None
try Some (Ident.IdentMap.find origin_id !subst_map) with Not_found -> None
in
let convert_instr instrs = function
| Sil.Load
@ -364,8 +360,8 @@ let specialize_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 Not_found -> origin_typename
try Mangled.Map.find (Pvar.get_name origin_pvar) substitutions with Not_found ->
origin_typename
in
subst_map := Ident.IdentMap.add id specialized_typname !subst_map ;
Sil.Load (id, convert_exp origin_exp, mk_ptr_typ specialized_typname, loc) :: instrs
@ -610,3 +606,4 @@ let pp_proc_signatures fmt cfg =
F.fprintf fmt "METHOD SIGNATURES@\n@." ;
let sorted_procs = List.sort ~cmp:Procdesc.compare (get_all_procs cfg) in
List.iter ~f:(fun pdesc -> F.fprintf fmt "%a@." Procdesc.pp_signature pdesc) sorted_procs

@ -321,10 +321,7 @@ module Err_table = struct
(* map error name to count *)
let count_err (err_name: IssueType.t) n =
let err_string = err_name.IssueType.unique_id in
let count =
try String.Map.find_exn !err_name_map err_string
with Not_found -> 0
in
let count = try String.Map.find_exn !err_name_map err_string with Not_found -> 0 in
err_name_map := String.Map.add ~key:err_string ~data:(count + n) !err_name_map
in
let count key err_datas =

@ -277,3 +277,4 @@ let is_objc_block_closure = function
Typ.Procname.is_objc_block name
| _ ->
false

@ -16,8 +16,7 @@ let errLogMap = ref Typ.Procname.Map.empty
let exists_issues () = not (Typ.Procname.Map.is_empty !errLogMap)
let get_err_log procname =
try Typ.Procname.Map.find procname !errLogMap
with Not_found ->
try Typ.Procname.Map.find procname !errLogMap with Not_found ->
let errlog = Errlog.empty () in
errLogMap := Typ.Procname.Map.add procname errlog !errLogMap ;
errlog
@ -38,10 +37,7 @@ let load_issues issues_file = Serialization.read_from_file lint_issues_serialize
(** Load all the lint issues in the given dir and update the issues map *)
let load_issues_to_errlog_map dir =
let issues_dir = Filename.concat Config.results_dir dir in
let children_opt =
try Some (Sys.readdir issues_dir)
with Sys_error _ -> None
in
let children_opt = try Some (Sys.readdir issues_dir) with Sys_error _ -> None in
let load_issues_to_map issues_file =
let file = DB.filename_from_string (Filename.concat issues_dir issues_file) in
match load_issues file with

@ -278,3 +278,4 @@ let get_initializer_pname {pv_name; pv_kind} =
(Config.clang_initializer_prefix ^ Mangled.to_string_full pv_name))
| _ ->
None

@ -1945,10 +1945,7 @@ type sharing_env = {exph: Exp.t Exp.Hash.t; hpredh: hpred HpredInstHash.t}
let create_sharing_env () = {exph= Exp.Hash.create 3; hpredh= HpredInstHash.create 3}
(** Return a canonical representation of the exp *)
let exp_compact sh e =
try Exp.Hash.find sh.exph e
with Not_found -> Exp.Hash.add sh.exph e e ; e
let exp_compact sh e = try Exp.Hash.find sh.exph e with Not_found -> Exp.Hash.add sh.exph e e ; e
let rec sexp_compact sh se =
match se with
@ -1975,8 +1972,7 @@ let _hpred_compact sh hpred =
let hpred_compact sh hpred =
try HpredInstHash.find sh.hpredh hpred
with Not_found ->
try HpredInstHash.find sh.hpredh hpred with Not_found ->
let hpred' = _hpred_compact sh hpred in
HpredInstHash.add sh.hpredh hpred' hpred' ;
hpred'
@ -2052,8 +2048,7 @@ let sigma_to_sigma_ne sigma : (atom list * hpred list) list =
let hpara_instantiate para e1 e2 elist =
let subst_for_svars =
let g id e = (id, e) in
try List.map2_exn ~f:g para.svars elist
with Invalid_argument _ -> assert false
try List.map2_exn ~f:g para.svars elist with Invalid_argument _ -> assert false
in
let ids_evars =
let g _ = Ident.create_fresh Ident.kprimed in
@ -2061,8 +2056,7 @@ let hpara_instantiate para e1 e2 elist =
in
let subst_for_evars =
let g id id' = (id, Exp.Var id') in
try List.map2_exn ~f:g para.evars ids_evars
with Invalid_argument _ -> assert false
try List.map2_exn ~f:g para.evars ids_evars with Invalid_argument _ -> assert false
in
let subst =
`Exp
@ -2079,8 +2073,7 @@ let hpara_instantiate para e1 e2 elist =
let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist =
let subst_for_svars =
let g id e = (id, e) in
try List.map2_exn ~f:g para.svars_dll elist
with Invalid_argument _ -> assert false
try List.map2_exn ~f:g para.svars_dll elist with Invalid_argument _ -> assert false
in
let ids_evars =
let g _ = Ident.create_fresh Ident.kprimed in
@ -2088,8 +2081,7 @@ let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist =
in
let subst_for_evars =
let g id id' = (id, Exp.Var id') in
try List.map2_exn ~f:g para.evars_dll ids_evars
with Invalid_argument _ -> assert false
try List.map2_exn ~f:g para.evars_dll ids_evars with Invalid_argument _ -> assert false
in
let subst =
`Exp

@ -99,8 +99,7 @@ end)
let check_subtype =
let subtMap = ref SubtypesMap.empty in
fun tenv c1 c2 ->
( try SubtypesMap.find (c1, c2) !subtMap
with Not_found ->
( try SubtypesMap.find (c1, c2) !subtMap with Not_found ->
let is_subt = check_subclass_tenv tenv c1 c2 in
subtMap := SubtypesMap.add (c1, c2) is_subt !subtMap ;
is_subt

@ -52,16 +52,13 @@ let mem tenv name = TypenameHash.mem tenv name
(** Look up a name in the global type environment. *)
let lookup tenv name : Typ.Struct.t option =
try Some (TypenameHash.find tenv name)
with Not_found ->
try Some (TypenameHash.find tenv name) with Not_found ->
(* ToDo: remove the following additional lookups once C/C++ interop is resolved *)
match (name : Typ.Name.t) with
| CStruct m -> (
try Some (TypenameHash.find tenv (CppClass (m, NoTemplate)))
with Not_found -> None )
try Some (TypenameHash.find tenv (CppClass (m, NoTemplate))) with Not_found -> None )
| CppClass (m, NoTemplate) -> (
try Some (TypenameHash.find tenv (CStruct m))
with Not_found -> None )
try Some (TypenameHash.find tenv (CStruct m)) with Not_found -> None )
| _ ->
None

@ -192,8 +192,7 @@ module Map (Key : PrettyPrintable.PrintableOrderedType) (ValueDomain : S) = stru
else
M.for_all
(fun k lhs_v ->
try ValueDomain.( <= ) ~lhs:lhs_v ~rhs:(M.find k rhs)
with Not_found -> false)
try ValueDomain.( <= ) ~lhs:lhs_v ~rhs:(M.find k rhs) with Not_found -> false)
lhs

@ -50,8 +50,7 @@ struct
(** extract the state of node [n] from [inv_map] *)
let extract_state node_id inv_map =
try Some (InvariantMap.find node_id inv_map)
with Not_found -> None
try Some (InvariantMap.find node_id inv_map) with Not_found -> None
(** extract the postcondition of node [n] from [inv_map] *)

@ -32,10 +32,7 @@ let empty = AccessPath.BaseMap.empty
let is_formal = AccessPath.BaseMap.mem
let get_formal_index base t =
try Some (AccessPath.BaseMap.find base t)
with Not_found -> None
let get_formal_index base t = try Some (AccessPath.BaseMap.find base t) with Not_found -> None
let get_formal_base index t =
List.find ~f:(fun (_, i) -> Int.equal i index) (AccessPath.BaseMap.bindings t)

@ -47,8 +47,7 @@ struct
let exec_instr ((actual_state, id_map) as astate) extras node instr =
let f_resolve_id id =
try Some (IdAccessPathMapDomain.find id id_map)
with Not_found -> None
try Some (IdAccessPathMapDomain.find id id_map) with Not_found -> None
in
match
HilInstr.of_sil ~include_array_indexes:HilConfig.include_array_indexes ~f_resolve_id instr

@ -189,8 +189,7 @@ module Exceptional = struct
let add_exn_pred exn_preds_acc exn_succ_node =
let exn_succ_node_id = Procdesc.Node.get_id exn_succ_node in
let existing_exn_preds =
try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc
with Not_found -> []
try Procdesc.IdMap.find exn_succ_node_id exn_preds_acc with Not_found -> []
in
if not (List.mem ~equal:Procdesc.Node.equal existing_exn_preds n) then
(* don't add duplicates *)
@ -216,8 +215,7 @@ module Exceptional = struct
let normal_preds _ n = Procdesc.Node.get_preds n
let exceptional_preds (_, exn_pred_map) n =
try Procdesc.IdMap.find (Procdesc.Node.get_id n) exn_pred_map
with Not_found -> []
try Procdesc.IdMap.find (Procdesc.Node.get_id n) exn_pred_map with Not_found -> []
(** get all normal and exceptional successors of [n]. *)

@ -82,8 +82,8 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
let schedule_succ worklist_acc node_to_schedule =
let id_to_schedule = CFG.id node_to_schedule in
let old_work =
try M.find id_to_schedule worklist_acc
with Not_found -> WorkUnit.make t.cfg node_to_schedule
try M.find id_to_schedule worklist_acc with Not_found ->
WorkUnit.make t.cfg node_to_schedule
in
let new_work = WorkUnit.add_visited_pred t.cfg old_work node_id in
M.add id_to_schedule new_work worklist_acc

@ -372,6 +372,7 @@ let execute___set_file_attribute {Builtin.tenv; pdesc; prop_; path; ret_id; args
| _ ->
raise (Exceptions.Wrong_argument_number __POS__)
(** Set the resource attribute of the first real argument of method as ignore, the first argument is
assumed to be "this" *)
let execute___method_set_ignore_attribute {Builtin.tenv; pdesc; prop_; path; ret_id; args; loc}
@ -1066,6 +1067,7 @@ let __objc_cast = Builtin.register BuiltinDecl.__objc_cast execute___objc_cast
let __objc_dictionary_literal =
Builtin.register BuiltinDecl.__objc_dictionary_literal execute___objc_dictionary_literal
let __objc_release_cf = Builtin.register BuiltinDecl.__objc_release_cf execute___objc_release_cf
let __objc_retain_cf = Builtin.register BuiltinDecl.__objc_retain_cf execute___objc_retain_cf
@ -1081,6 +1083,7 @@ let __print_value = Builtin.register BuiltinDecl.__print_value execute___print_v
let __require_allocated_array =
Builtin.register BuiltinDecl.__require_allocated_array execute___require_allocated_array
let __set_array_length = Builtin.register BuiltinDecl.__set_array_length execute___set_array_length
let __set_file_attribute =
@ -1090,7 +1093,6 @@ let __set_file_attribute =
(* set a hidden field in the struct to the given value *)
let __set_hidden_field = Builtin.register BuiltinDecl.__set_hidden_field execute___set_hidden_field
let __set_locked_attribute =
Builtin.register BuiltinDecl.__set_locked_attribute execute___set_locked_attribute

@ -24,10 +24,7 @@ let load_specfiles () =
let is_specs_file fname =
Sys.is_directory fname <> `Yes && Filename.check_suffix fname Config.specs_files_suffix
in
let all_filenames =
try Array.to_list (Sys.readdir dir)
with Sys_error _ -> []
in
let all_filenames = try Array.to_list (Sys.readdir dir) with Sys_error _ -> [] in
let all_filepaths = List.map ~f:(fun fname -> Filename.concat dir fname) all_filenames in
List.filter ~f:is_specs_file all_filepaths
in
@ -585,8 +582,8 @@ module Stats = struct
let process_loc loc stats =
try Hashtbl.find stats.files loc.Location.file
with Not_found -> Hashtbl.add stats.files loc.Location.file ()
try Hashtbl.find stats.files loc.Location.file with Not_found ->
Hashtbl.add stats.files loc.Location.file ()
let loc_trace_to_string_list linereader indent_num ltr =

@ -88,3 +88,4 @@ let resolve_method_with_block_args_and_analyze caller_pdesc pname act_params =
None )
| _ ->
None

@ -71,8 +71,7 @@ let create_condition_ls ids_private id_base p_leftover (inst: Sil.exp_subst) =
let inst_private, inst_public = Sil.sub_domain_partition f inst in
let insts_of_public_ids = Sil.sub_range inst_public in
let inst_of_base =
try Sil.sub_find (Ident.equal id_base) inst_public
with Not_found -> assert false
try Sil.sub_find (Ident.equal id_base) inst_public with Not_found -> assert false
in
let insts_of_private_ids = Sil.sub_range inst_private in
(insts_of_private_ids, insts_of_public_ids, inst_of_base)

@ -45,8 +45,8 @@ let is_registered name =
(** 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 Not_found -> check_register_populated () ; None
try Some (Typ.Procname.Hash.find builtin_functions name) with Not_found ->
check_register_populated () ; None
(** register a builtin [Typ.Procname.t] and symbolic execution handler *)

@ -100,8 +100,7 @@ end = struct
let lookup' tbl e default =
match e with
| Exp.Var _ -> (
try Hashtbl.find tbl e
with Not_found -> Hashtbl.replace tbl e default ; default )
try Hashtbl.find tbl e with Not_found -> Hashtbl.replace tbl e default ; default )
| _ ->
assert false

@ -114,8 +114,7 @@ let strip_special_chars b =
let replace st c c' =
if String.contains st c then
let idx = String.index_exn st c in
try st.[idx] <- c' ; st
with Invalid_argument _ ->
try st.[idx] <- c' ; st with Invalid_argument _ ->
L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ;
assert false
else st
@ -1300,8 +1299,7 @@ let pp_speclist_to_file (filename: DB.filename) spec_list =
let pp_speclist_dotty_file (filename: DB.filename) spec_list =
try pp_speclist_to_file filename spec_list
with exn when SymOp.exn_not_failure exn -> ()
try pp_speclist_to_file filename spec_list with exn when SymOp.exn_not_failure exn -> ()
(**********************************************************************)

@ -118,8 +118,7 @@ let add_cg (exe_env: t) (source_dir: DB.source_dir) =
let get_cg exe_env = exe_env.cg
let get_file_data exe_env pname =
try Some (Typ.Procname.Hash.find exe_env.proc_map pname)
with Not_found ->
try Some (Typ.Procname.Hash.find exe_env.proc_map pname) with Not_found ->
let source_file_opt =
match Attributes.load pname with
| None ->

@ -41,8 +41,7 @@ let is_matching patterns source_file =
let path = SourceFile.to_rel_path source_file in
List.exists
~f:(fun pattern ->
try Int.equal (Str.search_forward pattern path 0) 0
with Not_found -> false)
try Int.equal (Str.search_forward pattern path 0) 0 with Not_found -> false)
patterns
@ -76,8 +75,7 @@ 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 Not_found ->
try SourceFile.Map.find source_file !source_map with 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
@ -107,10 +105,7 @@ module FileOrProcMatcher = struct
let pattern_map =
List.fold
~f:(fun map pattern ->
let previous =
try String.Map.find_exn map pattern.class_name
with Not_found -> []
in
let previous = try String.Map.find_exn map pattern.class_name with Not_found -> [] in
String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map)
~init:String.Map.empty m_patterns
in

@ -79,10 +79,7 @@ end = struct
let create () : t = Hashtbl.create 11
let find table i =
try Hashtbl.find table i
with Not_found -> Paths.PathSet.empty
let find table i = try Hashtbl.find table i with Not_found -> Paths.PathSet.empty
let add table i dset = Hashtbl.replace table i dset
end
@ -109,8 +106,7 @@ module Worklist = struct
let add (wl: t) (node: Procdesc.Node.t) : unit =
let visits =
(* recover visit count if it was visited before *)
try Procdesc.NodeMap.find node wl.visit_map
with Not_found -> 0
try Procdesc.NodeMap.find node wl.visit_map with Not_found -> 0
in
wl.todo_set <- NodeVisitSet.add {node; visits} wl.todo_set
@ -140,8 +136,7 @@ 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 Not_found ->
try Hashtbl.find htable key with Not_found ->
Hashtbl.replace htable key Paths.PathSet.empty ;
Paths.PathSet.empty
@ -702,8 +697,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list =
let pre_post_map =
let add map (pre, post, visited) =
let current_posts, current_visited =
try Pmap.find pre map
with Not_found -> (Paths.PathSet.empty, Specs.Visitedset.empty)
try Pmap.find pre map with Not_found -> (Paths.PathSet.empty, Specs.Visitedset.empty)
in
let new_posts =
match post with
@ -1387,8 +1381,7 @@ let analyze_procedure_aux cg_opt tenv proc_desc =
let analyze_procedure {Callbacks.summary; proc_desc; tenv} : Specs.summary =
let proc_name = Procdesc.get_proc_name proc_desc in
Specs.add_summary proc_name summary ;
( try ignore (analyze_procedure_aux None tenv proc_desc)
with exn ->
( try ignore (analyze_procedure_aux None tenv proc_desc) with exn ->
reraise_if exn ~f:(fun () -> not (Exceptions.handle_exception exn)) ;
Reporting.log_error_deprecated proc_name exn ) ;
Specs.get_summary_unsafe __FILE__ proc_name

@ -260,9 +260,8 @@ 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
@ -275,9 +274,8 @@ 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)

@ -406,8 +406,7 @@ 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 Not_found ->
try ignore (PathMap.find p !delayed) with Not_found ->
incr delayed_num ;
delayed := PathMap.add p !delayed_num !delayed
in

@ -46,8 +46,7 @@ module LineReader = struct
let file_data (hash: t) fname =
try Some (Hashtbl.find hash fname)
with Not_found ->
try Some (Hashtbl.find hash fname) with Not_found ->
try
let lines_arr = read_file (SourceFile.to_abs_path fname) in
Hashtbl.add hash fname lines_arr ; Some lines_arr
@ -416,10 +415,7 @@ let write_html_proc source proof_cover table_nodes_at_linenum global_err_log pro
let proc_name = Procdesc.get_proc_name proc_desc in
let process_node n =
let lnum = (Procdesc.Node.get_loc n).Location.line in
let curr_nodes =
try Hashtbl.find table_nodes_at_linenum lnum
with Not_found -> []
in
let curr_nodes = try Hashtbl.find table_nodes_at_linenum lnum with Not_found -> [] in
Hashtbl.replace table_nodes_at_linenum lnum (n :: curr_nodes)
in
let proc_loc = Procdesc.get_loc proc_desc in
@ -463,8 +459,7 @@ let write_html_file linereader filename procs =
raise End_of_file
in
let nodes_at_linenum =
try Hashtbl.find table_nodes_at_linenum line_number
with Not_found -> []
try Hashtbl.find table_nodes_at_linenum line_number with Not_found -> []
in
let errors_at_linenum =
try

@ -1076,8 +1076,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 ->
@ -1092,8 +1092,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 ->
@ -2131,10 +2131,7 @@ let rec idlist_assoc id = function
if Ident.equal i id then x else idlist_assoc id l
let ident_captured_ren ren id =
try idlist_assoc id ren
with Not_found -> id
let ident_captured_ren ren id = try idlist_assoc id ren with Not_found -> id
(* If not defined in ren, id should be mapped to itself *)

@ -205,9 +205,7 @@ let compute_edge_diff (oldedge: edge) (newedge: edge) : Obj.t list =
compute_exp_diff e1 e2
| Eatom Sil.Apred (_, es1), Eatom Sil.Apred (_, es2)
| Eatom Sil.Anpred (_, es1), Eatom Sil.Anpred (_, es2) ->
List.concat
( try List.map2_exn ~f:compute_exp_diff es1 es2
with Invalid_argument _ -> [] )
List.concat (try List.map2_exn ~f:compute_exp_diff es1 es2 with Invalid_argument _ -> [])
| Esub_entry (_, e1), Esub_entry (_, e2) ->
compute_exp_diff e1 e2
| _ ->

@ -16,8 +16,8 @@ module L = Logging
module F = Format
let decrease_indent_when_exception thunk =
try thunk ()
with exn when SymOp.exn_not_failure exn -> reraise_after exn ~f:(fun () -> L.d_decrease_indent 1)
try thunk () with exn when SymOp.exn_not_failure exn ->
reraise_after exn ~f:(fun () -> L.d_decrease_indent 1)
let compute_max_from_nonempty_int_list l = uw (List.max_elt ~cmp:IntLit.compare_value l)
@ -1504,8 +1504,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
@ -2260,11 +2260,10 @@ 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 _ ->
@ -2775,8 +2774,7 @@ let find_minimum_pure_cover tenv cases =
else _shrink ((pi, x) :: seen) todo'
in
let shrink cases = if List.length cases > 2 then _shrink [] cases else cases in
try Some (shrink (grow [] cases))
with NO_COVER -> None
try Some (shrink (grow [] cases)) with NO_COVER -> None
(*

@ -862,7 +862,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
in
List.find_map
~f:(fun hpred ->
( match[@warning "-57"] (* FIXME: silenced warning may be legit *) hpred with
match[@warning "-57"] (* FIXME: silenced warning may be legit *) hpred with
| Sil.Hpointsto ((Const Cclass clazz as lhs_exp), _, Exp.Sizeof {typ})
| Sil.Hpointsto (_, Sil.Eexp ((Const Cclass clazz as lhs_exp), _), Exp.Sizeof {typ})
when guarded_by_str_is_class guarded_by_str0 (Ident.name_to_string clazz) ->
@ -888,7 +888,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
&& Pvar.is_this pvar ->
Some (rhs_exp, typ)
| _ ->
None ))
None)
sigma
in
(* warn if the access to [lexp] is not protected by the [guarded_by_fld_str] lock *)
@ -1507,8 +1507,7 @@ 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 -> None
try List.find_map ~f:attr_has_annot (Attribute.get_for_exp tenv prop exp) with Not_found -> None
let is_strexp_pt_fld_with_annot tenv obj_str is_annotation typ deref_exp (fld, strexp) =

@ -274,8 +274,7 @@ module CallStats = struct
let trace t proc_name loc res in_footprint =
let tr_old =
try PnameLocHash.find t (proc_name, loc)
with Not_found ->
try PnameLocHash.find t (proc_name, loc) with Not_found ->
PnameLocHash.add t (proc_name, loc) empty_trace ;
empty_trace
in
@ -652,8 +651,8 @@ let load_summary_to_spec_table proc_name =
let rec get_summary proc_name =
try Some (Typ.Procname.Hash.find spec_tbl proc_name)
with Not_found -> if load_summary_to_spec_table proc_name then get_summary proc_name else None
try Some (Typ.Procname.Hash.find spec_tbl proc_name) with Not_found ->
if load_summary_to_spec_table proc_name then get_summary proc_name else None
let get_summary_unsafe s proc_name =

@ -76,8 +76,7 @@ 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 Not_found ->
try NodeHash.find !gs.failure_map node with 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
@ -194,17 +193,13 @@ let mk_find_duplicate_nodes proc_desc : Procdesc.Node.t -> Procdesc.NodeSet.t =
let do_node node =
let normalized_instrs = instrs_normalize (Procdesc.Node.get_instrs node) in
let key = get_key node in
let s =
try M.find key !m
with Not_found -> S.empty
in
let s = try M.find key !m with Not_found -> S.empty in
if S.cardinal s > E.threshold then raise E.Threshold ;
let s' = S.add (node, normalized_instrs) s in
m := M.add key s' !m
in
let nodes = Procdesc.get_nodes proc_desc in
try List.iter ~f:do_node nodes ; !m
with E.Threshold -> M.empty
try List.iter ~f:do_node nodes ; !m with E.Threshold -> M.empty
in
let find_duplicate_nodes node =
try
@ -269,10 +264,7 @@ let extract_pre p tenv pdesc abstract_fun =
in
let _, p' = PropUtil.remove_locals_formals tenv pdesc p in
let pre, _ = Prop.extract_spec p' in
let pre' =
try abstract_fun tenv pre
with exn when SymOp.exn_not_failure exn -> pre
in
let pre' = try abstract_fun tenv pre with exn when SymOp.exn_not_failure exn -> pre in
Prop.normalize tenv (Prop.prop_sub sub pre')

@ -37,8 +37,7 @@ let unroll_type tenv (typ: Typ.t) (off: Sil.offset) =
| Tstruct name, Off_fld (fld, _) -> (
match Tenv.lookup tenv name with
| Some {fields; statics} -> (
try fldlist_assoc fld (fields @ statics)
with Not_found -> fail Typ.Fieldname.to_string fld )
try fldlist_assoc fld (fields @ statics) with Not_found -> fail Typ.Fieldname.to_string fld )
| None ->
fail Typ.Fieldname.to_string fld )
| Tarray (typ', _, _), Off_index _ ->
@ -398,10 +397,7 @@ let reason_to_skip callee_summary : string option =
(** In case of constant string dereference, return the result immediately *)
let check_constant_string_dereference lexp =
let string_lookup s n =
let c =
try Char.to_int s.[IntLit.to_int n]
with Invalid_argument _ -> 0
in
let c = try Char.to_int s.[IntLit.to_int n] with Invalid_argument _ -> 0 in
Exp.int (IntLit.of_int c)
in
match lexp with
@ -1132,7 +1128,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
Specs.CallStats.trace summary.Specs.stats.Specs.call_stats callee_pname loc
Specs.CallStats.CR_skip !Config.footprint ) ;
unknown_or_scan_call ~is_scan:false ~reason ret_typ_opt ret_annots
(Builtin.
Builtin.
{ pdesc= current_pdesc
; instr
; tenv
@ -1141,7 +1137,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
; ret_id
; args= actual_args
; proc_name= callee_pname
; loc })
; loc }
in
if is_objc_instance_method then
handle_objc_instance_method_call_or_skip current_pdesc tenv actual_args path callee_pname
@ -1362,7 +1358,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
let callee_pname = Typ.Procname.from_string_c_fun "__function_pointer__" in
unknown_or_scan_call ~is_scan:false ~reason:"unresolved function pointer" None
Annot.Item.empty
(Builtin.
Builtin.
{ pdesc= current_pdesc
; instr
; tenv
@ -1371,7 +1367,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
; ret_id
; args= n_actual_params
; proc_name= callee_pname
; loc }) )
; loc } )
| Sil.Nullify (pvar, _)
-> (
let eprop = Prop.expose prop_ in
@ -1436,8 +1432,7 @@ and instrs ?(mask_errors= false) tenv pdesc instrs ppl =
L.d_str "Executing Generated Instruction " ;
Sil.d_instr instr ;
L.d_ln () ;
try sym_exec tenv pdesc instr p path
with exn ->
try sym_exec tenv pdesc instr p path with exn ->
reraise_if exn ~f:(fun () -> not mask_errors || not (SymOp.exn_not_failure exn)) ;
let error = Exceptions.recognize_exception exn in
let loc =
@ -1642,8 +1637,7 @@ and check_variadic_sentinel ?(fails_on_nil= false) n_formals (sentinel, null_pos
(* simulate a Load for [lexp] *)
let tmp_id_deref = Ident.create_fresh Ident.kprimed in
let load_instr = Sil.Load (tmp_id_deref, lexp, typ, loc) in
try instrs tenv pdesc [load_instr] result
with e when SymOp.exn_not_failure e ->
try instrs tenv pdesc [load_instr] result with e when SymOp.exn_not_failure e ->
reraise_if e ~f:(fun () -> fails_on_nil) ;
let deref_str = Localise.deref_str_nil_argument_in_variadic_method proc_name nargs i in
let err_desc =

@ -478,8 +478,7 @@ let rec fsel_star_fld fsel1 fsel2 =
and array_content_star se1 se2 =
try sexp_star_fld se1 se2
with exn when SymOp.exn_not_failure exn -> se1
try sexp_star_fld se1 se2 with exn when SymOp.exn_not_failure exn -> se1
(* let postcondition override *)
@ -585,8 +584,7 @@ let sigma_star_fld tenv (sigma1: Sil.hpred list) (sigma2: Sil.hpred list) : Sil.
| _ ->
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 " ;
@ -627,8 +625,7 @@ let sigma_star_typ (sigma1: Sil.hpred list) (typings2: (Exp.t * Exp.t) list) : S
| _ ->
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 " ;

@ -234,10 +234,7 @@ let add parse_mode sections desc =
desc_list := desc :: !desc_list ;
let add_to_section (command, section) =
let sections = List.Assoc.find_exn ~equal:equal_command help_sections_desc_lists command in
let prev_contents =
try SectionMap.find section !sections
with Not_found -> []
in
let prev_contents = try SectionMap.find section !sections with Not_found -> [] in
sections := SectionMap.add section (desc :: prev_contents) !sections
in
List.iter sections ~f:add_to_section ;
@ -317,8 +314,7 @@ let mk ?(deprecated= []) ?(parse_mode= InferCommand) ?(in_help= []) ~long ?short
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 ("bad value " ^ str ^ " for flag " ^ long ^ " (" ^ Exn.to_string exc ^ ")"))
in
let spec = mk_spec setter in

@ -1033,7 +1033,7 @@ and ( bo_debug
"Debug level for the capture. See $(b,--debug-level) for accepted values."
and debug_level_linters =
CLOpt.mk_int ~long:"debug-level-linters" ~default:0
~in_help:(CLOpt.((Capture, manual_clang_linters)) :: all_generic_manuals)
~in_help:(CLOpt.(Capture, manual_clang_linters) :: all_generic_manuals)
"Debug level for the linters. See $(b,--debug-level) for accepted values."
and developer_mode =
CLOpt.mk_bool ~long:"developer-mode"
@ -1111,11 +1111,11 @@ and ( bo_debug
and print_logs =
CLOpt.mk_bool ~long:"print-logs"
~in_help:
(CLOpt.(
CLOpt.(
[ (Analyze, manual_generic)
; (Capture, manual_generic)
; (Run, manual_generic)
; (Report, manual_generic) ]))
; (Report, manual_generic) ])
"Also log messages to stdout and stderr"
and stats =
CLOpt.mk_bool ~deprecated:["stats"] ~long:"stats" "Stats mode (debugging)" ~f:(fun stats ->
@ -1290,11 +1290,11 @@ and flavors =
and force_delete_results_dir =
CLOpt.mk_bool ~long:"force-delete-results-dir" ~default:false
~in_help:
(CLOpt.(
CLOpt.(
[ (Capture, manual_generic)
; (Compile, manual_generic)
; (Diff, manual_generic)
; (Run, manual_generic) ]))
; (Run, manual_generic) ])
"Do not refuse to delete the results directory if it doesn't look like an infer results directory."
@ -1675,11 +1675,11 @@ and project_root =
CLOpt.mk_path ~deprecated:["project_root"; "-project_root"; "pr"] ~long:"project-root" ~short:'C'
~default:CLOpt.init_work_dir
~in_help:
(CLOpt.(
CLOpt.(
[ (Analyze, manual_generic)
; (Capture, manual_generic)
; (Run, manual_generic)
; (Report, manual_generic) ]))
; (Report, manual_generic) ])
~meta:"dir" "Specify the root directory of the project"
@ -1771,12 +1771,12 @@ and results_dir =
CLOpt.mk_path ~deprecated:["results_dir"; "-out"] ~long:"results-dir" ~short:'o'
~default:(CLOpt.init_work_dir ^/ "infer-out")
~in_help:
(CLOpt.(
CLOpt.(
[ (Analyze, manual_generic)
; (Capture, manual_generic)
; (Explore, manual_generic)
; (Run, manual_generic)
; (Report, manual_generic) ]))
; (Report, manual_generic) ])
~meta:"dir" "Write results and internal files in the specified directory"

@ -26,8 +26,7 @@ let activate_run_epilogues_on_signal =
let register ~f desc =
let f_no_exn () =
if not !ProcessPool.in_child then
try f ()
with exn ->
try f () with exn ->
F.eprintf "Error while running epilogue \"%s\":@ %a.@ Powering through...@." desc Exn.pp
exn
in

@ -67,3 +67,4 @@ let merge_buck_flavors_results infer_deps_file =
List.iter ~f:one_line lines
| Error error ->
L.internal_error "Couldn't read deps file '%s': %s" infer_deps_file error

@ -50,8 +50,7 @@ let write multilinks ~dir =
let lookup ~dir =
try Some (String.Table.find_exn multilink_files_cache dir)
with Not_found -> read ~dir
try Some (String.Table.find_exn multilink_files_cache dir) with Not_found -> read ~dir
let resolve fname =
@ -64,6 +63,5 @@ let resolve fname =
| None ->
fname
| Some links ->
try DB.filename_from_string (String.Table.find_exn links base)
with Not_found -> fname
try DB.filename_from_string (String.Table.find_exn links base) with Not_found -> fname

@ -39,8 +39,8 @@ let create_db () =
(* Write-ahead log is much faster than other journalling modes. *)
SqliteUtils.exec db ~log:"journal_mode=WAL" ~stmt:"PRAGMA journal_mode=WAL" ;
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 []
@ -69,8 +69,7 @@ let register_statement stmt_fmt =
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
@ -110,3 +109,4 @@ let new_database_connection () =
SqliteUtils.exec db ~log:"synchronous=NORMAL" ~stmt:"PRAGMA synchronous=NORMAL" ;
database := Some db ;
List.iter ~f:(fun callback -> callback db) !new_db_callbacks

@ -66,3 +66,4 @@ let delete_capture_and_analysis_data () =
List.iter ~f:Utils.rmtree dirs_to_delete ;
List.iter ~f:Unix.mkdir_p dirs_to_delete ;
()

@ -46,8 +46,7 @@ let retry_exception ~timeout ~catch_exn ~f x =
let init_time = Mtime_clock.counter () in
let expired () = Mtime.Span.compare timeout (Mtime_clock.count init_time) <= 0 in
let rec retry () =
try f x
with e when catch_exn e && not (expired ()) -> Utils.yield () ; (retry [@tailcall]) ()
try f x with e when catch_exn e && not (expired ()) -> Utils.yield () ; (retry [@tailcall]) ()
in
retry ()
@ -69,8 +68,7 @@ let create_serializer (key: Key.t) : 'a serializer =
else Some value
in
let read_from_string (str: string) : 'a option =
try read_data (Marshal.from_string str 0) "string"
with Sys_error _ -> None
try read_data (Marshal.from_string str 0) "string" with Sys_error _ -> None
in
(* The reads happen without synchronization.
The writes are synchronized with a .lock file. *)

@ -42,10 +42,7 @@ let from_abs_path ?(warn_on_error= true) fname =
if Filename.is_relative fname then
L.(die InternalError) "Path '%s' is relative, when absolute path was expected." fname ;
(* try to get realpath of source file. Use original if it fails *)
let fname_real =
try Utils.realpath ~warn_on_error fname
with Unix.Unix_error _ -> fname
in
let fname_real = try Utils.realpath ~warn_on_error fname with Unix.Unix_error _ -> fname in
let project_root_real = Utils.realpath ~warn_on_error Config.project_root in
let models_dir_real = Config.models_src_dir in
match Utils.filename_to_relative ~root:project_root_real fname_real with
@ -130,8 +127,7 @@ 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 ->
try String.Table.find_exn exists_cache abs_path with Not_found ->
let result = Sys.file_exists abs_path = `Yes in
String.Table.set exists_cache ~key:abs_path ~data:result ;
result

@ -25,8 +25,8 @@ let check_sqlite_error ?(fatal= false) ~log rc =
let exec db ~log ~stmt =
(* Call [check_sqlite_error] with [fatal:true] and catch exceptions to rewrite the error message. This avoids allocating the error string when not needed. *)
try check_sqlite_error ~fatal:true ~log (Sqlite3.exec db stmt)
with Error err -> error ~fatal:true "exec: %s" err
try check_sqlite_error ~fatal:true ~log (Sqlite3.exec db stmt) with Error err ->
error ~fatal:true "exec: %s" err
let finalize ~log stmt =
@ -78,3 +78,4 @@ let db_close db =
(Printf.sprintf "closing: %s (%s)"
(Sqlite3.errcode db |> Sqlite3.Rc.to_string)
(Sqlite3.errmsg db)))

@ -30,8 +30,7 @@ let try_finally ~f ~finally =
finally () ; r
| exception (Analysis_failure_exe _ as f_exn) ->
reraise_after f_exn ~f:(fun () ->
try finally ()
with _ -> (* swallow in favor of the original exception *) () )
try finally () with _ -> (* swallow in favor of the original exception *) () )
| exception f_exn ->
reraise_after f_exn ~f:(fun () ->
try finally ()

@ -170,17 +170,14 @@ let directory_is_empty path = Sys.readdir path |> Array.is_empty
let string_crc_hex32 s = Digest.to_hex (Digest.string s)
let read_json_file path =
try Ok (Yojson.Basic.from_file path)
with Sys_error msg | Yojson.Json_error msg -> Error msg
try Ok (Yojson.Basic.from_file path) with Sys_error msg | Yojson.Json_error msg -> Error msg
let do_finally_swallow_timeout ~f ~finally =
let res =
try f ()
with exc ->
try f () with exc ->
reraise_after exc ~f:(fun () ->
try finally () |> ignore
with _ -> (* swallow in favor of the original exception *) () )
try finally () |> ignore with _ -> (* swallow in favor of the original exception *) () )
in
let res' = finally () in
(res, res')
@ -210,8 +207,7 @@ let write_json_to_file destfile json =
let consume_in chan_in =
try while true do In_channel.input_line_exn chan_in |> ignore done
with End_of_file -> ()
try while true do In_channel.input_line_exn chan_in |> ignore done with End_of_file -> ()
let with_process_in command read =
@ -269,8 +265,7 @@ 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
@ -316,10 +311,7 @@ let suppress_stderr2 f2 x1 x2 =
let compare_versions v1 v2 =
let int_list_of_version v =
let lv = String.split ~on:'.' v in
let int_of_string_or_zero v =
try int_of_string v
with Failure _ -> 0
in
let int_of_string_or_zero v = try int_of_string v with Failure _ -> 0 in
List.map ~f:int_of_string_or_zero lv
in
let lv1 = int_list_of_version v1 in
@ -339,9 +331,7 @@ let write_file_with_locking ?(delete= false) ~f:do_write fname =
do_write outc ;
Out_channel.flush outc ;
ignore (Unix.flock file_descr Unix.Flock_command.unlock) ) ) ;
if delete then
try Unix.unlink fname
with Unix.Unix_error _ -> ()
if delete then try Unix.unlink fname with Unix.Unix_error _ -> ()
let rec rmtree name =

@ -197,8 +197,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| _ ->
mem
in
try List.fold2_exn formals actuals ~init:mem ~f
with Invalid_argument _ -> mem
try List.fold2_exn formals actuals ~init:mem ~f with Invalid_argument _ -> mem
let instantiate_mem

@ -218,8 +218,7 @@ module Val = struct
let traces_caller =
List.fold symbols
~f:(fun traces symbol ->
try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces
with Not_found -> traces)
try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces with Not_found -> traces)
~init:TraceSet.empty
in
let traces = TraceSet.instantiate ~traces_caller ~traces_callee:x.traces loc in
@ -265,11 +264,7 @@ module Stack = struct
let bot = empty
let find : Loc.t -> astate -> Val.t =
fun l m ->
try find l m
with Not_found -> Val.bot
let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.bot
let find_set : PowLoc.t -> astate -> Val.t =
fun locs mem ->
@ -326,11 +321,7 @@ module Heap = struct
let bot = empty
let find : Loc.t -> astate -> Val.t =
fun l m ->
try find l m
with Not_found -> Val.Itv.top
let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.Itv.top
let find_set : PowLoc.t -> astate -> Val.t =
fun locs mem ->
@ -448,9 +439,7 @@ module AliasMap = struct
let find : Ident.t -> t -> AliasTarget.t option =
fun k m ->
try Some (M.find k m)
with Not_found -> None
fun k m -> try Some (M.find k m) with Not_found -> None
let remove_temps : Ident.t list -> t -> t =

@ -24,8 +24,7 @@ module Make (CFG : ProcCfg.S) = struct
let eval_const : Const.t -> Val.t = function
| Const.Cint intlit -> (
try Val.of_int (IntLit.to_int intlit)
with _ -> Val.Itv.top )
try Val.of_int (IntLit.to_int intlit) with _ -> Val.Itv.top )
| Const.Cfloat f ->
f |> int_of_float |> Val.of_int
| _ ->

@ -69,11 +69,7 @@ module SymLinear = struct
let singleton : Symbol.t -> int -> t = M.singleton
let find : Symbol.t -> t -> int =
fun s x ->
try M.find s x
with Not_found -> 0
let find : Symbol.t -> t -> int = fun s x -> try M.find s x with Not_found -> 0
let is_le_zero : t -> bool =
fun x -> M.for_all (fun s v -> Int.equal v 0 || Symbol.is_unsigned s && v <= 0) x
@ -1182,10 +1178,7 @@ let ub : t -> Bound.t = function
let of_int : int -> astate = fun n -> NonBottom (ItvPure.of_int n)
let of_int_lit n =
try of_int (IntLit.to_int n)
with _ -> top
let of_int_lit n = try of_int (IntLit.to_int n) with _ -> top
let is_bot : t -> bool = fun x -> equal x Bottom

@ -33,8 +33,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let annotation = Localise.nullable_annotation_name pname in
let issue_kind = IssueType.nullable_dereference.unique_id in
let call_site =
try CallSites.min_elt call_sites
with Not_found ->
try CallSites.min_elt call_sites with Not_found ->
L.(die InternalError)
"Expecting a least one element in the set of call sites when analyzing %a"
Typ.Procname.pp pname
@ -110,8 +109,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let rec longest_nullable_prefix ap ((nulable_aps, _) as astate) =
try Some (ap, NullableAP.find ap nulable_aps)
with Not_found ->
try Some (ap, NullableAP.find ap nulable_aps) with Not_found ->
match ap with _, [] -> None | p -> longest_nullable_prefix (AccessPath.truncate p) astate

@ -113,8 +113,8 @@ let of_json filename json =
let of_json_file filename =
try of_json filename (Yojson.Basic.from_file filename)
with Sys_error msg | Yojson.Json_error msg ->
L.(die UserError)
"Could not read or parse the supplied JSON stacktrace file %s :@\n %s" filename msg
try of_json filename (Yojson.Basic.from_file filename) with
| Sys_error msg | Yojson.Json_error msg ->
L.(die UserError)
"Could not read or parse the supplied JSON stacktrace file %s :@\n %s" filename msg

@ -297,8 +297,7 @@ module Make (TraceDomain : AbstractDomain.WithBottom) (Config : Config) = struct
access_tree_add_trace_ ~seen_array_access accesses empty_starred_leaf depth'
else
let access_node =
try AccessMap.find access subtree
with Not_found -> empty_normal_leaf
try AccessMap.find access subtree with Not_found -> empty_normal_leaf
in
(* once we encounter a subtree rooted in an array access, we have to do weak updates in
the entire subtree. the reason: if I do x[i].f.g = <interesting trace>, then
@ -327,8 +326,7 @@ 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 Not_found ->
try BaseMap.find base tree with 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

@ -26,8 +26,8 @@ module Domain = struct
astate
| NonBottom _ ->
let sink_map =
try AnnotReachabilityDomain.find annot annot_map
with Not_found -> AnnotReachabilityDomain.SinkMap.empty
try AnnotReachabilityDomain.find annot annot_map with Not_found ->
AnnotReachabilityDomain.SinkMap.empty
in
let sink_map' =
if AnnotReachabilityDomain.SinkMap.mem sink sink_map then sink_map
@ -136,8 +136,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 {Specs.payload= {Specs.annot_map= Some annot_map}} -> (
try AnnotReachabilityDomain.find annot annot_map
with Not_found -> AnnotReachabilityDomain.SinkMap.empty )
try AnnotReachabilityDomain.find annot annot_map with Not_found ->
AnnotReachabilityDomain.SinkMap.empty )
| _ ->
AnnotReachabilityDomain.SinkMap.empty

@ -29,8 +29,7 @@ let create proc_desc =
let lookup map_ id =
let map = Lazy.force map_ in
try Some (Ident.IdentHash.find map id)
with Not_found -> None
try Some (Ident.IdentHash.find map id) with Not_found -> None
let expand_expr idenv e =

@ -37,10 +37,7 @@ module RepeatedCallsExtension : Eradicate.ExtensionT = struct
if not (InstrSet.is_empty calls) then ( F.fprintf fmt "Calls:@\n" ; InstrSet.iter pp_call calls )
let get_old_call instr calls =
try Some (InstrSet.find instr calls)
with Not_found -> None
let get_old_call instr calls = try Some (InstrSet.find instr calls) with Not_found -> None
let add_call instr calls = if InstrSet.mem instr calls then calls else InstrSet.add instr calls

@ -70,8 +70,7 @@ let is_name_keyword k = match k with Name -> true | _ -> false
(** true if and only if a substring of container matches the regular expression *)
let str_match_forward container regexp =
try Str.search_forward regexp container 0 >= 0
with Not_found -> false
try Str.search_forward regexp container 0 >= 0 with Not_found -> false
let compare_str_with_alexp s ae =

@ -94,8 +94,7 @@ 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 ->
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 ())

@ -67,10 +67,7 @@ let version_of number_s : human_readable_version option =
| [] ->
None
in
let number_opt =
try Some (float_of_string number_s)
with Failure _ -> None
in
let number_opt = try Some (float_of_string number_s) with Failure _ -> None in
match number_opt with
| None ->
None

@ -119,7 +119,6 @@ let make_expr_info qt vk objc_kind =
let make_expr_info_with_objc_kind qt objc_kind = make_expr_info qt `LValue objc_kind
let make_obj_c_message_expr_info_instance sel =
{ Clang_ast_t.omei_selector= sel
; omei_receiver_kind= `Instance
@ -212,10 +211,7 @@ let translate_dispatch_function stmt_info stmt_list n =
match stmt_list with
| _ :: args_stmts ->
let expr_info_call = make_general_expr_info create_void_star_type `XValue `Ordinary in
let arg_stmt =
try List.nth_exn args_stmts n
with Failure _ -> assert false
in
let arg_stmt = try List.nth_exn args_stmts n with Failure _ -> assert false in
CallExpr (stmt_info, [arg_stmt], expr_info_call)
| _ ->
assert false
@ -233,3 +229,4 @@ let trans_with_conditional stmt_info expr_info stmt_list =
let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal "0"] @ [create_integer_literal "1"] in
Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info)

@ -251,3 +251,4 @@ let sil_const_plus_one const =
Exp.Const (Const.Cint (IntLit.add n IntLit.one))
| _ ->
Exp.BinOp (Binop.PlusA, const, Exp.Const (Const.Cint IntLit.one))

@ -155,8 +155,7 @@ let add_block_static_var context block_name static_var_typ =
let static_vars_for_block context block_name =
try Typ.Procname.Map.find block_name context.blocks_static_vars
with Not_found -> []
try Typ.Procname.Map.find block_name context.blocks_static_vars with Not_found -> []
let rec get_outer_procname context =

@ -251,8 +251,7 @@ 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 -> p
try snd (List.find_exn sub ~f:(fun (a, _) -> ALVar.equal p a)) with Not_found -> p
in
let sub_list_param ps = List.map ps ~f:sub_param in
let open CTL in
@ -396,11 +395,10 @@ 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

@ -128,7 +128,7 @@ let mk_sil_global_var {CFrontend_config.source_file} ?(mk_name= fun _ x -> x) na
var_decl_info qt =
let name_string, simple_name = get_var_name_mangled named_decl_info var_decl_info in
let translation_unit =
match Clang_ast_t.((var_decl_info.vdi_is_extern, var_decl_info.vdi_init_expr)) with
match Clang_ast_t.(var_decl_info.vdi_is_extern, var_decl_info.vdi_init_expr) with
| true, None ->
Pvar.TUExtern
| _, None when var_decl_info.Clang_ast_t.vdi_is_static_data_member ->
@ -185,3 +185,4 @@ let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname o
CAst_utils.get_qualified_name named_decl_info |> QualifiedCppName.to_qual_string
in
Pvar.mk (Mangled.from_string name_string) procname

@ -654,8 +654,8 @@ let type_ptr_equal_type type_ptr type_str =
try Types_parser.abs_ctype token lexbuf with
| CTLExceptions.ALParserInvariantViolationException s ->
raise
(CTLExceptions.(
ALFileException (create_exc_info ("Syntax Error when defining type " ^ s) lexbuf)))
CTLExceptions.(
ALFileException (create_exc_info ("Syntax Error when defining type " ^ s) lexbuf))
| SyntaxError _ | Types_parser.Error ->
raise CTLExceptions.(ALFileException (create_exc_info "SYNTAX ERROR" lexbuf))
in

@ -431,22 +431,21 @@ 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
@ -814,12 +813,7 @@ let parameter_of_corresp_name method_name args name =
let parameter_of_corresp_pos args pos =
let pos_int =
match pos with
| ALVar.Const n -> (
try int_of_string n
with Failure _ -> -1 )
| _ ->
-1
match pos with ALVar.Const n -> ( try int_of_string n with Failure _ -> -1 ) | _ -> -1
in
List.nth args pos_int

@ -135,8 +135,7 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
expressions, but we take the type and create a static method call from it. This is done in
objcMessageExpr_trans. *)
let exec_with_self_exception f trans_state stmt =
try f trans_state stmt
with Self.SelfClassException class_name ->
try f trans_state stmt with Self.SelfClassException class_name ->
let typ = Typ.mk (Tstruct class_name) in
{ empty_res_trans with
exps=
@ -2608,9 +2607,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let context = trans_state.context in
let procname = Procdesc.get_proc_name context.CContext.procdesc in
let loc =
match stmt_info.Clang_ast_t.si_source_range with
| l1, _ ->
CLocation.clang_to_sil_location context.CContext.translation_unit_context l1
match stmt_info.Clang_ast_t.si_source_range with l1, _ ->
CLocation.clang_to_sil_location context.CContext.translation_unit_context l1
in
(* Given a captured var, return the instruction to assign it to a temp *)
let assign_captured_var (cvar, typ) =

@ -121,8 +121,7 @@ end
module GotoLabel = struct
let find_goto_label context label sil_loc =
try Hashtbl.find context.CContext.label_map label
with Not_found ->
try Hashtbl.find context.CContext.label_map label with Not_found ->
let node_name = Format.sprintf "GotoLabel_%s" label in
let new_node = Nodes.create_node (Procdesc.Node.Skip_node node_name) [] sil_loc context in
Hashtbl.add context.CContext.label_map label new_node ;

@ -169,8 +169,7 @@ and type_desc_of_c_type translate_decl tenv c_type : Typ.desc =
and decl_ptr_to_type_desc translate_decl tenv decl_ptr : Typ.desc =
let open Clang_ast_t in
let typ = Clang_ast_extend.DeclPtr decl_ptr in
try Clang_ast_extend.TypePointerMap.find typ !CFrontend_config.sil_types_map
with Not_found ->
try Clang_ast_extend.TypePointerMap.find typ !CFrontend_config.sil_types_map with Not_found ->
match CAst_utils.get_decl decl_ptr with
| Some (CXXRecordDecl _ as d)
| Some (RecordDecl _ as d)

@ -119,3 +119,4 @@ let captured_vars_from_block_info context cvl =
assert false
in
List.fold_right ~f:sil_var_of_captured_var cvl ~init:[]

@ -177,3 +177,4 @@ let interface_impl_declaration qual_type_to_sil_type tenv decl =
class_desc
| _ ->
assert false

@ -56,8 +56,7 @@ let add_formula_to_valuation k s =
let get_node_valuation k =
try NodesValuationHashtbl.find k !global_nodes_valuation
with Not_found -> CTLFormulaSet.empty
try NodesValuationHashtbl.find k !global_nodes_valuation with Not_found -> CTLFormulaSet.empty
let is_decl_allowed lcxt decl =
@ -305,8 +304,7 @@ let report_issue an lcxt linter (*npo_condition*) =
let check_linter_map linter_map_contex phi =
try ClosureHashtbl.find phi linter_map_contex
with Not_found ->
try ClosureHashtbl.find phi linter_map_contex with Not_found ->
Logging.die InternalError "@\n ERROR: linter_map must have an entry for each formula"
@ -330,8 +328,7 @@ let build_valuation 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 Not_found ->
try ClosureHashtbl.find normalized_condition !closure_map with Not_found ->
let cl' = formula_closure normalized_condition in
let is_state_only = is_state_only_formula normalized_condition in
(*print_closure cl' ; *)

@ -34,8 +34,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let open Domain in
match e with
| HilExp.AccessPath ap -> (
try AttributeMapDomain.find ap attribute_map
with Not_found -> AttributeSetDomain.empty )
try AttributeMapDomain.find ap attribute_map with Not_found -> AttributeSetDomain.empty )
| Constant _ ->
AttributeSetDomain.of_list [Attribute.Functional]
| Exception expr (* treat exceptions as transparent wrt attributes *) | Cast (_, expr) ->
@ -976,8 +975,8 @@ let analyze_procedure {Callbacks.proc_desc; get_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 Not_found -> AttributeSetDomain.empty
try AttributeMapDomain.find return_var_ap attribute_map with Not_found ->
AttributeSetDomain.empty
in
let post = {threads; locks; accesses; return_ownership; return_attributes} in
Summary.update_summary post summary
@ -1538,10 +1537,7 @@ module SyntacticQuotientedAccessListMap : QuotientedAccessListMap = struct
let empty = M.empty
let add k d m =
let ds =
try M.find k m
with Not_found -> []
in
let ds = try M.find k m with Not_found -> [] in
M.add k (d :: ds) m
@ -1556,10 +1552,7 @@ module MayAliasQuotientedAccessListMap : QuotientedAccessListMap = struct
let add = AccessListMap.add
let add k d m =
let ds =
try AccessListMap.find k m
with Not_found -> []
in
let ds = try AccessListMap.find k m with Not_found -> [] in
add k (d :: ds) m
@ -1704,10 +1697,7 @@ let aggregate_by_class file_env =
| _ ->
"unknown"
in
let bucket =
try String.Map.find_exn acc classname
with Not_found -> []
in
let bucket = try String.Map.find_exn acc classname with Not_found -> [] in
String.Map.add ~key:classname ~data:(proc :: bucket) acc)
~init:String.Map.empty
@ -1724,3 +1714,4 @@ let file_analysis {Callbacks.procedures} =
else (module MayAliasQuotientedAccessListMap) )
class_env))
(aggregate_by_class procedures)

@ -301,8 +301,7 @@ module OwnershipDomain = struct
include AbstractDomain.Map (AccessPath) (OwnershipAbstractValue)
let get_owned access_path astate =
try find access_path astate
with Not_found -> OwnershipAbstractValue.Unowned
try find access_path astate with Not_found -> OwnershipAbstractValue.Unowned
let is_owned access_path astate =
@ -320,8 +319,7 @@ module AttributeMapDomain = struct
let has_attribute access_path attribute t =
try find access_path t |> AttributeSetDomain.mem attribute
with Not_found -> false
try find access_path t |> AttributeSetDomain.mem attribute with Not_found -> false
let get_choices access_path t =
@ -335,8 +333,7 @@ module AttributeMapDomain = struct
let add_attribute access_path attribute t =
let attribute_set =
( try find access_path t
with Not_found -> AttributeSetDomain.empty )
(try find access_path t with Not_found -> AttributeSetDomain.empty)
|> AttributeSetDomain.add attribute
in
add access_path attribute_set t
@ -388,18 +385,12 @@ module AccessDomain = struct
include AbstractDomain.Map (AccessPrecondition) (PathDomain)
let add_access precondition access_path t =
let precondition_accesses =
try find precondition t
with Not_found -> PathDomain.empty
in
let precondition_accesses = try find precondition t with Not_found -> PathDomain.empty in
let precondition_accesses' = PathDomain.add_sink access_path precondition_accesses in
add precondition precondition_accesses' t
let get_accesses precondition t =
try find precondition t
with Not_found -> PathDomain.empty
let get_accesses precondition t = try find precondition t with Not_found -> PathDomain.empty
end
type astate =

@ -151,8 +151,7 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct
let find_duplicate_nodes = State.mk_find_duplicate_nodes curr_pdesc in
let find_canonical_duplicate node =
let duplicate_nodes = find_duplicate_nodes node in
try Procdesc.NodeSet.min_elt duplicate_nodes
with Not_found -> node
try Procdesc.NodeSet.min_elt duplicate_nodes with Not_found -> node
in
let typecheck_proc do_checks pname pdesc proc_details_opt =
let ann_sig, loc, idenv_pn =

@ -46,9 +46,7 @@ module Inference = struct
let update_count_str s_old =
let n =
if String.is_empty s_old then 0
else
try int_of_string s_old
with Failure _ -> L.die InternalError "int_of_string %s" s_old
else try int_of_string s_old with Failure _ -> L.die InternalError "int_of_string %s" s_old
in
string_of_int (n + 1)
@ -175,8 +173,7 @@ let is_check_not_null proc_name = table_has_procedure check_not_null_table proc_
(** Parameter number for a procedure known to be a checkNotNull *)
let get_check_not_null_parameter proc_name =
let proc_id = Typ.Procname.to_unique_id proc_name in
try Hashtbl.find check_not_null_parameter_table proc_id
with Not_found -> 0
try Hashtbl.find check_not_null_parameter_table proc_id with Not_found -> 0
(** Check if the procedure is one of the known Preconditions.checkState. *)

@ -22,10 +22,7 @@ type t = {map: bool AnnotationsMap.t; origin: TypeOrigin.t} [@@deriving compare]
let equal = [%compare.equal : t]
let get_value ann ta =
try AnnotationsMap.find ann ta.map
with Not_found -> false
let get_value ann ta = try AnnotationsMap.find ann ta.map with Not_found -> false
let set_value ann b ta =
if Bool.equal (get_value ann ta) b then ta else {ta with map= AnnotationsMap.add ann b ta.map}

@ -122,8 +122,7 @@ module ComplexExpressions = struct
in
match map_dexp (Errdesc.exp_rv_dexp tenv node' exp) with
| Some de -> (
try Some (dexp_to_string de)
with Not_handled -> None )
try Some (dexp_to_string de) with Not_handled -> None )
| None ->
None
@ -953,7 +952,7 @@ let typecheck_instr tenv ext calls_this checks (node: Procdesc.Node.t) idenv get
| _ ->
typestate2
in
( match[@warning "-57"] c with
match[@warning "-57"] c with
| Exp.BinOp (Binop.Eq, Exp.Const Const.Cint i, e)
| Exp.BinOp (Binop.Eq, e, Exp.Const Const.Cint i)
when IntLit.iszero i
@ -1032,7 +1031,7 @@ let typecheck_instr tenv ext calls_this checks (node: Procdesc.Node.t) idenv get
| Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.Ne, e1, e2), _) ->
check_condition node' (Exp.BinOp (Binop.Eq, e1, e2))
| _ ->
typestate )
typestate
(* FIXME: silenced warning may be legit *)
in
(* Handle assigment fron a temp pvar in a condition.

@ -104,8 +104,7 @@ let map_join m1 m2 =
in
let missing_rhs exp1 range1 =
(* handle elements missing in the rhs *)
try ignore (M.find exp1 m2)
with Not_found ->
try ignore (M.find exp1 m2) with Not_found ->
let t1, ta1, locs1 = range1 in
let range1' =
let ta1' = TypeAnnotation.with_origin ta1 TypeOrigin.Undef in
@ -127,14 +126,10 @@ let join ext t1 t2 =
tjoin
let lookup_id id typestate =
try Some (M.find (Exp.Var id) typestate.map)
with Not_found -> None
let lookup_id id typestate = try Some (M.find (Exp.Var id) typestate.map) with Not_found -> None
let lookup_pvar pvar typestate =
try Some (M.find (Exp.Lvar pvar) typestate.map)
with Not_found -> None
try Some (M.find (Exp.Lvar pvar) typestate.map) with Not_found -> None
let add_id id range typestate =

@ -117,8 +117,7 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs =
let lifecycle_procs =
List.fold
~f:(fun lifecycle_procs lifecycle_proc_str ->
try lookup_proc lifecycle_proc_str :: lifecycle_procs
with Not_found -> lifecycle_procs)
try lookup_proc lifecycle_proc_str :: lifecycle_procs with Not_found -> lifecycle_procs)
~init:[] lifecycle_proc_strs
in
lifecycle_procs

@ -86,8 +86,7 @@ let inhabit_alloc sizeof_typ sizeof_len ret_typ alloc_kind env =
(** find or create a Sil expression with type typ *)
let rec inhabit_typ tenv typ cfg env =
try (TypMap.find typ env.cache, env)
with Not_found ->
try (TypMap.find typ env.cache, env) with Not_found ->
let inhabit_internal typ env =
match typ.Typ.desc with
| Typ.Tptr ({desc= Tarray (inner_typ, Some _, _)}, Typ.Pk_pointer) ->

@ -188,8 +188,7 @@ 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

@ -579,3 +579,4 @@ let read_config_changed_files () =
| Error error ->
L.external_error "Error reading the changed files index '%s': %s@." index error ;
None

@ -133,8 +133,7 @@ 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)

@ -106,3 +106,4 @@ let uncons_exn = function [] -> failwith "uncons_exn" | hd :: tl -> (hd, tl)
let append_no_duplicates eq list1 list2 =
let list2_no_dup = List.filter (fun x2 -> List.for_all (fun x1 -> not (eq x2 x1)) list1) list2 in
list1 @ list2_no_dup

@ -11,8 +11,7 @@ include Core
module Unix_ = struct
let improve f make_arg_sexps =
try f ()
with Unix.Unix_error (e, s, _) ->
try f () with Unix.Unix_error (e, s, _) ->
let buf = Buffer.create 100 in
let fmt = Format.formatter_of_buffer buf in
Format.pp_set_margin fmt 10000 ;

@ -161,8 +161,7 @@ let load_from_verbose_output javac_verbose_out =
let line = In_channel.input_line_exn file_in in
if Str.string_match class_filename_re line 0 then
let path =
try Str.matched_group 5 line
with Not_found ->
try Str.matched_group 5 line with 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,12 +273,13 @@ let add_class cn jclass program =
let cleanup program = Javalib.close_class_path program.classpath
let lookup_node cn program =
try Some (JBasics.ClassMap.find cn (get_classmap program))
with Not_found ->
try Some (JBasics.ClassMap.find cn (get_classmap program)) with Not_found ->
try
let jclass = javalib_get_class (get_classpath program) cn in
add_class cn jclass program ; Some jclass
with JBasics.No_class_found _ | JBasics.Class_structure_error _ | Invalid_argument _ -> None
with
| JBasics.No_class_found _ | JBasics.Class_structure_error _ | Invalid_argument _ ->
None
let collect_classes start_classmap jar_filename =

@ -73,9 +73,8 @@ 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
@ -94,15 +93,13 @@ let get_goto_jumps context = context.goto_jumps
let add_if_jump context node pc = NodeTbl.add (get_if_jumps context) node pc
let get_if_jump context node =
try Some (NodeTbl.find (get_if_jumps context) node)
with Not_found -> None
try Some (NodeTbl.find (get_if_jumps context) node) with Not_found -> None
let add_goto_jump context pc jump = Hashtbl.add (get_goto_jumps context) pc jump
let get_goto_jump context pc =
try Hashtbl.find (get_goto_jumps context) pc
with Not_found -> Next
try Hashtbl.find (get_goto_jumps context) pc with Not_found -> Next
let is_goto_jump context pc =

@ -209,9 +209,7 @@ let compute_source_icfg linereader classes program tenv source_basename package_
{JContext.cg= Cg.create source_file; JContext.cfg= Cfg.create_cfg (); JContext.tenv}
in
let select test procedure cn node =
if test node then
try procedure cn node
with Bir.Subroutine -> ()
if test node then try procedure cn node with Bir.Subroutine -> ()
in
let () =
JBasics.ClassMap.iter

@ -57,10 +57,7 @@ let fix_method_definition_line linereader proc_name loc =
let get_location source_file impl pc =
let line_number =
let ln =
try JBir.get_source_line_number pc impl
with Invalid_argument _ -> None
in
let ln = try JBir.get_source_line_number pc impl with Invalid_argument _ -> None in
match ln with None -> 0 | Some n -> n
in
{Location.line= line_number; col= -1; file= source_file}
@ -268,14 +265,14 @@ let get_implementation cm =
let update_constr_loc cn ms loc_start =
if String.equal (JBasics.ms_name ms) JConfig.constructor_name then
try ignore (JBasics.ClassMap.find cn !constr_loc_map)
with Not_found -> constr_loc_map := JBasics.ClassMap.add cn loc_start !constr_loc_map
try ignore (JBasics.ClassMap.find cn !constr_loc_map) with Not_found ->
constr_loc_map := JBasics.ClassMap.add cn loc_start !constr_loc_map
let update_init_loc cn ms loc_start =
if JBasics.ms_equal ms JBasics.clinit_signature then
try ignore (JBasics.ClassMap.find cn !init_loc_map)
with Not_found -> init_loc_map := JBasics.ClassMap.add cn loc_start !init_loc_map
try ignore (JBasics.ClassMap.find cn !init_loc_map) with Not_found ->
init_loc_map := JBasics.ClassMap.add cn loc_start !init_loc_map
let trans_access = function
@ -666,9 +663,8 @@ let method_invocation (context: JContext.t) loc pc var_opt cn ms sil_obj_opt exp
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, _) =

@ -51,8 +51,7 @@ let translate_exceptions (context: JContext.t) exit_nodes get_body_nodes handler
[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 Not_found ->
try ignore (Hashtbl.find catch_block_table handler_list) with Not_found ->
let collect succ_nodes rethrow_exception handler =
let catch_nodes = get_body_nodes handler.JBir.e_handler in
let loc =

@ -127,3 +127,4 @@ let checker {Callbacks.summary; proc_desc; tenv} : Specs.summary =
L.(die InternalError)
"Analyzer failed to compute post for %a" Typ.Procname.pp
(Procdesc.get_proc_name proc_data.pdesc)

@ -54,10 +54,7 @@ module SourceKind = struct
List.find_map
~f:(fun (qualifiers, kind, index) ->
if QualifiedCppName.Match.match_qualifiers qualifiers qualified_pname then
let source_index =
try Some (int_of_string index)
with Failure _ -> return
in
let source_index = try Some (int_of_string index) with Failure _ -> return in
Some (of_string kind, source_index)
else None)
external_sources

@ -392,10 +392,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
inlines the field read because it's a static final constant *)
let convert_id_literal_to_read = function
| HilExp.Constant Const.Cint i as e ->
let int_value =
try IntLit.to_int i
with _ -> 0
in
let int_value = try IntLit.to_int i with _ -> 0 in
(* heuristic to decide if this looks like a resource ID *)
if Int.abs int_value > 1000 then
(* convert this resource ID literal into a dummy field read *)

@ -147,8 +147,7 @@ let get_fb_year cstart cend lines_arr =
let _ = Str.search_forward fmt_re line 0 in
let fmt_match = Str.matched_string line in
if String.length fmt_match = 4 then
try found := Some (int_of_string fmt_match)
with _ -> ()
try found := Some (int_of_string fmt_match) with _ -> ()
with Not_found -> ()
in
for i = cstart to cend do

@ -164,3 +164,4 @@ let tests =
~initial:(MockTaintAnalysis.Domain.empty, IdAccessPathMapDomain.empty)
in
"taint_test_suite" >::: test_list

Loading…
Cancel
Save