diff --git a/infer/src/Makefile.in b/infer/src/Makefile.in index 775bf7f8f..7800e0fd1 100644 --- a/infer/src/Makefile.in +++ b/infer/src/Makefile.in @@ -92,14 +92,16 @@ OCAMLBUILD_OPTIONS = \ -cflags -w,@20 \ -cflags -w,@26 \ -cflags -w,@29 \ - -cflags -w,+32 \ + -cflags -w,@27 \ + -cflags -w,@32 \ -cflags -w,@33 \ -cflags -w,@34 \ -cflags -w,@35 \ -cflags -w,@37 \ -cflags -w,@38 \ -cflags -w,@39 \ - -tag-line "<*{clang/clang_ast_*,backend/jsonbug_*}>: warn(-32-35-39)" \ + -cflags -w,-40..42 \ + -tag-line "<*{clang/clang_ast_*,backend/jsonbug_*}>: warn(-27-32-35-39)" \ -tag-line "not <**/{config,iList,utils}.*>: open(Utils)" \ -lflags $(OCAML_INCLUDES) \ -cflags $(OCAML_INCLUDES) \ diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index b06193dce..6b73a8de2 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -51,7 +51,7 @@ let create_fresh_primeds_ls para = let id_end = Ident.create_fresh Ident.kprimed in let ids_shared = let svars = para.Sil.svars in - let f id = Ident.create_fresh Ident.kprimed in + let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let ids_tuple = (id_base, id_next, id_end, ids_shared) in let exp_base = Sil.Var id_base in @@ -71,7 +71,7 @@ let create_condition_ls ids_private id_base p_leftover (inst: Sil.subst) = (insts_of_private_ids, insts_of_public_ids, inst_of_base) in let fav_insts_of_public_ids = IList.flatten (IList.map Sil.exp_fav_list insts_of_public_ids) in let fav_insts_of_private_ids = IList.flatten (IList.map Sil.exp_fav_list insts_of_private_ids) in - let (fav_p_leftover, fav_in_pvars) = + let (fav_p_leftover, _) = let sigma = Prop.get_sigma p_leftover in (sigma_fav_list sigma, sigma_fav_in_pvars_list sigma) in let fpv_inst_of_base = Sil.exp_fpv inst_of_base in @@ -108,7 +108,7 @@ let mk_rule_ptspts_ls impl_ok1 impl_ok2 (para: Sil.hpara) = let para_body_hpats = IList.map mark_impl_flag para_body in (ids, para_body_hpats) in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = id_next :: (ids_exist_fst @ ids_exist_snd) in create_condition_ls ids_private id_base in @@ -132,7 +132,7 @@ let mk_rule_ptsls_ls k2 impl_ok1 impl_ok2 para = (allow_impl hpred, IList.map allow_impl hpreds) in let lseg_pat = { Match.hpred = Prop.mk_lseg k2 para exp_next exp_end exps_shared; Match.flag = impl_ok2 } in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = id_next :: ids_exist in create_condition_ls ids_private id_base in @@ -154,7 +154,7 @@ let mk_rule_lspts_ls k1 impl_ok1 impl_ok2 para = let para_body_pat = IList.map allow_impl para_body in (ids, para_body_pat) in let lseg_res = Prop.mk_lseg Sil.Lseg_NE para exp_base exp_end exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = id_next :: ids_exist in create_condition_ls ids_private id_base in @@ -179,7 +179,7 @@ let mk_rule_lsls_ls k1 k2 impl_ok1 impl_ok2 para = { Match.hpred = Prop.mk_lseg k2 para exp_next exp_end exps_shared; Match.flag = impl_ok2 } in let k_res = lseg_kind_add k1 k2 in let lseg_res = Prop.mk_lseg k_res para exp_base exp_end exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] + let gen_pi_res _ _ (_: Sil.subst) = [] (* let inst_base, inst_next, inst_end = let find x = sub_find (equal x) inst in @@ -239,7 +239,7 @@ let mk_rule_ptspts_dll impl_ok1 impl_ok2 para = let id_oF = Ident.create_fresh Ident.kprimed in let ids_shared = let svars = para.Sil.svars_dll in - let f id = Ident.create_fresh Ident.kprimed in + let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in @@ -261,7 +261,7 @@ let mk_rule_ptspts_dll impl_ok1 impl_ok2 para = let para_body_hpats = IList.map mark_impl_flag para_body in (ids, para_body_hpats) in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = (* for the case of ptspts since iF'=iB therefore iF' cannot be private*) let ids_private = ids_exist_fst @ ids_exist_snd in @@ -287,7 +287,7 @@ let mk_rule_ptsdll_dll k2 impl_ok1 impl_ok2 para = let id_iB = Ident.create_fresh Ident.kprimed in let ids_shared = let svars = para.Sil.svars_dll in - let f id = Ident.create_fresh Ident.kprimed in + let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in @@ -304,7 +304,7 @@ let mk_rule_ptsdll_dll k2 impl_ok1 impl_ok2 para = (allow_impl hpred, IList.map allow_impl hpreds) in let dllseg_pat = { Match.hpred = Prop.mk_dllseg k2 para exp_iF' exp_iF exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iB exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = id_iF':: ids_exist in create_condition_dll ids_private id_iF in @@ -323,7 +323,7 @@ let mk_rule_dllpts_dll k1 impl_ok1 impl_ok2 para = let id_oF = Ident.create_fresh Ident.kprimed in let ids_shared = let svars = para.Sil.svars_dll in - let f id = Ident.create_fresh Ident.kprimed in + let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in @@ -337,7 +337,7 @@ let mk_rule_dllpts_dll k1 impl_ok1 impl_ok2 para = IList.map allow_impl para_inst in let dllseg_pat = { Match.hpred = Prop.mk_dllseg k1 para exp_iF exp_oB exp_iF' exp_oB' exps_shared; Match.flag = impl_ok1 } in let dllseg_res = Prop.mk_dllseg Sil.Lseg_NE para exp_iF exp_oB exp_oF exp_iF' exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = id_oB':: ids_exist in create_condition_dll ids_private id_iF in @@ -357,7 +357,7 @@ let mk_rule_dlldll_dll k1 k2 impl_ok1 impl_ok2 para = let id_iB = Ident.create_fresh Ident.kprimed in let ids_shared = let svars = para.Sil.svars_dll in - let f id = Ident.create_fresh Ident.kprimed in + let f _ = Ident.create_fresh Ident.kprimed in IList.map f svars in let exp_iF = Sil.Var id_iF in let exp_iF' = Sil.Var id_iF' in @@ -370,7 +370,7 @@ let mk_rule_dlldll_dll k1 k2 impl_ok1 impl_ok2 para = let lseg_snd_pat = { Match.hpred = Prop.mk_dllseg k2 para exp_iF' exp_oB' exp_oF exp_iB exps_shared; Match.flag = impl_ok2 } in let k_res = lseg_kind_add k1 k2 in let lseg_res = Prop.mk_dllseg k_res para exp_iF exp_oB exp_oF exp_iB exps_shared in - let gen_pi_res p_start p_leftover (inst: Sil.subst) = [] in + let gen_pi_res _ _ (_: Sil.subst) = [] in let condition = let ids_private = [id_iF'; id_oB'] in create_condition_dll ids_private id_iF in @@ -423,7 +423,7 @@ let typ_get_recursive_flds tenv typ_exp = | Sil.Tvar _ -> assert false (* there should be no indirection *) | Sil.Tint _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tptr _ | Sil.Tfloat _ | Sil.Tenum _ -> [] | Sil.Tstruct { Sil.instance_fields } -> - IList.map (fun (x, y, z) -> x) (IList.filter (filter typ) instance_fields) + IList.map (fun (x, _, _) -> x) (IList.filter (filter typ) instance_fields) | Sil.Tarray _ -> []) | Sil.Var _ -> [] (* type of |-> not known yet *) | Sil.Const _ -> [] @@ -474,7 +474,7 @@ let discover_para_candidates tenv p = let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in let process (_, nextse) = match nextse with - | Sil.Eexp (next, inst) -> add_edge (root, next) + | Sil.Eexp (next, _) -> add_edge (root, next) | _ -> assert false in IList.iter process fsel' in let rec get_edges_sigma = function @@ -510,7 +510,7 @@ let discover_para_dll_candidates tenv p = let fsel' = IList.filter (fun (fld, _) -> is_rec_fld fld) fsel in let convert_to_exp acc (_, se) = match se with - | Sil.Eexp (e, inst) -> e:: acc + | Sil.Eexp (e, _) -> e:: acc | _ -> assert false in let links = IList.rev (IList.fold_left convert_to_exp [] fsel') in let rec iter_pairs = function @@ -616,7 +616,7 @@ let sigma_special_cases_eqs sigma = [(IList.rev ids_acc, IList.rev eqs_acc, IList.rev sigma_acc)] | Sil.Hpointsto _ as hpred :: sigma_rest -> f ids_acc eqs_acc (hpred:: sigma_acc) sigma_rest - | Sil.Hlseg(k, para, e1, e2, es) as hpred :: sigma_rest -> + | Sil.Hlseg(_, para, e1, e2, es) as hpred :: sigma_rest -> let empty_case = f ids_acc ((e1, e2):: eqs_acc) sigma_acc sigma_rest in let pointsto_case = @@ -625,7 +625,7 @@ let sigma_special_cases_eqs sigma = let general_case = f ids_acc eqs_acc (hpred:: sigma_acc) sigma_rest in empty_case @ pointsto_case @ general_case - | Sil.Hdllseg(k, para, e1, e2, e3, e4, es) as hpred :: sigma_rest -> + | Sil.Hdllseg(_, para, e1, e2, e3, e4, es) as hpred :: sigma_rest -> let empty_case = f ids_acc ((e1, e3):: (e2, e4):: eqs_acc) sigma_acc sigma_rest in let pointsto_case = @@ -957,7 +957,7 @@ let abstract_pure_part p ~(from_abstract_footprint: bool) = IList.fold_left (fun pi a -> match a with - | Sil.Aneq (Sil.Var name, _) -> a:: pi + | Sil.Aneq (Sil.Var _, _) -> a:: pi (* we only use Lt and Le because Gt and Ge are inserted in terms of Lt and Le. *) | Sil.Aeq (Sil.Const (Sil.Cint i), Sil.BinOp (Sil.Lt, _, _)) | Sil.Aeq (Sil.BinOp (Sil.Lt, _, _), Sil.Const (Sil.Cint i)) @@ -1107,9 +1107,10 @@ let get_cycle root prop = (* Check whether the hidden counter field of a struct representing an *) (* objective-c object is positive, and whether the leak is part of the *) (* specified buckets. In the positive case, it returns the bucket *) -let should_raise_objc_leak prop hpred = +let should_raise_objc_leak hpred = match hpred with - | Sil.Hpointsto(e, Sil.Estruct((fn, Sil.Eexp( (Sil.Const (Sil.Cint i)), _)):: _, _), Sil.Sizeof (typ, _)) + | Sil.Hpointsto(_, Sil.Estruct((fn, Sil.Eexp( (Sil.Const (Sil.Cint i)), _)):: _, _), + Sil.Sizeof (typ, _)) when Ident.fieldname_is_hidden fn && Sil.Int.gt i Sil.Int.zero (* counter > 0 *) -> Mleak_buckets.should_raise_objc_leak typ | _ -> None @@ -1125,7 +1126,7 @@ let get_var_retain_cycle _prop = let sigma = Prop.get_sigma _prop in let is_pvar v h = match h with - | Sil.Hpointsto (Sil.Lvar pv, v', _) when Sil.strexp_equal v v' -> true + | Sil.Hpointsto (Sil.Lvar _, v', _) when Sil.strexp_equal v v' -> true | _ -> false in let is_hpred_block v h = match h, v with @@ -1176,7 +1177,7 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = match t with | Sil.Tstruct { Sil.instance_fields; static_fields } -> let ia = ref [] in - IList.iter (fun (fn', t', ia') -> + IList.iter (fun (fn', _, ia') -> if Ident.fieldname_equal fn fn' then ia := ia') (instance_fields @ static_fields); !ia @@ -1192,7 +1193,7 @@ let cycle_has_weak_or_unretained_or_assign_field cycle = let rec do_cycle c = match c with | [] -> false - | ((e, t), fn, _):: c' -> + | ((_, t), fn, _):: c' -> let ia = get_item_annotation t fn in if (IList.exists do_annotation ia) then true else do_cycle c' in @@ -1270,7 +1271,7 @@ let check_junk ?original_prop pname tenv prop = | None -> Sil.Rmemory Sil.Mmalloc in let ml_bucket_opt = match resource with - | Sil.Rmemory Sil.Mobjc -> should_raise_objc_leak prop hpred + | Sil.Rmemory Sil.Mobjc -> should_raise_objc_leak hpred | Sil.Rmemory Sil.Mnew when !Config.curr_language = Config.C_CPP -> Mleak_buckets.should_raise_cpp_leak () | _ -> None in diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index a360a65da..58e5bf93c 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -36,7 +36,7 @@ module StrexpMatch : sig val find_path : sigma -> path -> t (** Find a strexp with the given property. *) - val find : sigma -> (sigma -> strexp_data -> bool) -> t list + val find : sigma -> (strexp_data -> bool) -> t list (** Get the array *) val get_data : t -> strexp_data @@ -66,13 +66,13 @@ end = struct match se, t, syn_offs with | _, _, [] -> (se, t) | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields }, Field (fld, _) :: syn_offs' -> - let se' = snd (IList.find (fun (f', se') -> Sil.fld_equal f' fld) fsel) in - let t' = (fun (x,y,z) -> y) - (IList.find (fun (f', t', a') -> + let se' = snd (IList.find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in + let t' = (fun (_,y,_) -> y) + (IList.find (fun (f', _, _) -> Sil.fld_equal f' fld) instance_fields) in get_strexp_at_syn_offsets se' t' syn_offs' - | Sil.Earray (size, esel, _), Sil.Tarray(t', _), Index ind :: syn_offs' -> - let se' = snd (IList.find (fun (i', se') -> Sil.exp_equal i' ind) esel) in + | Sil.Earray (_, esel, _), Sil.Tarray(t', _), Index ind :: syn_offs' -> + let se' = snd (IList.find (fun (i', _) -> Sil.exp_equal i' ind) esel) in get_strexp_at_syn_offsets se' t' syn_offs' | _ -> L.d_strln "Failure of get_strexp_at_syn_offsets"; @@ -84,10 +84,10 @@ end = struct let rec replace_strexp_at_syn_offsets se t syn_offs update = match se, t, syn_offs with | _, _, [] -> - update se t + update se | Sil.Estruct (fsel, inst), Sil.Tstruct { Sil.instance_fields }, Field (fld, _) :: syn_offs' -> let se' = snd (IList.find (fun (f', _) -> Sil.fld_equal f' fld) fsel) in - let t' = (fun (x,y,z) -> y) + let t' = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> Sil.fld_equal f' fld) instance_fields) in let se_mod = replace_strexp_at_syn_offsets se' t' syn_offs' update in @@ -137,17 +137,17 @@ end = struct (sigma, hpred, syn_offs) (** Find a sub strexp with the given property. Can raise [Not_found] *) - let find (sigma : sigma) (pred : sigma -> strexp_data -> bool) : t list = + let find (sigma : sigma) (pred : strexp_data -> bool) : t list = let found = ref [] in let rec find_offset_sexp sigma_other hpred root offs se typ = let offs' = IList.rev offs in let path = (root, offs') in - if pred sigma_other (path, se, typ) then found := (sigma, hpred, offs') :: !found + if pred (path, se, typ) then found := (sigma, hpred, offs') :: !found else begin match se, typ with | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields } -> find_offset_fsel sigma_other hpred root offs fsel instance_fields typ - | Sil.Earray (size, esel, _), Sil.Tarray (t, _) -> + | Sil.Earray (_, esel, _), Sil.Tarray (t, _) -> find_offset_esel sigma_other hpred root offs esel t | _ -> () end @@ -156,7 +156,7 @@ end = struct | (f, se) :: fsel' -> begin try - let t = (fun (x,y,z) -> y) (IList.find (fun (f', t, a) -> Sil.fld_equal f' f) ftal) in + let t = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> Sil.fld_equal f' f) ftal) in find_offset_sexp sigma_other hpred root ((Field (f, typ)) :: offs) se t with Not_found -> L.d_strln ("Can't find field " ^ (Ident.fieldname_to_string f) ^ " in StrexpMatch.find") @@ -195,15 +195,15 @@ end = struct | _ -> assert false (** Replace the current hpred *) - let replace_hpred ((sigma, hpred, syn_offs) : t) hpred' = + let replace_hpred ((sigma, hpred, _) : t) hpred' = IList.map (fun hpred'' -> if hpred''== hpred then hpred' else hpred'') sigma (** Replace the strexp at the given offset in the given hpred *) let hpred_replace_strexp footprint_part hpred syn_offs update = - let update se' t' = - let se_in = update se' t' in + let update se' = + let se_in = update se' in match se', se_in with - | Sil.Earray (size, esel, inst1), Sil.Earray (_, esel_in, inst2) -> + | Sil.Earray (size, esel, _), Sil.Earray (_, esel_in, inst2) -> let orig_indices = IList.map fst esel in let index_is_not_new idx = IList.exists (Sil.exp_equal idx) orig_indices in let process_index idx = @@ -222,13 +222,13 @@ end = struct (** Replace the strexp at a given position by a new strexp *) let replace_strexp footprint_part ((sigma, hpred, syn_offs) : t) se_in = - let update se' t' = se_in in + let update _ = se_in in let hpred' = hpred_replace_strexp footprint_part hpred syn_offs update in replace_hpred (sigma, hpred, syn_offs) hpred' (** Replace the index in the array at a given position with the new index *) let replace_index footprint_part ((sigma, hpred, syn_offs) : t) (index: Sil.exp) (index': Sil.exp) = - let update se' t' = + let update se' = match se' with | Sil.Earray (size, esel, inst) -> let esel' = IList.map (fun (e', se') -> if Sil.exp_equal e' index then (index', se') else (e', se')) esel in @@ -297,12 +297,12 @@ let array_abstraction_performed = ref false let generic_strexp_abstract (abstraction_name : string) (p_in : Prop.normal Prop.t) - (_can_abstract : sigma -> StrexpMatch.strexp_data -> bool) + (can_abstract_ : StrexpMatch.strexp_data -> bool) (do_abstract : bool -> Prop.normal Prop.t -> StrexpMatch.strexp_data -> Prop.normal Prop.t * bool) : Prop.normal Prop.t = - let can_abstract s data = - let r = _can_abstract s data in + let can_abstract data = + let r = can_abstract_ data in if r then array_abstraction_performed := true; r in let find_strexp_to_abstract p0 = @@ -352,14 +352,13 @@ let index_is_pointed_to (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: fun i -> IList.map (add_index i) elist_path in let pointers = IList.flatten (IList.map add_index_to_paths indices) in let filter = function - | Sil.Hpointsto (_, Sil.Eexp (e, inst), _) -> IList.exists (Sil.exp_equal e) pointers + | Sil.Hpointsto (_, Sil.Eexp (e, _), _) -> IList.exists (Sil.exp_equal e) pointers | _ -> false in IList.exists filter (Prop.get_sigma p) (** Given [p] containing an array at [path], blur [index] in it *) let blur_array_index - (footprint_part: bool) (p: Prop.normal Prop.t) (path: StrexpMatch.path) (index: Sil.exp) : Prop.normal Prop.t @@ -392,18 +391,16 @@ let blur_array_index (** Given [p] containing an array at [root], blur [indices] in it *) let blur_array_indices - (footprint_part : bool) (p: Prop.normal Prop.t) (root: StrexpMatch.path) (indices: Sil.exp list) : Prop.normal Prop.t * bool = - let f prop index = blur_array_index footprint_part prop root index in + let f prop index = blur_array_index prop root index in (IList.fold_left f p indices, IList.length indices > 0) (** Given [p] containing an array at [root], only keep [indices] in it *) let keep_only_indices - (footprint_part : bool) (p: Prop.normal Prop.t) (path: StrexpMatch.path) (indices: Sil.exp list) : Prop.normal Prop.t * bool @@ -432,9 +429,9 @@ let array_typ_can_abstract = function | _ -> true (** This function checks whether we can apply an abstraction to a strexp *) -let strexp_can_abstract sigma_rest ((_, se, typ) : StrexpMatch.strexp_data) : bool = +let strexp_can_abstract ((_, se, typ) : StrexpMatch.strexp_data) : bool = let can_abstract_se = match se with - | Sil.Earray (size, esel, _) -> + | Sil.Earray (_, esel, _) -> let len = IList.length esel in len > 1 | _ -> false in @@ -442,7 +439,8 @@ let strexp_can_abstract sigma_rest ((_, se, typ) : StrexpMatch.strexp_data) : bo (** This function abstracts a strexp *) -let strexp_do_abstract footprint_part p ((path, se_in, typ_in) : StrexpMatch.strexp_data) : Prop.normal Prop.t * bool = +let strexp_do_abstract + footprint_part p ((path, se_in, _) : StrexpMatch.strexp_data) : Prop.normal Prop.t * bool = if !Config.trace_absarray && footprint_part then (L.d_str "strexp_do_abstract (footprint)"; L.d_ln ()); if !Config.trace_absarray && not footprint_part then (L.d_str "strexp_do_abstract (nonfootprint)"; L.d_ln ()); let prune_and_blur d_keys keep blur path keep_keys blur_keys = @@ -458,13 +456,11 @@ let strexp_do_abstract footprint_part p ((path, se_in, typ_in) : StrexpMatch.str if !Config.trace_absarray then (L.d_strln "Returns"; Prop.d_prop p3; L.d_ln (); L.d_ln ()); (p3, changed2 || changed3) in let prune_and_blur_indices = - prune_and_blur Sil.d_exp_list - (keep_only_indices footprint_part) - (blur_array_indices footprint_part) in + prune_and_blur Sil.d_exp_list keep_only_indices blur_array_indices in let partition_abstract should_keep abstract ksel default_keys = let keep_ksel, remove_ksel = IList.partition should_keep ksel in - let keep_keys, remove_keys, keys = + let keep_keys, _, _ = IList.map fst keep_ksel, IList.map fst remove_ksel, IList.map fst ksel in let keep_keys' = if keep_keys == [] then default_keys else keep_keys in abstract keep_keys' keep_keys' in diff --git a/infer/src/backend/autounit.ml b/infer/src/backend/autounit.ml index 4a45e9b3d..d811bdc7b 100644 --- a/infer/src/backend/autounit.ml +++ b/infer/src/backend/autounit.ml @@ -294,18 +294,18 @@ let create_idmap sigma : idmap = | Sil.BinOp (Sil.PlusPI, e1, e2), _ -> do_exp e1 typ; do_exp e2 (Sil.Tint Sil.IULong) - | Sil.Lfield (e1, f, t), _ -> + | Sil.Lfield (e1, _, _), _ -> do_exp e1 typ | Sil.Sizeof _, _ -> () | _ -> L.err "Unmatched exp: %a : %a@." (Sil.pp_exp pe) e (Sil.pp_typ_full pe) typ; assert false in let rec do_se se typ = match se, typ with - | Sil.Eexp (e, inst), _ -> + | Sil.Eexp (e, _), _ -> do_exp e typ | Sil.Estruct (fsel, _), Sil.Tstruct { Sil.instance_fields } -> do_struct fsel instance_fields - | Sil.Earray (size, esel, _), Sil.Tarray (typ, size') -> + | Sil.Earray (size, esel, _), Sil.Tarray (typ, _) -> do_se (Sil.Eexp (size, Sil.inst_none)) (Sil.Tint Sil.IULong); do_array esel typ | _ -> @@ -313,10 +313,10 @@ let create_idmap sigma : idmap = assert false and do_struct fsel ftal = match fsel, ftal with | [], _ -> () - | (f1, se) :: fsel', (f2, typ, a2) :: ftl' when Ident.fieldname_equal f1 f2 -> + | (f1, se) :: fsel', (f2, typ, _) :: ftl' when Ident.fieldname_equal f1 f2 -> do_se se typ; do_struct fsel' ftl' - | (f1, se) :: fsel', (f2, typ, a2) :: ftal' -> + | _ :: _, _ :: ftal' -> do_struct fsel ftal' | _:: _, [] -> assert false and do_array esel typ = match esel with @@ -333,7 +333,7 @@ let create_idmap sigma : idmap = | Sil.Hpointsto (e, se, Sil.Sizeof (typ, _)) -> do_lhs_e e (Sil.Tptr (typ, Sil.Pk_pointer)); do_se se typ - | Sil.Hlseg (k, hpar, e, f, el) -> + | Sil.Hlseg (_, _, e, f, el) -> do_lhs_e e (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); do_se (Sil.Eexp (f, Sil.inst_none)) (Sil.Tptr (Sil.Tvoid, Sil.Pk_pointer)); IList.iter (fun e -> do_se (Sil.Eexp (e, Sil.inst_none)) Sil.Tvoid) el @@ -377,7 +377,7 @@ type code = Code.t let pp_code = Code.pp (** pretty print an ident in C *) -let pp_id_c pe fmt id = +let pp_id_c fmt id = let name = Ident.get_name id in let stamp = Ident.get_stamp id in let varname = Ident.name_to_string name in @@ -385,16 +385,16 @@ let pp_id_c pe fmt id = (** pretty print an expression in C *) let rec pp_exp_c pe fmt = function - | Sil.Lfield (e, f, t) -> + | Sil.Lfield (e, f, _) -> F.fprintf fmt "&(%a->%a)" (pp_exp_c pe) e Ident.pp_fieldname f | Sil.Var id -> - pp_id_c pe fmt id + pp_id_c fmt id | e -> Sil.pp_exp pe fmt e (** pretty print a type in C *) let pp_typ_c pe typ = - let pp_nil fmt () = () in + let pp_nil _ () = () in Sil.pp_type_decl pe pp_nil pp_exp_c typ (** Convert a pvar to a string by just extracting the name *) @@ -431,17 +431,17 @@ let pp_texp_for_malloc fmt = | e -> pp_exp_c pe fmt e (* generate code for sigma *) -let gen_sigma code proc_name spec_num env idmap sigma = +let gen_sigma code proc_name spec_num env sigma = let post_code = Code.empty () in let rec do_strexp code' base need_deref = function - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) -> let lhs = if need_deref then "(*"^base^")" else base in let pp f () = F.fprintf f "%s = %a;" lhs (pp_exp_c pe) e in Code.add_from_pp code' pp | Sil.Estruct (fsel, _) -> let accessor = if need_deref then "->" else "." in IList.iter (fun (f, se) -> do_strexp code' (base ^ accessor ^ Ident.fieldname_to_string f) false se) fsel - | Sil.Earray (size, esel, _) -> + | Sil.Earray (_, esel, _) -> IList.iter (fun (e, se) -> let pp f () = F.fprintf f "%a" (pp_exp_c pe) e in let index = pp_to_string pp () in @@ -453,15 +453,15 @@ let gen_sigma code proc_name spec_num env idmap sigma = do_strexp post_code base false se | Sil.Hpointsto (Sil.Var id, se, te) -> let pp1 f () = - F.fprintf f "%a = malloc(%a);" (pp_id_c pe) id pp_texp_for_malloc te in + F.fprintf f "%a = malloc(%a);" pp_id_c id pp_texp_for_malloc te in let pp2 f () = - F.fprintf f "if(%a == NULL) exit(12);" (pp_id_c pe) id in + F.fprintf f "if(%a == NULL) exit(12);" pp_id_c id in Code.add_from_pp code pp1; Code.add_from_pp code pp2; - let pp3 f () = F.fprintf f "%a" (pp_id_c pe) id in + let pp3 f () = F.fprintf f "%a" pp_id_c id in let base = pp_to_string pp3 () in do_strexp post_code base true se - | Sil.Hlseg (k, hpar, Sil.Var id, f, el) -> + | Sil.Hlseg (_, hpar, Sil.Var id, f, el) -> let hpara_id = Sil.Predicates.get_hpara_id env hpar in let size_var = mk_size_name hpara_id in let mk_name = mk_lseg_name hpara_id proc_name spec_num in @@ -470,7 +470,7 @@ let gen_sigma code proc_name spec_num env idmap sigma = let pp1 fmt () = F.fprintf fmt "int %s = 42;" size_var in let pp2 fmt () = - F.fprintf fmt "%a = %s(%s, %a%a);" (pp_id_c pe) id mk_name size_var (pp_exp_c pe) f pp_el el in + F.fprintf fmt "%a = %s(%s, %a%a);" pp_id_c id mk_name size_var (pp_exp_c pe) f pp_el el in Code.add_from_pp code pp1; Code.add_from_pp code pp2 | hpred -> @@ -482,7 +482,7 @@ let gen_sigma code proc_name spec_num env idmap sigma = let gen_init_equalities code pure = let do_atom = function | Sil.Aeq (Sil.Var id, e) -> - let pp f () = F.fprintf f "%a = %a;" (pp_id_c pe) id (pp_exp_c pe) e in + let pp f () = F.fprintf f "%a = %a;" pp_id_c id (pp_exp_c pe) e in Code.add_from_pp code pp | _ -> () in IList.iter do_atom pure @@ -493,8 +493,8 @@ let gen_var_decl code idmap parameters = let pp_name f () = Mangled.pp f name in let pp f () = F.fprintf f "%a;" (Sil.pp_type_decl pe pp_name pp_exp_c) typ in Code.add_from_pp code pp in - let do_vinfo id { typ = typ; alloc = alloc } = - let pp_var f () = pp_id_c pe f id in + let do_vinfo id { typ } = + let pp_var f () = pp_id_c f id in let pp f () = F.fprintf f "%a;" (Sil.pp_type_decl pe pp_var pp_exp_c) typ in Code.add_from_pp code pp in IList.iter do_parameter parameters; @@ -520,7 +520,8 @@ let gen_init_vars code solutions idmap = L.err "do_vinfo type undefined: %a@." (Sil.pp_typ_full pe) typ; assert false in let pp fmt () = - F.fprintf fmt "%a = (%a) %a;" (pp_id_c pe) id (Sil.pp_typ_full pe) typ (Sil.pp_exp pe) (Sil.Const const) in + F.fprintf fmt "%a = (%a) %a;" + pp_id_c id (Sil.pp_typ_full pe) typ (Sil.pp_exp pe) (Sil.Const const) in Code.add_from_pp code pp in IdMap.iter do_vinfo idmap @@ -531,16 +532,18 @@ let filter_idmap filter idmap = !idmap' let pp_svars fmt svars = - if svars != [] then F.fprintf fmt "%a" (pp_comma_seq (pp_id_c pe)) svars + if svars != [] then F.fprintf fmt "%a" (pp_comma_seq pp_id_c) svars let gen_hpara code proc_name spec_num env id hpara = let mk_name = mk_lseg_name id proc_name spec_num in let size_name = mk_size_name id in let pp1 f () = - F.fprintf f "void* %s(int %s, void* %a%a) {" mk_name size_name (pp_id_c pe) hpara.Sil.next pp_svars hpara.Sil.svars in + F.fprintf f "void* %s(int %s, void* %a%a) {" + mk_name size_name pp_id_c hpara.Sil.next pp_svars hpara.Sil.svars in let pp2 f () = - F.fprintf f "%a= %s(%s -1 , %a%a);" (pp_id_c pe) hpara.Sil.next mk_name size_name (pp_id_c pe) hpara.Sil.next pp_svars hpara.Sil.svars in + F.fprintf f "%a= %s(%s -1 , %a%a);" + pp_id_c hpara.Sil.next mk_name size_name pp_id_c hpara.Sil.next pp_svars hpara.Sil.svars in let line1 = pp_to_string pp1 () in let idmap = create_idmap hpara.Sil.body in let idmap_ex = @@ -552,10 +555,10 @@ let gen_hpara code proc_name spec_num env id hpara = not (Ident.equal i hpara.Sil.next) in filter_idmap filter idmap in let line11 = "if ("^size_name^" == 0) {" in - let line12 = "return " ^ (pp_to_string (pp_id_c pe) hpara.Sil.next) ^ ";" in + let line12 = "return " ^ (pp_to_string pp_id_c hpara.Sil.next) ^ ";" in let line13 ="} else {" in let line14 = pp_to_string pp2 () in - let line2 = "return " ^ (pp_to_string (pp_id_c pe) hpara.Sil.root) ^ ";" in + let line2 = "return " ^ (pp_to_string pp_id_c hpara.Sil.root) ^ ";" in let line3 = "}" in Code.add_line code line1; Code.set_indent " "; @@ -568,7 +571,7 @@ let gen_hpara code proc_name spec_num env id hpara = Code.set_indent " "; Code.add_line code line14; gen_init_vars code IdMap.empty idmap_ex; - gen_sigma code proc_name spec_num env idmap hpara.Sil.body; + gen_sigma code proc_name spec_num env hpara.Sil.body; Code.add_line code line2; Code.set_indent " "; Code.add_line code line3; @@ -576,7 +579,7 @@ let gen_hpara code proc_name spec_num env id hpara = Code.add_line code line3; Code.add_line code "" -let gen_hpara_dll code proc_name spec_num env id hpara_dll = assert false +let gen_hpara_dll _ _ _ _ _ _ = assert false (** Generate epilog for the test case *) let gen_epilog code proc_name (parameters : (Mangled.t * Sil.typ) list) = @@ -603,7 +606,7 @@ let gen_prolog code fname proc_name spec_num = let solve_constraints pure idmap = let vars = ref [] in - let do_vinfo id { typ = typ; alloc = alloc } = + let do_vinfo id { alloc } = if not alloc then vars := !vars @ [id] in IdMap.iter do_vinfo idmap; Constraint.solve_from_pure pure !vars @@ -623,7 +626,7 @@ let genunit fname proc_name spec_num parameters spec = gen_var_decl code idmap parameters; gen_init_vars code (solve_constraints pure idmap) idmap; gen_init_equalities code pure; - gen_sigma code proc_name spec_num env idmap sigma; + gen_sigma code proc_name spec_num env sigma; gen_epilog code proc_name parameters; code diff --git a/infer/src/backend/buckets.ml b/infer/src/backend/buckets.ml index 69d6e16f5..4382b1d2b 100644 --- a/infer/src/backend/buckets.ml +++ b/infer/src/backend/buckets.ml @@ -30,11 +30,13 @@ let check_nested_loop path pos_opt = (* if !verbose then L.d_strln ((if b then "enter" else "exit") ^ " node " ^ (string_of_int (Cfg.Node.get_id node))); *) loop_visits_log := b :: !loop_visits_log | _ -> () in - let do_any_node level node = + let do_any_node _level _node = incr trace_length; - (* L.d_strln ("level " ^ string_of_int level ^ " (Cfg.Node.get_id node) " ^ string_of_int nid); *) - () in - let f level p session exn_opt = match Paths.Path.curr_node p with + (* L.d_strln *) + (* ("level " ^ string_of_int _level ^ *) + (* " (Cfg.Node.get_id node) " ^ string_of_int (Cfg.Node.get_id _node)) *) + in + let f level p _ _ = match Paths.Path.curr_node p with | Some node -> do_any_node level node; if level = 0 then do_node_caller node @@ -80,7 +82,7 @@ let check_access access_opt de_opt = let filter = function | Sil.Call (_, _, etl, _, _) -> let formal_ids = find_formal_ids node in - let arg_is_formal_param (e, t) = match e with + let arg_is_formal_param (e, _) = match e with | Sil.Var id -> IList.exists (Ident.equal id) formal_ids | _ -> false in if IList.exists arg_is_formal_param etl then formal_param_used_in_call := true; @@ -111,7 +113,7 @@ let check_access access_opt de_opt = find_bucket n ncf | Some (Localise.Returned_from_call n) -> find_bucket n false - | Some (Localise.Last_accessed (n, is_nullable)) when is_nullable -> + | Some (Localise.Last_accessed (_, is_nullable)) when is_nullable -> Some Localise.BucketLevel.b1 | _ -> begin diff --git a/infer/src/backend/callbacks.ml b/infer/src/backend/callbacks.ml index 50f56e3a4..27c73fac8 100644 --- a/infer/src/backend/callbacks.ml +++ b/infer/src/backend/callbacks.ml @@ -79,7 +79,7 @@ let iterate_procedure_callbacks exe_env proc_name = | None -> () in Option.may - (fun (idenv, tenv, proc_name, proc_desc, language) -> + (fun (idenv, tenv, proc_name, proc_desc, _) -> IList.iter (fun (language_opt, proc_callback) -> let language_matches = match language_opt with diff --git a/infer/src/backend/cfg.ml b/infer/src/backend/cfg.ml index 2b2f21b0e..9a2348192 100644 --- a/infer/src/backend/cfg.ml +++ b/infer/src/backend/cfg.ml @@ -381,14 +381,13 @@ module Node = struct pdesc_tbl_add cfg proc_attributes.ProcAttributes.proc_name pdesc; pdesc - let remove_node' filter_out_fun cfg node = + let remove_node' filter_out_fun cfg = let remove_node_in_cfg nodes = IList.filter filter_out_fun nodes in cfg.node_list := remove_node_in_cfg !(cfg.node_list) let remove_node_set cfg nodes = - remove_node' (fun node' -> not (NodeSet.mem node' nodes)) - cfg nodes + remove_node' (fun node' -> not (NodeSet.mem node' nodes)) cfg let proc_desc_remove cfg name remove_nodes = (if remove_nodes then @@ -500,7 +499,7 @@ module Node = struct | Stmt_node s -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "statements (%s) %a" s pp_loc () - | Prune_node (is_true_branch, if_kind, descr) -> + | Prune_node (_, _, descr) -> if sub_instrs then print_sub_instrs () else F.fprintf fmt "assume %s %a" descr pp_loc () | Exit_node _ -> @@ -526,11 +525,11 @@ module Node = struct match get_kind node with | Stmt_node _ -> "Instructions" - | Prune_node (is_true_branch, if_kind, descr) -> + | Prune_node (_, _, descr) -> "Conditional" ^ " " ^ descr | Exit_node _ -> "Exit" - | Skip_node s -> + | Skip_node _ -> "Skip" | Start_node _ -> "Start" @@ -568,7 +567,7 @@ module Node = struct do_node (proc_desc_get_start_node proc_desc) (** iterate between two nodes or until we reach a branching structure *) - let proc_desc_iter_slope_range f proc_desc src_node dst_node = + let proc_desc_iter_slope_range f src_node dst_node = let visited = ref NodeSet.empty in let rec do_node node = begin visited := NodeSet.add node !visited; @@ -672,7 +671,7 @@ let rec pp_node_list f = function (** Get all the procdescs (defined and declared) *) let get_all_procs cfg = let procs = ref [] in - let f pname pdesc = procs := pdesc :: !procs in + let f _ pdesc = procs := pdesc :: !procs in iter_proc_desc cfg f; !procs (** Get the procedures whose body is defined in this cfg *) @@ -724,7 +723,7 @@ let add_abstraction_instructions cfg = if node_requires_abstraction node then Node.append_instrs_temps node [Sil.Abstract loc] [] in IList.iter do_node all_nodes -let get_name_of_local (curr_f : Procdesc.t) (x, typ) = +let get_name_of_local (curr_f : Procdesc.t) (x, _) = Sil.mk_pvar x (Procdesc.get_proc_name curr_f) (* returns a list of local static variables (ie local variables defined static) in a proposition *) @@ -766,7 +765,7 @@ let remove_abducted_retvars p = IList.fold_left (fun exps (_, strexp) -> collect_exps exps strexp) exps flds | Sil.Earray (_, elems, _) -> - IList.fold_left (fun exps (index, strexp) -> collect_exps exps strexp) exps elems in + IList.fold_left (fun exps (_, strexp) -> collect_exps exps strexp) exps elems in let rec compute_reachable_hpreds_rec sigma (reach, exps) = let add_hpred_if_reachable (reach, exps) = function | Sil.Hpointsto (lhs, rhs, _) as hpred when Sil.ExpSet.mem lhs exps -> @@ -925,7 +924,7 @@ let load_cfg_from_file (filename : DB.filename) : cfg option = (** save a copy in the results dir of the source files of procedures defined in the cfg, unless an updated copy already exists *) let save_source_files cfg = - let process_proc pname pdesc = + let process_proc _ pdesc = let loc = Node.proc_desc_get_loc pdesc in let source_file = loc.Location.file in let source_file_str = DB.source_file_to_abs_path source_file in @@ -945,7 +944,7 @@ let save_source_files cfg = Node.iter_proc_desc cfg process_proc (** Save the .attr files for the procedures in the cfg. *) -let save_attributes filename cfg = +let save_attributes cfg = let save_proc proc_desc = let attributes = Procdesc.get_attributes proc_desc in let loc = attributes.ProcAttributes.loc in @@ -966,7 +965,7 @@ let save_attributes filename cfg = IList.iter save_proc (get_all_procs cfg) (** Inline a synthetic (access or bridge) method. *) -let inline_synthetic_method ret_ids etl proc_desc proc_name loc_call : Sil.instr option = +let inline_synthetic_method ret_ids etl proc_desc loc_call : Sil.instr option = let modified = ref None in let debug = false in let found instr instr' = @@ -976,32 +975,32 @@ let inline_synthetic_method ret_ids etl proc_desc proc_name loc_call : Sil.instr L.stderr "XX inline_synthetic_method found instr: %a@." (Sil.pp_instr pe_text) instr; L.stderr "XX inline_synthetic_method instr': %a@." (Sil.pp_instr pe_text) instr' end in - let do_instr node instr = + let do_instr _ instr = match instr, ret_ids, etl with - | Sil.Letderef (id1, Sil.Lfield (Sil.Var id2, fn, ft), bt, loc), + | Sil.Letderef (_, Sil.Lfield (Sil.Var _, fn, ft), bt, _), [ret_id], - [(e1, t1)] -> (* getter for fields *) + [(e1, _)] -> (* getter for fields *) let instr' = Sil.Letderef (ret_id, Sil.Lfield (e1, fn, ft), bt, loc_call) in found instr instr' - | Sil.Letderef (id1, Sil.Lfield (Sil.Lvar pvar, fn, ft), bt, loc), [ret_id], [] + | Sil.Letderef (_, Sil.Lfield (Sil.Lvar pvar, fn, ft), bt, _), [ret_id], [] when Sil.pvar_is_global pvar -> (* getter for static fields *) let instr' = Sil.Letderef (ret_id, Sil.Lfield (Sil.Lvar pvar, fn, ft), bt, loc_call) in found instr instr' - | Sil.Set (Sil.Lfield (ex1, fn, ft), bt , ex2, loc), + | Sil.Set (Sil.Lfield (_, fn, ft), bt , _, _), _, - [(e1, t1); (e2, t2)] -> (* setter for fields *) + [(e1, _); (e2, _)] -> (* setter for fields *) let instr' = Sil.Set (Sil.Lfield (e1, fn, ft), bt , e2, loc_call) in found instr instr' - | Sil.Set (Sil.Lfield (Sil.Lvar pvar, fn, ft), bt , ex2, loc), _, [(e1, t1)] + | Sil.Set (Sil.Lfield (Sil.Lvar pvar, fn, ft), bt , _, _), _, [(e1, _)] when Sil.pvar_is_global pvar -> (* setter for static fields *) let instr' = Sil.Set (Sil.Lfield (Sil.Lvar pvar, fn, ft), bt , e1, loc_call) in found instr instr' - | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', loc', cf), _, _ + | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', _, cf), _, _ when IList.length ret_ids = IList.length ret_ids' && IList.length etl' = IList.length etl -> let instr' = Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), etl, loc_call, cf) in found instr instr' - | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', loc', cf), _, _ + | Sil.Call (ret_ids', Sil.Const (Sil.Cfun pn), etl', _, cf), _, _ when IList.length ret_ids = IList.length ret_ids' && IList.length etl' + 1 = IList.length etl -> let etl1 = match IList.rev etl with (* remove last element *) @@ -1024,7 +1023,7 @@ let proc_inline_synthetic_methods cfg proc_desc : unit = let is_synthetic = attributes.ProcAttributes.is_synthetic_method in let is_bridge = attributes.ProcAttributes.is_bridge_method in if is_access || is_bridge || is_synthetic - then inline_synthetic_method ret_ids etl pd pn loc + then inline_synthetic_method ret_ids etl pd loc else None | None -> None) | _ -> None in @@ -1057,5 +1056,5 @@ let store_cfg_to_file (filename : DB.filename) (save_sources : bool) (cfg : cfg) | Some old_cfg -> Node.mark_unchanged_pdescs cfg old_cfg | None -> () end; - save_attributes filename cfg; + save_attributes cfg; Serialization.to_file cfg_serializer filename cfg diff --git a/infer/src/backend/cfg.mli b/infer/src/backend/cfg.mli index 5532732ff..4fecca154 100644 --- a/infer/src/backend/cfg.mli +++ b/infer/src/backend/cfg.mli @@ -106,7 +106,7 @@ module Procdesc : sig val iter_slope_calls : (Procname.t -> unit) -> t -> unit (** iterate between two nodes or until we reach a branching structure *) - val iter_slope_range : (node -> unit) -> t -> node -> node -> unit + val iter_slope_range : (node -> unit) -> node -> node -> unit val set_exit_node : t -> node -> unit diff --git a/infer/src/backend/cg.ml b/infer/src/backend/cg.ml index 50d21d74b..47f6658ed 100644 --- a/infer/src/backend/cg.ml +++ b/infer/src/backend/cg.ml @@ -180,7 +180,7 @@ let restrict_defined (g: t) (nodeset_opt: Procname.Set.t option) = let get_nodes (g: t) = let nodes = ref Procname.Set.empty in - let f node info = + let f node _ = nodes := Procname.Set.add node !nodes in node_map_iter f g; !nodes @@ -204,7 +204,7 @@ let get_all_nodes (g: t) = IList.map (fun node -> (node, get_calls g node)) nodes let get_nodes_and_calls (g: t) = - IList.filter (fun (n, calls) -> node_defined g n) (get_all_nodes g) + IList.filter (fun (n, _) -> node_defined g n) (get_all_nodes g) let node_get_num_ancestors g n = (n, Procname.Set.cardinal (get_ancestors g n)) @@ -277,11 +277,11 @@ type nodes_and_edges = let get_nodes_and_edges (g: t) : nodes_and_edges = let nodes = ref [] in let edges = ref [] in - let do_children node info nto = + let do_children node nto = edges := (node, nto) :: !edges in let f node info = nodes := (node, info.defined, info.disabled) :: !nodes; - Procname.Set.iter (do_children node info) info.children in + Procname.Set.iter (do_children node) info.children in node_map_iter f g; (!nodes, !edges) @@ -345,11 +345,11 @@ let store_to_file (filename : DB.filename) (call_graph : t) = let pp_graph_dotty get_specs (g: t) fmt = let nodes_with_calls = get_all_nodes g in let num_specs n = try IList.length (get_specs n) with exn when exn_not_failure exn -> - 1 in - let get_color (n, calls) = + let get_color (n, _) = if num_specs n != 0 then "green" else "red" in - let get_shape (n, calls) = + let get_shape (n, _) = if node_defined g n then "box" else "diamond" in - let pp_node fmt (n, calls) = + let pp_node fmt (n, _) = F.fprintf fmt "\"%s\"" (Procname.to_filename n) in let pp_node_label fmt (n, calls) = F.fprintf fmt "\"%a | calls=%d %d | specs=%d)\"" Procname.pp n calls.in_calls calls.out_calls (num_specs n) in diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index 82c2d54ff..88909decf 100644 --- a/infer/src/backend/dom.ml +++ b/infer/src/backend/dom.ml @@ -268,7 +268,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct match e with | Sil.Lvar _ -> false | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 - | Sil.Var id -> + | Sil.Var _ -> if !Config.join_cond = 0 then IList.exists (Sil.exp_equal Sil.exp_zero) es else if Dangling.check side e then @@ -307,17 +307,17 @@ end module CheckJoinPost : InfoLossCheckerSig = struct - let init sigma1 sigma2 = + let init _ _ = NonInj.init () let final () = NonInj.final () - let fail_case side e es = + let fail_case _ e es = match e with | Sil.Lvar _ -> false | Sil.Var id when Ident.is_normal id -> IList.length es >= 1 - | Sil.Var id -> false + | Sil.Var _ -> false | _ -> false let lost_little side e es = @@ -463,7 +463,7 @@ end = struct let init () = t := [] let final () = t := [] - let entry_compare (e1, e2, _) (e1', e2', _) = + let entry_compare (e1, e2, _) (_, e2', _) = let n1 = Sil.exp_compare e1 e2 in if n1 <> 0 then n1 else Sil.exp_compare e2 e2' @@ -628,7 +628,7 @@ end = struct begin let r = lookup_side' side e in match r with - | [(e1, e2, id) as t] -> if todo then Todo.push t; id + | [(_, _, id) as t] -> if todo then Todo.push t; id | _ -> L.d_strln "failure reason 9"; raise IList.Fail end | Sil.Var _ | Sil.Const _ | Sil.Lvar _ -> if todo then Todo.push (e, e, e); e @@ -647,17 +647,17 @@ end = struct (function (e1, e2, Sil.Var i) -> (i, select side e1 e2) | _ -> assert false) renaming_restricted in let sub_list_side_sorted = - IList.sort (fun (i, e) (i', e') -> Sil.exp_compare e e') sub_list_side in + IList.sort (fun (_, e) (_, e') -> Sil.exp_compare e e') sub_list_side in let rec find_duplicates = function - | (i, e):: ((i', e'):: l' as t) -> Sil.exp_equal e e' || find_duplicates t + | (_, e):: ((_, e'):: _ as t) -> Sil.exp_equal e e' || find_duplicates t | _ -> false in if find_duplicates sub_list_side_sorted then (L.d_strln "failure reason 11"; raise IList.Fail) else Sil.sub_of_list sub_list_side let to_subst_emb (side : side) = let renaming_restricted = - let pick_id_case (e1, e2, e) = + let pick_id_case (e1, e2, _) = match select side e1 e2 with | Sil.Var i -> can_rename i | _ -> false in @@ -672,7 +672,7 @@ end = struct let compare (i, _) (i', _) = Ident.compare i i' in IList.sort compare sub_list in let rec find_duplicates = function - | (i, _):: ((i', _):: l' as t) -> Ident.equal i i' || find_duplicates t + | (i, _):: ((i', _):: _ as t) -> Ident.equal i i' || find_duplicates t | _ -> false in if find_duplicates sub_list_sorted then (L.d_strln "failure reason 12"; raise IList.Fail) else Sil.sub_of_list sub_list_sorted @@ -905,8 +905,8 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Var id1, Sil.Var id2 -> ident_partial_join id1 id2 - | Sil.Var id, Sil.Const c - | Sil.Const c, Sil.Var id -> + | Sil.Var id, Sil.Const _ + | Sil.Const _, Sil.Var id -> if Ident.is_normal id then (L.d_strln "failure reason 20"; raise IList.Fail) else @@ -938,7 +938,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = else let e1'' = exp_partial_join e1 e2 in Sil.Cast (t1, e1'') - | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, topt2) -> + | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, _) -> if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 23"; raise IList.Fail) else Sil.UnOp (unop1, exp_partial_join e1 e2, topt1) (* should be topt1 = topt2 *) | Sil.BinOp(Sil.PlusPI, e1, e1'), Sil.BinOp(Sil.PlusPI, e2, e2') -> @@ -956,7 +956,7 @@ let rec exp_partial_join (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 25"; raise IList.Fail) else e1 - | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, t2) -> + | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 26"; raise IList.Fail) else Sil.Lfield(exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> @@ -1011,7 +1011,7 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = else let e1'' = exp_partial_meet e1 e2 in Sil.Cast (t1, e1'') - | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, topt2) -> + | Sil.UnOp(unop1, e1, topt1), Sil.UnOp(unop2, e2, _) -> if not (Sil.unop_equal unop1 unop2) then (L.d_strln "failure reason 31"; raise IList.Fail) else Sil.UnOp (unop1, exp_partial_meet e1 e2, topt1) (* should be topt1 = topt2 *) | Sil.BinOp(binop1, e1, e1'), Sil.BinOp(binop2, e2, e2') -> @@ -1031,7 +1031,7 @@ let rec exp_partial_meet (e1: Sil.exp) (e2: Sil.exp) : Sil.exp = | Sil.Lvar(pvar1), Sil.Lvar(pvar2) -> if not (Sil.pvar_equal pvar1 pvar2) then (L.d_strln "failure reason 35"; raise IList.Fail) else e1 - | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, t2) -> + | Sil.Lfield(e1, f1, t1), Sil.Lfield(e2, f2, _) -> if not (Sil.fld_equal f1 f2) then (L.d_strln "failure reason 36"; raise IList.Fail) else Sil.Lfield(exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) | Sil.Lindex(e1, e1'), Sil.Lindex(e2, e2') -> @@ -1052,7 +1052,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let rec f_fld_se_list inst mode acc fld_se_list1 fld_se_list2 = match fld_se_list1, fld_se_list2 with | [], [] -> Sil.Estruct (IList.rev acc, inst) - | [], other_fsel | other_fsel, [] -> + | [], _ | _, [] -> begin match mode with | JoinState.Pre -> (L.d_strln "failure reason 42"; raise IList.Fail) @@ -1082,7 +1082,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S let rec f_idx_se_list inst size idx_se_list_acc idx_se_list1 idx_se_list2 = match idx_se_list1, idx_se_list2 with | [], [] -> Sil.Earray (size, IList.rev idx_se_list_acc, inst) - | [], other_isel | other_isel, [] -> + | [], _ | _, [] -> begin match mode with | JoinState.Pre -> (L.d_strln "failure reason 44"; raise IList.Fail) @@ -1212,10 +1212,10 @@ let hpara_dll_partial_meet (hpara1: Sil.hpara_dll) (hpara2: Sil.hpara_dll) : Sil let hpred_partial_join mode (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) (hpred2: Sil.hpred) : Sil.hpred = let e1, e2, e = todo in match hpred1, hpred2 with - | Sil.Hpointsto (e1, se1, te1), Sil.Hpointsto (e2, se2, te2) -> + | Sil.Hpointsto (_, se1, te1), Sil.Hpointsto (_, se2, te2) -> let te = exp_partial_join te1 te2 in Prop.mk_ptsto e (strexp_partial_join mode se1 se2) te - | Sil.Hlseg (k1, hpara1, root1, next1, shared1), Sil.Hlseg (k2, hpara2, root2, next2, shared2) -> + | Sil.Hlseg (k1, hpara1, _, next1, shared1), Sil.Hlseg (k2, hpara2, _, next2, shared2) -> let hpara' = hpara_partial_join hpara1 hpara2 in let next' = exp_partial_join next1 next2 in let shared' = exp_list_partial_join shared1 shared2 in @@ -1239,11 +1239,11 @@ let hpred_partial_join mode (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpr let hpred_partial_meet (todo: Sil.exp * Sil.exp * Sil.exp) (hpred1: Sil.hpred) (hpred2: Sil.hpred) : Sil.hpred = let e1, e2, e = todo in match hpred1, hpred2 with - | Sil.Hpointsto (e1, se1, te1), Sil.Hpointsto (e2, se2, te2) when Sil.exp_equal te1 te2 -> + | Sil.Hpointsto (_, se1, te1), Sil.Hpointsto (_, se2, te2) when Sil.exp_equal te1 te2 -> Prop.mk_ptsto e (strexp_partial_meet se1 se2) te1 | Sil.Hpointsto _, _ | _, Sil.Hpointsto _ -> (L.d_strln "failure reason 58"; raise IList.Fail) - | Sil.Hlseg (k1, hpara1, root1, next1, shared1), Sil.Hlseg (k2, hpara2, root2, next2, shared2) -> + | Sil.Hlseg (k1, hpara1, _, next1, shared1), Sil.Hlseg (k2, hpara2, _, next2, shared2) -> let hpara' = hpara_partial_meet hpara1 hpara2 in let next' = exp_partial_meet next1 next2 in let shared' = exp_list_partial_meet shared1 shared2 in @@ -1322,7 +1322,7 @@ let rec sigma_partial_join' mode (sigma_acc: Prop.sigma) CheckJoin.add side root next; Sil.Hlseg (Sil.Lseg_PE, hpara, root', next', shared') - | Sil.Hdllseg (k, hpara, iF, oB, oF, iB, shared) + | Sil.Hdllseg (_, hpara, iF, oB, oF, iB, shared) when Sil.exp_equal iF e -> let oF' = do_side side exp_partial_join oF opposite in let shared' = Rename.lookup_list side shared in @@ -1335,7 +1335,7 @@ let rec sigma_partial_join' mode (sigma_acc: Prop.sigma) CheckJoin.add side oB iB; Sil.Hdllseg (Sil.Lseg_PE, hpara, root', oB', oF', iB', shared') - | Sil.Hdllseg (k, hpara, iF, oB, oF, iB, shared) + | Sil.Hdllseg (_, hpara, iF, oB, oF, iB, shared) when Sil.exp_equal iB e -> let oB' = do_side side exp_partial_join oB opposite in let shared' = Rename.lookup_list side shared in @@ -1587,7 +1587,7 @@ let pi_partial_join mode else widening_top in let a' = Prop.mk_inequality (Sil.BinOp(Sil.Le, e, Sil.exp_int bound)) in Some a' - | Some (e, n), [] -> + | Some (e, _), [] -> let bound = widening_top in let a' = Prop.mk_inequality (Sil.BinOp(Sil.Le, e, Sil.exp_int bound)) in Some a' @@ -1651,8 +1651,8 @@ let pi_partial_join mode | Sil.Aneq(e, e') | Sil.Aeq(e, e') when (exp_is_const e && exp_is_const e') -> true - | Sil.Aneq(Sil.Var id, e') | Sil.Aneq(e', Sil.Var id) - | Sil.Aeq(Sil.Var id, e') | Sil.Aeq(e', Sil.Var id) + | Sil.Aneq(Sil.Var _, e') | Sil.Aneq(e', Sil.Var _) + | Sil.Aeq(Sil.Var _, e') | Sil.Aeq(e', Sil.Var _) when (exp_is_const e') -> true | Sil.Aneq _ -> false @@ -1913,8 +1913,8 @@ let jplist_collapse mode jplist = let jprop_list_add_ids jplist = let seq_number = ref 0 in let rec do_jprop = function - | Specs.Jprop.Prop (n, p) -> incr seq_number; Specs.Jprop.Prop (!seq_number, p) - | Specs.Jprop.Joined (n, p, jp1, jp2) -> + | Specs.Jprop.Prop (_, p) -> incr seq_number; Specs.Jprop.Prop (!seq_number, p) + | Specs.Jprop.Joined (_, p, jp1, jp2) -> let jp1' = do_jprop jp1 in let jp2' = do_jprop jp2 in incr seq_number; diff --git a/infer/src/backend/dotty.ml b/infer/src/backend/dotty.ml index 77a8b0045..171e0a99b 100644 --- a/infer/src/backend/dotty.ml +++ b/infer/src/backend/dotty.ml @@ -125,12 +125,12 @@ let strip_special_chars s = let rec strexp_to_string pe coo f se = match se with - | Sil.Eexp (Sil.Lvar pvar, inst) -> F.fprintf f "%a" (Sil.pp_pvar pe) pvar - | Sil.Eexp (Sil.Var id, inst) -> + | Sil.Eexp (Sil.Lvar pvar, _) -> F.fprintf f "%a" (Sil.pp_pvar pe) pvar + | Sil.Eexp (Sil.Var id, _) -> if !print_full_prop then F.fprintf f "%a" (Ident.pp pe) id else () - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) -> if !print_full_prop then F.fprintf f "%a" (Sil.pp_exp pe) e else F.fprintf f "_" @@ -145,7 +145,7 @@ and struct_to_dotty_str pe coo f ls : unit = and get_contents_sexp pe coo f se = match se with - | Sil.Eexp (e', inst') -> + | Sil.Eexp (e', _) -> F.fprintf f "%a" (Sil.pp_exp pe) e' | Sil.Estruct (se', _) -> F.fprintf f "| { %a }" (struct_to_dotty_str pe coo) se' @@ -241,14 +241,14 @@ let make_dangling_boxes pe allocated_nodes (sigma_lambda: (Sil.hpred * int) list incr dotty_state_count; let coo = mk_coordinate n lambda in (match hpred with - | Sil.Hpointsto (_, Sil.Eexp (e, inst), _) + | Sil.Hpointsto (_, Sil.Eexp (e, _), _) when not (Sil.exp_equal e Sil.exp_zero) && !print_full_prop -> let e_color_str = color_to_str (exp_color hpred e) in [Dotdangling(coo, e, e_color_str)] - | Sil.Hlseg (k, hpara, _, e2, _) when not (Sil.exp_equal e2 Sil.exp_zero) -> + | Sil.Hlseg (_, _, _, e2, _) when not (Sil.exp_equal e2 Sil.exp_zero) -> let e2_color_str = color_to_str (exp_color hpred e2) in [Dotdangling(coo, e2, e2_color_str)] - | Sil.Hdllseg (k, hpara_dll, e1, e2, e3, e4, elist) -> + | Sil.Hdllseg (_, _, _, e2, e3, _, _) -> let e2_color_str = color_to_str (exp_color hpred e2) in let e3_color_str = color_to_str (exp_color hpred e3) in let ll = if not (Sil.exp_equal e2 Sil.exp_zero) then @@ -292,7 +292,7 @@ let rec dotty_mk_node pe sigma = let n = !dotty_state_count in incr dotty_state_count; let do_hpred_lambda exp_color = function - | (Sil.Hpointsto (e, Sil.Earray(e', l, _), Sil.Sizeof(Sil.Tarray(t, s), _)), lambda) -> + | (Sil.Hpointsto (e, Sil.Earray(e', l, _), Sil.Sizeof(Sil.Tarray(t, _), _)), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for the array *) let e_color_str = color_to_str (exp_color e) in let e_color_str'= color_to_str (exp_color e') in @@ -307,11 +307,11 @@ let rec dotty_mk_node pe sigma = let e_color_str = color_to_str (exp_color e) in if IList.mem Sil.exp_equal e !struct_exp_nodes then [] else [Dotpointsto((mk_coordinate n lambda), e, e_color_str)] - | (Sil.Hlseg (k, hpara, e1, e2, elist), lambda) -> + | (Sil.Hlseg (k, hpara, e1, e2, _), lambda) -> incr dotty_state_count; (* increment once more n+1 is the box for last element of the list *) let eq_color_str = color_to_str (exp_color e1) in [Dotlseg((mk_coordinate n lambda), e1, e2, k, hpara.Sil.body, eq_color_str)] - | (Sil.Hdllseg (k, hpara_dll, e1, e2, e3, e4, elist), lambda) -> + | (Sil.Hdllseg (k, hpara_dll, e1, e2, e3, e4, _), lambda) -> let e1_color_str = color_to_str (exp_color e1) in incr dotty_state_count; (* increment once more n+1 is the box for e4 *) [Dotdllseg((mk_coordinate n lambda), e1, e2, e3, e4, k, hpara_dll.Sil.body_dll, e1_color_str)] in @@ -349,7 +349,7 @@ let compute_fields_struct sigma = fields_structs:=[]; let rec do_strexp se in_struct = match se with - | Sil.Eexp (e, inst) -> if in_struct then fields_structs:= e ::!fields_structs else () + | Sil.Eexp (e, _) -> if in_struct then fields_structs:= e ::!fields_structs else () | Sil.Estruct (l, _) -> IList.iter (fun e -> do_strexp e true) (snd (IList.split l)) | Sil.Earray (_, l, _) -> IList.iter (fun e -> do_strexp e false) (snd (IList.split l)) in let rec fs s = @@ -384,7 +384,7 @@ let in_cycle cycle edge = let node_in_cycle cycle node = match cycle, node with - | Some cycle', Dotstruct(coo, e1, l, c,te) -> (* only struct nodes can be in cycle *) + | Some _, Dotstruct(_, _, l, _,_) -> (* only struct nodes can be in cycle *) IList.exists (in_cycle cycle) l | _ -> false @@ -393,7 +393,7 @@ let node_in_cycle cycle node = let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = let find_target_one_fld (fn, se) = match se with - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) -> if is_nil e p then begin let n'= make_nil_node lambda in if !print_full_prop then @@ -419,7 +419,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = [(LinkStructToExp, Ident.fieldname_to_string fn, n,"")] | _ -> (* by construction there must be at most 2 nodes for an expression*) L.out "@\n Too many nodes! Error! @\n@.@."; assert false) - | Sil.Estruct (l, _) -> [] (* inner struct are printed by print_struc function *) + | Sil.Estruct (_, _) -> [] (* inner struct are printed by print_struc function *) | Sil.Earray _ -> [] in (* inner arrays are printed by print_array function *) match list_fld with | [] -> [] @@ -431,7 +431,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = let rec compute_target_array_elements dotnodes list_elements p f lambda = let find_target_one_element (idx, se) = match se with - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) -> if is_nil e p then begin let n'= make_nil_node lambda in [(LinkArrayToExp, Sil.exp_to_string idx, n',"")] @@ -453,7 +453,7 @@ let rec compute_target_array_elements dotnodes list_elements p f lambda = | _ -> (* by construction there must be at most 2 nodes for an expression*) L.out "@\n Too many nodes! Error! @\n@.@."; assert false ) - | Sil.Estruct (l, _) -> [] (* inner struct are printed by print_struc function *) + | Sil.Estruct (_, _) -> [] (* inner struct are printed by print_struc function *) | Sil.Earray _ ->[] (* inner arrays are printed by print_array function *) in match list_elements with @@ -462,7 +462,7 @@ let rec compute_target_array_elements dotnodes list_elements p f lambda = let targets_a = find_target_one_element a in targets_a @ compute_target_array_elements dotnodes list_ele' p f lambda -let compute_target_from_eexp dotnodes e p f lambda = +let compute_target_from_eexp dotnodes e p lambda = if is_nil e p then let n'= make_nil_node lambda in [(LinkExpToExp, n', "")] @@ -498,7 +498,7 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = | [] -> [] | (Sil.Hpointsto (e, Sil.Earray(_, lie, _), _), lambda):: sigma' -> make_links_for_arrays e lie lambda sigma' - | (Sil.Hpointsto (e, Sil.Estruct (lfld, _), t), lambda):: sigma' -> + | (Sil.Hpointsto (e, Sil.Estruct (lfld, _), _), lambda):: sigma' -> let src = look_up dotnodes e lambda in (match src with | [] -> assert false @@ -522,12 +522,12 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = else [] in lnk_from_address_struct @ links_from_fields @ dotty_mk_set_links dotnodes sigma' p f cycle) - | (Sil.Hpointsto (e, Sil.Eexp (e', inst'), t), lambda):: sigma' -> + | (Sil.Hpointsto (e, Sil.Eexp (e', _), _), lambda):: sigma' -> let src = look_up dotnodes e lambda in (match src with | [] -> assert false | nl -> if !print_full_prop then - let target_list = compute_target_from_eexp dotnodes e' p f lambda in + let target_list = compute_target_from_eexp dotnodes e' p lambda in let ff n = IList.map (fun (k, m, lab_target) -> mk_link k (mk_coordinate n lambda) "" (mk_coordinate m lambda) (strip_special_chars lab_target) @@ -536,16 +536,16 @@ let rec dotty_mk_set_links dotnodes sigma p f cycle = ll @ dotty_mk_set_links dotnodes sigma' p f cycle else dotty_mk_set_links dotnodes sigma' p f cycle) - | (Sil.Hlseg (_, pred, e1, e2, elist), lambda):: sigma' -> + | (Sil.Hlseg (_, _, e1, e2, _), lambda):: sigma' -> let src = look_up dotnodes e1 lambda in (match src with | [] -> assert false | n:: _ -> - let (_, m, lab) = IList.hd (compute_target_from_eexp dotnodes e2 p f lambda) in + let (_, m, lab) = IList.hd (compute_target_from_eexp dotnodes e2 p lambda) in let lnk = mk_link LinkToSSL (mk_coordinate (n + 1) lambda) "" (mk_coordinate m lambda) lab in lnk:: dotty_mk_set_links dotnodes sigma' p f cycle ) - | (Sil.Hdllseg (_, pred, e1, e2, e3, e4, elist), lambda):: sigma' -> + | (Sil.Hdllseg (_, _, e1, e2, e3, _, _), lambda):: sigma' -> let src = look_up dotnodes e1 lambda in (match src with | [] -> assert false @@ -571,7 +571,7 @@ let print_kind f kind = current_pre:=!dotty_state_count; F.fprintf f "\n PRE%iL0 [label=\"PRE %i \", style=filled, color= yellow]\n" !dotty_state_count !spec_counter; print_stack_info:= true; - | Spec_postcondition pre -> + | Spec_postcondition _ -> F.fprintf f "\n POST%iL0 [label=\"POST %i \", style=filled, color= yellow]\n" !dotty_state_count !post_counter; print_stack_info:= true; | Generic_proposition -> @@ -693,7 +693,7 @@ let rec print_struct f pe e te l coo c = n lambda e_no_special_char n lambda print_type (struct_to_dotty_str pe coo) l c; F.fprintf f "}\n" -and print_array f pe e1 e2 l ty coo c = +and print_array f pe e1 e2 l coo c = let n = coo.id in let lambda = coo.lambda in let e_no_special_char = strip_special_chars (Sil.exp_to_string e1) in @@ -701,7 +701,7 @@ and print_array f pe e1 e2 l ty coo c = F.fprintf f " node [shape=record]; \n struct%iL%i [label=\"{<%s%iL%i> ARRAY| SIZE: %a } | %a\" ] fontcolor=%s\n" n lambda e_no_special_char n lambda (Sil.pp_exp pe) e2 (get_contents pe coo) l c; F.fprintf f "}\n" -and print_sll f pe nesting k e1 e2 coo = +and print_sll f pe nesting k e1 coo = let n = coo.id in let lambda = coo.lambda in let n' = !dotty_state_count in @@ -721,7 +721,7 @@ and print_sll f pe nesting k e1 e2 coo = incr lambda_counter; pp_dotty f (Lambda_pred(n + 1, lambda, false)) (Prop.normalize (Prop.from_sigma nesting)) None -and print_dll f pe nesting k e1 e2 e3 e4 coo = +and print_dll f pe nesting k e1 e4 coo = let n = coo.id in let lambda = coo.lambda in let n' = !dotty_state_count in @@ -760,15 +760,15 @@ and dotty_pp_state f pe cycle dotnode = let l' = if !print_full_prop then l else IList.filter (fun edge -> in_cycle cycle edge) l in print_struct f pe e1 te l' coo c - | Dotarray(coo, e1, e2, l, ty, c) when !print_full_prop -> print_array f pe e1 e2 l ty coo c - | Dotlseg(coo, e1, e2, Sil.Lseg_NE, nesting, c) when !print_full_prop -> - print_sll f pe nesting Sil.Lseg_NE e1 e2 coo - | Dotlseg(coo, e1, e2, Sil.Lseg_PE, nesting, c) when !print_full_prop -> - print_sll f pe nesting Sil.Lseg_PE e1 e2 coo - | Dotdllseg(coo, e1, e2, e3, e4, Sil.Lseg_NE, nesting, c) when !print_full_prop -> - print_dll f pe nesting Sil.Lseg_NE e1 e2 e3 e4 coo - | Dotdllseg(coo, e1, e2, e3, e4, Sil.Lseg_PE, nesting, c) when !print_full_prop -> - print_dll f pe nesting Sil.Lseg_PE e1 e2 e3 e4 coo + | Dotarray(coo, e1, e2, l, _, c) when !print_full_prop -> print_array f pe e1 e2 l coo c + | Dotlseg(coo, e1, _, Sil.Lseg_NE, nesting, _) when !print_full_prop -> + print_sll f pe nesting Sil.Lseg_NE e1 coo + | Dotlseg(coo, e1, _, Sil.Lseg_PE, nesting, _) when !print_full_prop -> + print_sll f pe nesting Sil.Lseg_PE e1 coo + | Dotdllseg(coo, e1, _, _, e4, Sil.Lseg_NE, nesting, _) when !print_full_prop -> + print_dll f pe nesting Sil.Lseg_NE e1 e4 coo + | Dotdllseg(coo, e1, _, _, e4, Sil.Lseg_PE, nesting, _) when !print_full_prop -> + print_dll f pe nesting Sil.Lseg_PE e1 e4 coo | _ -> () (* Build the graph data structure to be printed *) @@ -856,7 +856,7 @@ let pp_dotty_one_spec f pre posts = invisible_arrows:= true; pp_dotty f (Spec_precondition) pre None; invisible_arrows:= false; - IList.iter (fun (po, path) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po None; + IList.iter (fun (po, _) -> incr post_counter ; pp_dotty f (Spec_postcondition pre) po None; for j = 1 to 4 do F.fprintf f " inv_%i%i%i%i -> state_pi_%i [style=invis]\n" !spec_counter j j j !target_invisible_arrow_pre; done @@ -949,7 +949,8 @@ let pp_cfgnodelabel fmt (n : Cfg.Node.t) = Format.fprintf fmt "Exit %s" (Procname.to_string (Cfg.Procdesc.get_proc_name pdesc)) | Cfg.Node.Join_node -> Format.fprintf fmt "+" - | Cfg.Node.Prune_node (is_true_branch, ik, s) -> Format.fprintf fmt "Prune (%b branch)" is_true_branch + | Cfg.Node.Prune_node (is_true_branch, _, _) -> + Format.fprintf fmt "Prune (%b branch)" is_true_branch | Cfg.Node.Stmt_node s -> Format.fprintf fmt " %s" s | Cfg.Node.Skip_node s -> Format.fprintf fmt "Skip %s" s in let instr_string i = @@ -1116,10 +1117,10 @@ let rec make_visual_heap_nodes sigma = | [] -> [] | Sil.Hpointsto (e, se, t):: sigma' -> VH_pointsto(n, e, se, t):: make_visual_heap_nodes sigma' - | Sil.Hlseg (k, hpara, e1, e2, elist):: sigma' -> + | Sil.Hlseg (k, hpara, e1, e2, _):: sigma' -> working_list:= (n, hpara.Sil.body)::!working_list; VH_lseg(n, e1, e2, k):: make_visual_heap_nodes sigma' - | Sil.Hdllseg (k, hpara_dll, e1, e2, e3, e4, elist):: sigma'-> + | Sil.Hdllseg (k, hpara_dll, e1, e2, e3, e4, _):: sigma'-> working_list:= (n, hpara_dll.Sil.body_dll)::!working_list; VH_dllseg(n, e1, e2, e3, e4, k):: make_visual_heap_nodes sigma' @@ -1158,9 +1159,9 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = VH_dangling(n, e) in let get_rhs_predicate hpred = (match hpred with - | Sil.Hpointsto (_, Sil.Eexp (e, inst), _) when not (Sil.exp_equal e Sil.exp_zero) -> [e] + | Sil.Hpointsto (_, Sil.Eexp (e, _), _) when not (Sil.exp_equal e Sil.exp_zero) -> [e] | Sil.Hlseg (_, _, _, e2, _) when not (Sil.exp_equal e2 Sil.exp_zero) -> [e2] - | Sil.Hdllseg (_, _, e1, e2, e3, _, _) -> + | Sil.Hdllseg (_, _, _, e2, e3, _, _) -> if (Sil.exp_equal e2 Sil.exp_zero) then if (Sil.exp_equal e3 Sil.exp_zero) then [] else [e3] @@ -1191,8 +1192,10 @@ let make_set_dangling_nodes allocated_nodes (sigma: Sil.hpred list) = (* field_lab is the name of the field which points to n (if any)*) let rec compute_target_nodes_from_sexp nodes se prop field_lab = match se with - | Sil.Eexp (e, inst) when is_nil e prop -> [] (* Nil is not represented by a node, it's just a value which should be printed*) - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) when is_nil e prop -> + (* Nil is not represented by a node, it's just a value which should be printed*) + [] + | Sil.Eexp (e, _) -> let e_node = select_node_at_address nodes e in (match e_node with | None -> @@ -1225,7 +1228,7 @@ let rec make_visual_heap_edges nodes sigma prop = mk_visual_heap_edge (get_node_id n) (get_node_id m) lab in match sigma with | [] -> [] - | Sil.Hpointsto (e, se, t):: sigma' -> + | Sil.Hpointsto (e, se, _):: sigma' -> let e_node = select_node_at_address nodes e in (match e_node with | None -> assert false @@ -1234,7 +1237,7 @@ let rec make_visual_heap_edges nodes sigma prop = let ll = IList.map (combine_source_target_label n) target_nodes in ll @ make_visual_heap_edges nodes sigma' prop ) - | Sil.Hlseg (_, pred, e1, e2, elist):: sigma' -> + | Sil.Hlseg (_, _, e1, e2, _):: sigma' -> let e1_node = select_node_at_address nodes e1 in (match e1_node with | None -> assert false @@ -1244,7 +1247,7 @@ let rec make_visual_heap_edges nodes sigma prop = ll @ make_visual_heap_edges nodes sigma' prop ) - | Sil.Hdllseg (_, pred, e1, e2, e3, e4, elist):: sigma' -> + | Sil.Hdllseg (_, _, e1, e2, e3, _, _):: sigma' -> let e1_node = select_node_at_address nodes e1 in (match e1_node with | None -> assert false @@ -1274,7 +1277,7 @@ let prop_to_set_of_visual_heaps prop = let rec pointsto_contents_to_xml (co: Sil.strexp) : Io_infer.Xml.node = match co with - | Sil.Eexp (e, inst) -> + | Sil.Eexp (e, _) -> Io_infer.Xml.create_tree "cell" [("content-value", exp_to_xml_string e)] [] | Sil.Estruct (fel, _) -> let f (fld, exp) = Io_infer.Xml.create_tree "struct-field" [("id", Ident.fieldname_to_string fld)] [(pointsto_contents_to_xml exp)] in @@ -1317,17 +1320,17 @@ let heap_node_to_xml node = | VH_dangling(id, addr) -> let atts =[("id", string_of_int id); ("address", exp_to_xml_string addr); ("node-type","dangling"); ("memory-type", pointsto_addr_kind addr)] in Io_infer.Xml.create_tree "node" atts [] - | VH_pointsto(id, addr, cont, t) -> + | VH_pointsto(id, addr, cont, _) -> let atts =[("id", string_of_int id); ("address", exp_to_xml_string addr); ("node-type","allocated"); ("memory-type", pointsto_addr_kind addr)] in let contents = pointsto_contents_to_xml cont in Io_infer.Xml.create_tree "node" atts [contents] - | VH_lseg(id, addr, cont, Sil.Lseg_NE) -> + | VH_lseg(id, addr, _, Sil.Lseg_NE) -> let atts =[("id", string_of_int id); ("address", exp_to_xml_string addr); ("node-type","single linked list"); ("list-type","non-empty"); ("memory-type", "other")] in Io_infer.Xml.create_tree "node" atts [] - | VH_lseg(id, addr, cont, Sil.Lseg_PE) -> + | VH_lseg(id, addr, _, Sil.Lseg_PE) -> let atts =[("id", string_of_int id); ("address", exp_to_xml_string addr); ("node-type","single linked list"); ("list-type","possibly empty"); ("memory-type", "other")] in Io_infer.Xml.create_tree "node" atts [] - | VH_dllseg(id, addr1, cont1, cont2, addr2, k) -> + | VH_dllseg(id, addr1, cont1, cont2, addr2, _) -> let contents1 = pointsto_contents_to_xml (Sil.Eexp (cont1, Sil.inst_none)) in let contents2 = pointsto_contents_to_xml (Sil.Eexp (cont2, Sil.inst_none)) in let atts =[("id", string_of_int id); ("addr-first", exp_to_xml_string addr1); ("addr-last", exp_to_xml_string addr2); ("node-type","double linked list"); ("memory-type", "other") ] in @@ -1359,12 +1362,17 @@ let print_specs_xml signature specs loc fmt = reset_node_counter (); let do_one_spec pre posts n = let add_stack_to_prop _prop = - let pre_stack = fst (Prop.sigma_get_stack_nonstack true (Prop.get_sigma pre)) in (* add stack vars from pre *) + (* add stack vars from pre *) + let pre_stack = fst (Prop.sigma_get_stack_nonstack true (Prop.get_sigma pre)) in let _prop' = Prop.replace_sigma (pre_stack @ Prop.get_sigma _prop) _prop in Prop.normalize _prop' in let jj = ref 0 in let xml_pre = prop_to_xml pre "precondition" !jj in - let xml_spec = xml_pre:: (IList.map (fun (po, path) -> jj:=!jj + 1; prop_to_xml (add_stack_to_prop po) "postcondition" !jj) posts) in + let xml_spec = + xml_pre :: + (IList.map (fun (po, _) -> + jj := !jj + 1; prop_to_xml (add_stack_to_prop po) "postcondition" !jj + ) posts) in Io_infer.Xml.create_tree "specification" [("id", string_of_int n)] xml_spec in let j = ref 0 in let list_of_specs_xml = diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 88d2758fd..a1e29873d 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -46,7 +46,7 @@ let find_variable_assigment node id : Sil.instr option = let res = ref None in let node_instrs = Cfg.Node.get_instrs node in let find_set instr = match instr with - | Sil.Set (Sil.Lvar pv, _, e, _) when Sil.exp_equal (Sil.Var id) e -> + | Sil.Set (Sil.Lvar _, _, e, _) when Sil.exp_equal (Sil.Var id) e -> res := Some instr; true | _ -> false in @@ -275,7 +275,7 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : Sil.dexp option = end end else Some (Sil.Dpvar pvar) - | Sil.Lfield (Sil.Var id, f, typ) when Ident.is_normal id -> + | Sil.Lfield (Sil.Var id, f, _) when Ident.is_normal id -> if !verbose then begin L.d_str "exp_lv_dexp: Lfield with var "; @@ -286,7 +286,7 @@ and _exp_lv_dexp (_seen : Sil.ExpSet.t) node e : Sil.dexp option = (match _find_normal_variable_letderef seen node id with | None -> None | Some de -> Some (Sil.Darrow (de, f))) - | Sil.Lfield (e1, f, typ) -> + | Sil.Lfield (e1, f, _) -> if !verbose then begin L.d_str "exp_lv_dexp: Lfield "; @@ -334,7 +334,7 @@ and _exp_rv_dexp (_seen : Sil.ExpSet.t) node e : Sil.dexp option = | Sil.Var id when Ident.is_normal id -> if !verbose then (L.d_str "exp_rv_dexp: normal var "; Sil.d_exp e; L.d_ln ()); _find_normal_variable_letderef seen node id - | Sil.Lfield (e1, f, typ) -> + | Sil.Lfield (e1, f, _) -> if !verbose then begin L.d_str "exp_rv_dexp: Lfield "; @@ -412,9 +412,9 @@ let leak_from_list_abstraction hpred prop = let check_hpred texp hp = match hpred_type hp with | Some texp' when Sil.exp_equal texp texp' -> found := true | _ -> () in - let check_hpara texp n hpara = + let check_hpara texp _ hpara = IList.iter (check_hpred texp) hpara.Sil.body in - let check_hpara_dll texp n hpara = + let check_hpara_dll texp _ hpara = IList.iter (check_hpred texp) hpara.Sil.body_dll in match hpred_type hpred with | Some texp -> @@ -430,7 +430,7 @@ let find_hpred_typ hpred = match hpred with | _ -> None (** find the type of pvar and remove the pointer, if any *) -let find_pvar_typ_without_ptr tenv prop pvar = +let find_pvar_typ_without_ptr prop pvar = let res = ref None in let do_hpred = function | Sil.Hpointsto (e, _, te) when Sil.exp_equal e (Sil.Lvar pvar) -> @@ -470,8 +470,8 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = let check_pvar pvar = (* check that pvar is local or global and has the same type as the leaked hpred *) (Sil.pvar_is_local pvar || Sil.pvar_is_global pvar) && not (pvar_is_frontend_tmp pvar) && - match hpred_typ_opt, find_pvar_typ_without_ptr tenv prop pvar with - | Some (Sil.Sizeof (t1, st1)), Some (Sil.Sizeof (Sil.Tptr (_t2, _), st2)) -> + match hpred_typ_opt, find_pvar_typ_without_ptr prop pvar with + | Some (Sil.Sizeof (t1, _)), Some (Sil.Sizeof (Sil.Tptr (_t2, _), _)) -> (try let t2 = Sil.expand_type tenv _t2 in Sil.typ_equal t1 t2 @@ -483,7 +483,7 @@ let explain_leak tenv hpred prop alloc_att_opt bucket = | None -> if !verbose then (L.d_str "explain_leak: no current instruction"; L.d_ln ()); value_str_from_pvars_vpath [] vpath - | Some (Sil.Nullify (pvar, loc, _)) when check_pvar pvar -> + | Some (Sil.Nullify (pvar, _, _)) when check_pvar pvar -> if !verbose then (L.d_str "explain_leak: current instruction is Nullify for pvar "; Sil.d_pvar pvar; L.d_ln ()); (match exp_lv_dexp (State.get_node ()) (Sil.Lvar pvar) with | None -> None @@ -564,7 +564,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = let res = ref (None, None) in IList.iter (do_fse res sigma_acc' sigma_todo' lexp texp) fsel; !res - | sexp -> + | _ -> None, None in let do_hpred sigma_acc' sigma_todo' = let substituted_from_normal id = @@ -577,7 +577,7 @@ let vpath_find prop _exp : Sil.dexp option * Sil.typ option = do_sexp sigma_acc' sigma_todo' (Sil.Lvar pv) sexp texp | Sil.Hpointsto (Sil.Var id, sexp, texp) when Ident.is_normal id || (Ident.is_footprint id && substituted_from_normal id) -> do_sexp sigma_acc' sigma_todo' (Sil.Var id) sexp texp - | hpred -> + | _ -> (* if !verbose then (L.d_str "vpath_find do_hpred: no match "; Sil.d_hpred hpred; L.d_ln ()); *) None, None in match sigma_todo with @@ -664,13 +664,13 @@ let explain_dexp_access prop dexp is_nullable = | None -> None | Some (Sil.Eexp (e, _)) -> find_ptsto e | Some _ -> None) - | (Sil.Dbinop(Sil.PlusPI, Sil.Dpvar pvar, Sil.Dconst c) as de) -> + | (Sil.Dbinop(Sil.PlusPI, Sil.Dpvar _, Sil.Dconst _) as de) -> if !verbose then (L.d_strln ("lookup: case )pvar + constant) " ^ Sil.dexp_to_string de)); None | Sil.Dfcall (Sil.Dconst c, _, loc, _) -> if !verbose then (L.d_strln "lookup: found Dfcall "); (match c with - | Sil.Cfun pn -> (* Treat function as an update *) + | Sil.Cfun _ -> (* Treat function as an update *) Some (Sil.Eexp (Sil.Const c, Sil.Ireturn_from_call loc.Location.line)) | _ -> None) | de -> @@ -680,9 +680,9 @@ let explain_dexp_access prop dexp is_nullable = | None -> if !verbose then (L.d_strln ("explain_dexp_access: cannot find inst of " ^ Sil.dexp_to_string dexp)); None - | Some (Sil.Iupdate (_, ncf, n, pos)) -> + | Some (Sil.Iupdate (_, ncf, n, _)) -> Some (Localise.Last_assigned (n, ncf)) - | Some (Sil.Irearrange (_, _, n, pos)) -> + | Some (Sil.Irearrange (_, _, n, _)) -> Some (Localise.Last_accessed (n, is_nullable)) | Some (Sil.Ireturn_from_call n) -> Some (Localise.Returned_from_call n) @@ -696,11 +696,11 @@ let explain_dexp_access prop dexp is_nullable = let explain_dereference_access outermost_array is_nullable _de_opt prop = let de_opt = let rec remove_outermost_array_access = function (* remove outermost array access from [de] *) - | Sil.Dbinop(Sil.PlusPI, de1, de2) -> (* remove pointer arithmetic before array access *) + | Sil.Dbinop(Sil.PlusPI, de1, _) -> (* remove pointer arithmetic before array access *) remove_outermost_array_access de1 - | Sil.Darray(Sil.Dderef de1, de2) -> (* array access is a deref already: remove both *) + | Sil.Darray(Sil.Dderef de1, _) -> (* array access is a deref already: remove both *) de1 - | Sil.Darray(de1, de2) -> (* remove array access *) + | Sil.Darray(de1, _) -> (* remove array access *) de1 | Sil.Dderef de -> (* remove implicit array access *) de @@ -758,16 +758,16 @@ let _explain_access ?(is_premature_nil = false) deref_str prop loc = let rec find_outermost_dereference node e = match e with - | Sil.Const c -> + | Sil.Const _ -> if !verbose then (L.d_str "find_outermost_dereference: constant "; Sil.d_exp e; L.d_ln ()); exp_lv_dexp node e | Sil.Var id when Ident.is_normal id -> (* look up the normal variable declaration *) if !verbose then (L.d_str "find_outermost_dereference: normal var "; Sil.d_exp e; L.d_ln ()); find_normal_variable_letderef node id - | Sil.Lfield (e', f, t) -> + | Sil.Lfield (e', _, _) -> if !verbose then (L.d_str "find_outermost_dereference: Lfield "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' - | Sil.Lindex(e', e2) -> + | Sil.Lindex(e', _) -> if !verbose then (L.d_str "find_outermost_dereference: Lindex "; Sil.d_exp e; L.d_ln ()); find_outermost_dereference node e' | Sil.Lvar _ -> @@ -785,22 +785,23 @@ let _explain_access | _ -> if !verbose then (L.d_str "find_outermost_dereference: no match for "; Sil.d_exp e; L.d_ln ()); None in - let find_exp_dereferenced node = match State.get_instr () with + let find_exp_dereferenced () = match State.get_instr () with | Some Sil.Set (e, _, _, _) -> if !verbose then (L.d_str "explain_dereference Sil.Set "; Sil.d_exp e; L.d_ln ()); Some e | Some Sil.Letderef (_, e, _, _) -> if !verbose then (L.d_str "explain_dereference Sil.Leteref "; Sil.d_exp e; L.d_ln ()); Some e - | Some Sil.Call (_, Sil.Const (Sil.Cfun fn), [(e, typ)], loc, _) when Procname.to_string fn = "free" -> + | Some Sil.Call (_, Sil.Const (Sil.Cfun fn), [(e, _)], _, _) + when Procname.to_string fn = "free" -> if !verbose then (L.d_str "explain_dereference Sil.Call "; Sil.d_exp e; L.d_ln ()); Some e - | Some Sil.Call (_, (Sil.Var id as e), _, loc, _) -> + | Some Sil.Call (_, (Sil.Var _ as e), _, _, _) -> if !verbose then (L.d_str "explain_dereference Sil.Call "; Sil.d_exp e; L.d_ln ()); Some e | _ -> None in let node = State.get_node () in - match find_exp_dereferenced node with + match find_exp_dereferenced () with | None -> if !verbose then L.d_strln "_explain_access: find_exp_dereferenced returned None"; Localise.no_desc diff --git a/infer/src/backend/errlog.ml b/infer/src/backend/errlog.ml index 45412d042..057513a5c 100644 --- a/infer/src/backend/errlog.ml +++ b/infer/src/backend/errlog.ml @@ -27,8 +27,8 @@ type err_data = Prop.normal Prop.t option * Exceptions.err_class let err_data_compare - ((nodeid1, key1), session1, loc1, ml_loc_opt1, ltr1, po1, ec1) - ((nodeid2, key2), session2, loc2, ml_loc_opt2, ltr2, po2, ec2) = + (_, _, loc1, _, _, _, _) + (_, _, loc2, _, _, _, _) = Location.compare loc1 loc2 module ErrDataSet = (* set err_data with no repeated loc *) @@ -42,12 +42,12 @@ module ErrLogHash = Hashtbl.Make (struct type t = Exceptions.err_kind * bool * Localise.t * Localise.error_desc * string - let hash (ekind, in_footprint, err_name, desc, severity) = + let hash (ekind, in_footprint, err_name, desc, _) = Hashtbl.hash (ekind, in_footprint, err_name, Localise.error_desc_hash desc) let equal - (ekind1, in_footprint1, err_name1, desc1, severity1) - (ekind2, in_footprint2, err_name2, desc2, severity2) = + (ekind1, in_footprint1, err_name1, desc1, _) + (ekind2, in_footprint2, err_name2, desc2, _) = (ekind1, in_footprint1, err_name1) = (ekind2, in_footprint2, err_name2) && Localise.error_desc_equal desc1 desc2 @@ -78,7 +78,7 @@ type iter_fun = let iter (f: iter_fun) (err_log: t) = ErrLogHash.iter (fun (ekind, in_footprint, err_name, desc, severity) set -> ErrDataSet.iter - (fun (node_id_key, section, loc, ml_loc_opt, ltr, pre_opt, eclass) -> + (fun (node_id_key, _, loc, ml_loc_opt, ltr, pre_opt, eclass) -> f node_id_key loc ml_loc_opt ekind in_footprint err_name desc severity ltr pre_opt eclass) @@ -94,14 +94,14 @@ let size filter (err_log: t) = (** Print errors from error log *) let pp_errors fmt (errlog : t) = - let f (ekind, _, ename, _, _) locs = + let f (ekind, _, ename, _, _) _ = if ekind == Exceptions.Kerror then F.fprintf fmt "%a@ " Localise.pp ename in ErrLogHash.iter f errlog (** Print warnings from error log *) let pp_warnings fmt (errlog : t) = - let f (ekind, _, ename, desc, _) locs = + let f (ekind, _, ename, desc, _) _ = if ekind == Exceptions.Kwarning then F.fprintf fmt "%a %a@ " Localise.pp ename Localise.pp_error_desc desc in ErrLogHash.iter f errlog @@ -110,10 +110,10 @@ let pp_warnings fmt (errlog : t) = let pp_html path_to_root fmt (errlog: t) = let pp_eds fmt eds = let pp_nodeid_session_loc - fmt ((nodeid, nodekey), session, loc, ml_loc_opt, ltr, pre_opt, eclass) = + fmt ((nodeid, _), session, loc, _, _, _, _) = Io_infer.Html.pp_session_link path_to_root fmt (nodeid, session, loc.Location.line) in ErrDataSet.iter (pp_nodeid_session_loc fmt) eds in - let f do_fp ek (ekind, infp, err_name, desc, severity) eds = + let f do_fp ek (ekind, infp, err_name, desc, _) eds = if ekind == ek && do_fp == infp then F.fprintf fmt "
%a %a %a" @@ -231,7 +231,7 @@ module Err_table = struct let err_string = Localise.to_string err_name in let count = try StringMap.find err_string !err_name_map with Not_found -> 0 in err_name_map := StringMap.add err_string (count + n) !err_name_map in - let count (ekind', in_footprint, err_name, desc, severity) eds = + let count (ekind', in_footprint, err_name, _, _) eds = if ekind = ekind' && in_footprint then count_err err_name (ErrDataSet.cardinal eds) in ErrLogHash.iter count err_table; let pp err_string count = F.fprintf fmt " %s:%d" err_string count in @@ -249,7 +249,7 @@ module Err_table = struct let map_warn_fp = ref LocMap.empty in let map_warn_re = ref LocMap.empty in let map_info = ref LocMap.empty in - let add_err nslm (ekind , in_fp, err_name, desc, severity) = + let add_err nslm (ekind , in_fp, err_name, desc, _) = let map = match in_fp, ekind with | true, Exceptions.Kerror -> map_err_fp | false, Exceptions.Kerror -> map_err_re @@ -265,7 +265,7 @@ module Err_table = struct ErrDataSet.iter (fun loc -> add_err loc err_name) eds in ErrLogHash.iter f err_table; - let pp ekind (nodeidkey, session, loc, ml_loc_opt, ltr, pre_opt, eclass) fmt err_names = + let pp ekind (nodeidkey, _, loc, ml_loc_opt, _, _, _) fmt err_names = IList.iter (fun (err_name, desc) -> Exceptions.pp_err nodeidkey loc ekind err_name desc ml_loc_opt fmt ()) err_names in F.fprintf fmt "@.Detailed errors during footprint phase:@."; diff --git a/infer/src/backend/exceptions.ml b/infer/src/backend/exceptions.ml index 67c9251e0..9a5d7a935 100644 --- a/infer/src/backend/exceptions.ml +++ b/infer/src/backend/exceptions.ml @@ -147,7 +147,7 @@ let recognize_exception exn = desc, Some ml_loc, Exn_user, Medium, None, Nocat) | Dangling_pointer_dereference (dko, desc, ml_loc) -> let visibility = match dko with - | Some dk -> Exn_user (* only show to the user if the category was identified *) + | Some _ -> Exn_user (* only show to the user if the category was identified *) | None -> Exn_developer in (Localise.dangling_pointer_dereference, desc, Some ml_loc, visibility, High, None, Prover) @@ -192,7 +192,7 @@ let recognize_exception exn = | Invalid_argument s -> let desc = Localise.verbatim_desc s in (Localise.from_string "Invalid_argument", desc, None, Exn_system, Low, None, Nocat) - | Java_runtime_exception (exn_name, pre_str, desc) -> + | Java_runtime_exception (exn_name, _, desc) -> let exn_str = Typename.name exn_name in (Localise.from_string exn_str, desc, None, Exn_user, High, None, Prover) | Leak (fp_part, _, _, (exn_vis, error_desc), done_array_abstraction, resource, ml_loc) -> @@ -231,7 +231,7 @@ let recognize_exception exn = | Precondition_not_met (desc, ml_loc) -> (Localise.precondition_not_met, desc, Some ml_loc, Exn_user, Medium, Some Kwarning, Nocat) (** always a warning *) - | Retain_cycle (prop, hpred, desc, ml_loc) -> + | Retain_cycle (_, _, desc, ml_loc) -> (Localise.retain_cycle, desc, Some ml_loc, Exn_user, High, None, Prover) | Return_expression_required (desc, ml_loc) -> @@ -320,7 +320,7 @@ let err_class_string = function let print_key = false (** pretty print an error given its (id,key), location, kind, name, description, and optional ml location *) -let pp_err (node_id, node_key) loc ekind ex_name desc ml_loc_opt fmt () = +let pp_err (_, node_key) loc ekind ex_name desc ml_loc_opt fmt () = let kind = err_kind_string (if ekind = Kinfo then Kwarning else ekind) (* eclipse does not know about infos: treat as warning *) in let pp_key fmt k = if print_key then F.fprintf fmt " key: %d " k else () in F.fprintf fmt "%s:%d: %s: %a %a%a%a@\n" diff --git a/infer/src/backend/exe_env.ml b/infer/src/backend/exe_env.ml index 461ff3bc8..02fe6cdca 100644 --- a/infer/src/backend/exe_env.ml +++ b/infer/src/backend/exe_env.ml @@ -155,7 +155,7 @@ let file_data_to_tenv file_data = assert false | Some tenv -> tenv -let file_data_to_cfg exe_env file_data = +let file_data_to_cfg file_data = match file_data.cfg with | None -> let cfg = match Cfg.load_cfg_from_file file_data.cfg_file with @@ -175,7 +175,7 @@ let get_tenv exe_env pname = (** return the cfg associated to the procedure *) let get_cfg exe_env pname = let file_data = get_file_data exe_env pname in - file_data_to_cfg exe_env file_data + file_data_to_cfg file_data (** [iter_files f exe_env] applies [f] to the filename and tenv and cfg for each file in [exe_env] *) let iter_files f exe_env = @@ -189,7 +189,7 @@ let iter_files f exe_env = begin DB.current_source := fname; Config.nLOC := file_data.nLOC; - f fname (file_data_to_tenv file_data) (file_data_to_cfg exe_env file_data); + f fname (file_data_to_cfg file_data); DB.SourceFileSet.add fname seen_files_acc end in ignore (Procname.Hash.fold do_file exe_env.proc_map DB.SourceFileSet.empty) diff --git a/infer/src/backend/exe_env.mli b/infer/src/backend/exe_env.mli index 4d76b5330..2df426b42 100644 --- a/infer/src/backend/exe_env.mli +++ b/infer/src/backend/exe_env.mli @@ -44,7 +44,7 @@ val get_tenv : t -> Procname.t -> Sil.tenv val get_cfg : t -> Procname.t -> Cfg.cfg (** [iter_files f exe_env] applies [f] to the source file and tenv and cfg for each file in [exe_env] *) -val iter_files : (DB.source_file -> Sil.tenv -> Cfg.cfg -> unit) -> t -> unit +val iter_files : (DB.source_file -> Cfg.cfg -> unit) -> t -> unit (** check if a procedure is marked as active *) val proc_is_active : t -> Procname.t -> bool diff --git a/infer/src/backend/fork.ml b/infer/src/backend/fork.ml index 5cf77dfb6..4330cb8ac 100644 --- a/infer/src/backend/fork.ml +++ b/infer/src/backend/fork.ml @@ -22,7 +22,7 @@ module WeightedPnameSet = end) let pp_weightedpnameset fmt set = - let f (pname, weight) = F.fprintf fmt "%a@ " Procname.pp pname in + let f (pname, _) = F.fprintf fmt "%a@ " Procname.pp pname in WeightedPnameSet.iter f set let compute_weighed_pnameset gr = @@ -210,7 +210,7 @@ let post_process_procs exe_env procs_done = (** Find the max string in the [set] which satisfies [filter],and count the number of attempts. Precedence is given to strings in [priority_set] *) -let filter_max exe_env cg filter set priority_set = +let filter_max exe_env filter set priority_set = let rec find_max n filter set = let elem = WeightedPnameSet.max_elt set in if filter elem then @@ -322,7 +322,7 @@ end propagates results, and handles fixpoints in the call graph. *) let main_algorithm exe_env analyze_proc filter_out process_result : unit = let call_graph = Exe_env.get_cg exe_env in - let filter_initial (pname, w) = + let filter_initial (pname, _) = let summary = Specs.get_summary_unsafe "main_algorithm" pname in Specs.get_timestamp summary = 0 in wpnames_todo := WeightedPnameSet.filter filter_initial (compute_weighed_pnameset call_graph); @@ -333,7 +333,7 @@ let main_algorithm exe_env analyze_proc filter_out process_result : unit = tot_procs := WeightedPnameSet.cardinal !wpnames_todo; num_procs_done := 0; let max_timeout = ref 1 in - let wpname_can_be_analyzed (pname, weight) : bool = + let wpname_can_be_analyzed (pname, _) : bool = (* Return true if [pname] is not up to date and it can be analyzed right now *) Procname.Set.for_all (proc_is_done call_graph) (Cg.get_nonrecursive_dependents call_graph pname) && @@ -383,7 +383,7 @@ let main_algorithm exe_env analyze_proc filter_out process_result : unit = try let pname, calls = (** find max analyzable proc *) - filter_max exe_env call_graph wpname_can_be_analyzed !wpnames_todo wpnames_address_of in + filter_max exe_env wpname_can_be_analyzed !wpnames_todo wpnames_address_of in process_one_proc pname calls with Not_found -> (* no analyzable procs *) L.err "Error: can't analyze any procs. Printing current spec table@\n@[%a@]@." @@ -430,11 +430,11 @@ let interprocedural_algorithm (* wrap _process_result and handle exceptions *) try _process_result exe_env (pname, calls) summary with | exn -> - let err_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in + let err_name, _, _, _, _, _, _ = Exceptions.recognize_exception exn in let err_str = "process_result raised " ^ (Localise.to_string err_name) in L.err "Error: %s@." err_str; let exn' = Exceptions.Internal_error (Localise.verbatim_desc err_str) in Reporting.log_error pname exn'; post_process_procs exe_env [pname] in main_algorithm - exe_env (fun exe_env (n, w) -> analyze_proc exe_env n) filter_out process_result + exe_env (fun exe_env (n, _) -> analyze_proc exe_env n) filter_out process_result diff --git a/infer/src/backend/iList.ml b/infer/src/backend/iList.ml index 8198e7c43..fa60fa05e 100644 --- a/infer/src/backend/iList.ml +++ b/infer/src/backend/iList.ml @@ -67,7 +67,7 @@ let flatten_options list = let rec drop_first n = function | xs when n == 0 -> xs - | x:: xs -> drop_first (n - 1) xs + | _ :: xs -> drop_first (n - 1) xs | [] -> [] let drop_last n list = diff --git a/infer/src/backend/ident.ml b/infer/src/backend/ident.ml index bbd9f24f3..7a3f70ee0 100644 --- a/infer/src/backend/ident.ml +++ b/infer/src/backend/ident.ml @@ -135,7 +135,7 @@ let fieldname_to_simplified_string fn = match string_split_character s '.' with | Some s1, s2 -> (match string_split_character s1 '.' with - | Some s3, s4 -> s4 ^ "." ^ s2 + | Some _, s4 -> s4 ^ "." ^ s2 | _ -> s) | _ -> s @@ -143,7 +143,7 @@ let fieldname_to_simplified_string fn = let fieldname_to_flat_string fn = let s = Mangled.to_string fn.fname in match string_split_character s '.' with - | Some s1, s2 -> s2 + | Some _, s2 -> s2 | _ -> s (** Returns the class part of the fieldname *) diff --git a/infer/src/backend/inferanalyze.ml b/infer/src/backend/inferanalyze.ml index b312846b6..1fa8335d7 100644 --- a/infer/src/backend/inferanalyze.ml +++ b/infer/src/backend/inferanalyze.ml @@ -352,7 +352,7 @@ let print_usage_exit () = exit(1) let () = (* parse command-line arguments *) - let f arg = + let f _ = () (* ignore anonymous arguments *) in Arg.parse arg_desc f usage; if not (Sys.file_exists !Config.results_dir) then @@ -364,7 +364,7 @@ let () = (* parse command-line arguments *) module Simulator = struct (** Simulate the analysis only *) let reset_summaries cg = IList.iter - (fun (pname, in_out_calls) -> Specs.reset_summary cg pname None) + (fun (pname, _) -> Specs.reset_summary cg pname None) (Cg.get_nodes_and_calls cg) (** Perform phase transition from [FOOTPRINT] to [RE_EXECUTION] for @@ -386,14 +386,14 @@ module Simulator = struct (** Simulate the analysis only *) let procs_done = Fork.procs_become_done (Exe_env.get_cg exe_env) proc_name in Fork.post_process_procs exe_env procs_done - let analyze_proc exe_env tenv proc_name = + let analyze_proc _ proc_name = L.err "in analyze_proc %a@." Procname.pp proc_name; (* for i = 1 to Random.int 1000000 do () done; *) let prev_summary = Specs.get_summary_unsafe "Simulator" proc_name in let timestamp = max 1 (prev_summary.Specs.timestamp) in { prev_summary with Specs.timestamp = timestamp } - let filter_out cg proc_name = false + let filter_out _ _ = false end let analyze exe_env = @@ -412,7 +412,7 @@ let analyze exe_env = Simulator.reset_summaries (Exe_env.get_cg exe_env); Fork.interprocedural_algorithm exe_env - (Simulator.analyze_proc exe_env) + Simulator.analyze_proc Simulator.process_result Simulator.filter_out end @@ -643,7 +643,7 @@ let compute_clusters exe_env files_changed : Cluster.t list = let defined_procs = Cg.get_defined_nodes global_cg in let total_nodes = IList.length nodes in let computed_nodes = ref 0 in - let do_node (n, defined, restricted) = + let do_node (n, defined, _) = L.log_progress "Computing dependencies..." computed_nodes total_nodes; if defined then Cg.add_defined_node file_cg @@ -711,7 +711,7 @@ let compute_clusters exe_env files_changed : Cluster.t list = clusters' (** compute the set of procedures in [cg] changed since the last analysis *) -let cg_get_changed_procs exe_env source_dir cg = +let cg_get_changed_procs source_dir cg = let cfg_fname = DB.source_dir_get_internal_file source_dir ".cfg" in let cfg_opt = Cfg.load_cfg_from_file cfg_fname in let pdesc_changed pname = @@ -750,11 +750,11 @@ let compute_files_changed_map _exe_env (source_dirs : DB.source_dir list) exclud | Some cg -> (source_dir, cg) :: cg_list) [] sorted_dirs in - let exe_env_get_files_changed files_changed_map exe_env = + let exe_env_get_files_changed files_changed_map = let cg_get_files_changed files_changed_map (source_dir, cg) = let changed_procs = if !incremental_mode = ANALYZE_ALL then Cg.get_defined_nodes cg - else cg_get_changed_procs exe_env source_dir cg in + else cg_get_changed_procs source_dir cg in if changed_procs <> [] then let file_pname = ClusterMakefile.source_file_to_pname (Cg.get_source cg) in Procname.Map.add file_pname (proc_list_to_set changed_procs) files_changed_map @@ -763,7 +763,7 @@ let compute_files_changed_map _exe_env (source_dirs : DB.source_dir list) exclud let exe_env = Exe_env.freeze _exe_env in let files_changed = if !incremental_mode = ANALYZE_ALL then Procname.Map.empty - else exe_env_get_files_changed Procname.Map.empty exe_env in + else exe_env_get_files_changed Procname.Map.empty in files_changed, exe_env (** Create an exe_env from a cluster. *) @@ -824,7 +824,7 @@ let open_output_file f fname = let close_output_file = function | None -> () - | Some (fmt, cout) -> close_out cout + | Some (_, cout) -> close_out cout let setup_logging () = if !Config.developer_mode then diff --git a/infer/src/backend/inferconfig.ml b/infer/src/backend/inferconfig.ml index f39074d97..dbbfe5b27 100644 --- a/infer/src/backend/inferconfig.ml +++ b/infer/src/backend/inferconfig.ml @@ -31,9 +31,9 @@ type filters = proc_filter : proc_filter; } -let default_path_filter : path_filter = function path -> true -let default_error_filter : error_filter = function error_name -> true -let default_proc_filter : proc_filter = function proc_name -> true +let default_path_filter : path_filter = function _ -> true +let default_error_filter : error_filter = function _ -> true +let default_proc_filter : proc_filter = function _ -> true let do_not_filter : filters = { @@ -63,7 +63,7 @@ let is_matching patterns = module FileContainsStringMatcher = struct type matcher = DB.source_file -> bool - let default_matcher : matcher = fun fname -> false + let default_matcher : matcher = fun _ -> false let file_contains regexp file_in = let rec loop () = @@ -104,7 +104,7 @@ struct type matcher = DB.source_file -> Procname.t -> bool let default_matcher : matcher = - fun source_file proc_name -> false + fun _ _ -> false type method_pattern = { class_name : string; @@ -158,7 +158,7 @@ struct | `String s -> s:: accu | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in IList.rev (IList.fold_left collect [] l) in - let create_method_pattern mp assoc = + let create_method_pattern assoc = let loop mp = function | (key, `String s) when key = "class" -> { mp with class_name = s } @@ -169,17 +169,17 @@ struct | (key, _) when key = "language" -> mp | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in IList.fold_left loop default_method_pattern assoc - and create_string_contains sc assoc = + and create_string_contains assoc = let loop sc = function | (key, `String pattern) when key = "source_contains" -> pattern | (key, _) when key = "language" -> sc | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in IList.fold_left loop default_source_contains assoc in match detect_pattern assoc with - | Method_pattern (language, mp) -> - Method_pattern (language, create_method_pattern mp assoc) - | Source_contains (language, sc) -> - Source_contains (language, create_string_contains sc assoc) + | Method_pattern (language, _) -> + Method_pattern (language, create_method_pattern assoc) + | Source_contains (language, _) -> + Source_contains (language, create_string_contains assoc) let rec translate accu (json : Yojson.Basic.json) : pattern list = match json with @@ -201,7 +201,7 @@ struct StringMap.add pattern.class_name (pattern:: previous) map) StringMap.empty m_patterns in - fun source_file proc_name -> + fun _ proc_name -> let class_name = Procname.java_get_class proc_name and method_name = Procname.java_get_method proc_name in try @@ -217,12 +217,12 @@ struct let create_file_matcher patterns = let s_patterns, m_patterns = let collect (s_patterns, m_patterns) = function - | Source_contains (lang, s) -> (s:: s_patterns, m_patterns) - | Method_pattern (lang, mp) -> (s_patterns, mp :: m_patterns) in + | Source_contains (_, s) -> (s:: s_patterns, m_patterns) + | Method_pattern (_, mp) -> (s_patterns, mp :: m_patterns) in IList.fold_left collect ([], []) patterns in let s_matcher = let matcher = FileContainsStringMatcher.create_matcher s_patterns in - fun source_file proc_name -> matcher source_file + fun source_file _ -> matcher source_file and m_matcher = create_method_matcher m_patterns in fun source_file proc_name -> m_matcher source_file proc_name || s_matcher source_file proc_name diff --git a/infer/src/backend/inferprint.ml b/infer/src/backend/inferprint.ml index 90a2f0d22..e71af1d47 100644 --- a/infer/src/backend/inferprint.ml +++ b/infer/src/backend/inferprint.ml @@ -269,7 +269,7 @@ let begin_latex_file fmt = Latex.pp_begin fmt (author, title, table_of_contents) (** Write proc summary to latex file *) -let write_summary_latex fname fmt summary = +let write_summary_latex fmt summary = let proc_name = Specs.get_proc_name summary in Latex.pp_section fmt ("Analysis of function " ^ (Latex.convert_string (Procname.to_string proc_name))); F.fprintf fmt "@[%a@]" (Specs.pp_summary (pe_latex Black) !whole_seconds) summary @@ -364,7 +364,7 @@ let summary_values top_proc_set summary = let do_spec spec = visited := Specs.Visitedset.union spec.Specs.visited !visited in IList.iter do_spec specs; let visited_lines = ref IntSet.empty in - Specs.Visitedset.iter (fun (n, ls) -> + Specs.Visitedset.iter (fun (_, ls) -> IList.iter (fun l -> visited_lines := IntSet.add l !visited_lines) ls) !visited; Specs.Visitedset.cardinal !visited, IntSet.elements !visited_lines in @@ -437,7 +437,7 @@ module ProcsCsv = struct Io_infer.Xml.tag_proof_trace (** Write proc summary stats in csv format *) - let pp_summary fname top_proc_set fmt summary = + let pp_summary top_proc_set fmt summary = let pp x = F.fprintf fmt x in let sv = summary_values top_proc_set summary in pp "\"%s\"," (Escape.escape_csv sv.vname); @@ -530,10 +530,10 @@ module BugsCsv = struct "advice" (** Write bug report in csv format *) - let pp_bugs error_filter fname fmt summary = + let pp_bugs error_filter fmt summary = let pp x = F.fprintf fmt x in let err_log = summary.Specs.attributes.ProcAttributes.err_log in - let pp_row (node_id, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr pre_opt eclass = + let pp_row (_, node_key) loc _ ekind in_footprint error_name error_desc severity ltr _ eclass = if in_footprint && error_filter error_desc error_name then let err_desc_string = error_desc_to_csv_string error_desc in let err_advice_string = error_advice_to_csv_string error_desc in @@ -579,10 +579,12 @@ module BugsJson = struct let pp_json_close fmt () = F.fprintf fmt "]\n@?" (** Write bug report in JSON format *) - let pp_bugs error_filter fname fmt summary = + let pp_bugs error_filter fmt summary = let pp x = F.fprintf fmt x in let err_log = summary.Specs.attributes.ProcAttributes.err_log in - let pp_row (node_id, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr pre_opt eclass = + let pp_row + (_, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr _ eclass + = if in_footprint && error_filter error_desc error_name then let kind = Exceptions.err_kind_string ekind in let bug_type = Localise.to_string error_name in @@ -617,9 +619,9 @@ end module BugsTxt = struct (** Write bug report in text format *) - let pp_bugs error_filter fname fmt summary = + let pp_bugs error_filter fmt summary = let err_log = summary.Specs.attributes.ProcAttributes.err_log in - let pp_row (node_id, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr pre_opt eclass = + let pp_row (node_id, node_key) loc _ ekind in_footprint error_name error_desc _ _ _ _ = if in_footprint && error_filter error_desc error_name then Exceptions.pp_err (node_id, node_key) loc ekind error_name error_desc None fmt () in Errlog.iter pp_row err_log @@ -659,7 +661,8 @@ module BugsXml = struct (** print bugs from summary in xml *) let pp_bugs error_filter linereader fmt summary = let err_log = summary.Specs.attributes.ProcAttributes.err_log in - let do_row (node_id, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr pre_opt eclass = + let do_row + (_, node_key) loc _ ekind in_footprint error_name error_desc severity ltr pre_opt eclass = if in_footprint && error_filter error_desc error_name then let err_desc_string = error_desc_to_xml_string error_desc in let precondition_tree () = match pre_opt with @@ -726,7 +729,7 @@ module CallsCsv = struct Io_infer.Xml.tag_call_trace (** Write proc summary stats in csv format *) - let pp_calls fname fmt summary = + let pp_calls fmt summary = let pp x = F.fprintf fmt x in let stats = summary.Specs.stats in let caller_name = Specs.get_proc_name summary in @@ -746,7 +749,7 @@ module UnitTest = struct let procs_done = ref [] (** Print unit test for every spec in the summary *) - let print_unit_test fname proc_name summary = + let print_unit_test proc_name summary = let cnt = ref 0 in let fmt = F.std_formatter in let do_spec spec = @@ -861,7 +864,7 @@ module Stats = struct let process_err_log error_filter linereader err_log stats = let found_errors = ref false in - let process_row (node_id, node_key) loc ml_loc_opt ekind in_footprint error_name error_desc severity ltr pre_opt eclass = + let process_row _ loc _ ekind in_footprint error_name error_desc _ ltr _ _ = let type_str = Localise.to_string error_name in if in_footprint && error_filter error_desc error_name then match ekind with @@ -974,18 +977,18 @@ let process_summary filters linereader stats (top_proc_set: Procname.Set.t) (fna (filters.Inferconfig.path_filter summary.Specs.attributes.ProcAttributes.loc.Location.file || always_report ()) && filters.Inferconfig.error_filter error_name && filters.Inferconfig.proc_filter proc_name in - do_outf procs_csv (fun outf -> F.fprintf outf.fmt "%a" (ProcsCsv.pp_summary fname top_proc_set) summary); - do_outf calls_csv (fun outf -> F.fprintf outf.fmt "%a" (CallsCsv.pp_calls fname) summary); + do_outf procs_csv (fun outf -> ProcsCsv.pp_summary top_proc_set outf.fmt summary); + do_outf calls_csv (fun outf -> CallsCsv.pp_calls outf.fmt summary); do_outf procs_xml (fun outf -> ProcsXml.pp_proc top_proc_set outf.fmt summary); - do_outf bugs_csv (fun outf -> BugsCsv.pp_bugs error_filter fname outf.fmt summary); - do_outf bugs_json (fun outf -> BugsJson.pp_bugs error_filter fname outf.fmt summary); - do_outf bugs_txt (fun outf -> BugsTxt.pp_bugs error_filter linereader outf.fmt summary); + do_outf bugs_csv (fun outf -> BugsCsv.pp_bugs error_filter outf.fmt summary); + do_outf bugs_json (fun outf -> BugsJson.pp_bugs error_filter outf.fmt summary); + do_outf bugs_txt (fun outf -> BugsTxt.pp_bugs error_filter outf.fmt summary); do_outf bugs_xml (fun outf -> BugsXml.pp_bugs error_filter linereader outf.fmt summary); - do_outf report (fun outf -> Stats.process_summary error_filter summary linereader stats); + do_outf report (fun _ -> Stats.process_summary error_filter summary linereader stats); if !precondition_stats then PreconditionStats.do_summary proc_name summary; - if !unit_test then UnitTest.print_unit_test fname proc_name summary; + if !unit_test then UnitTest.print_unit_test proc_name summary; Config.pp_simple := pp_simple_saved; - do_outf latex (fun outf -> write_summary_latex (DB.filename_from_string fname) outf.fmt summary); + do_outf latex (fun outf -> write_summary_latex outf.fmt summary); if !svg then begin let specs = Specs.get_specs_from_payload summary in let dot_file = DB.filename_add_suffix base ".dot" in @@ -1058,7 +1061,7 @@ module AnalysisResults = struct | Some summary -> summaries := (fname, summary) :: !summaries in apply_without_gc (IList.iter load_file) spec_files_from_cmdline; - let summ_cmp (fname1, summ1) (fname2, summ2) = + let summ_cmp (_, summ1) (_, summ2) = let n = DB.source_file_compare summ1.Specs.attributes.ProcAttributes.loc.Location.file diff --git a/infer/src/backend/interproc.ml b/infer/src/backend/interproc.ml index 7e01cc98e..b468457a8 100644 --- a/infer/src/backend/interproc.ml +++ b/infer/src/backend/interproc.ml @@ -253,14 +253,13 @@ let propagate (wl : Worklist.t) pname is_exception (pset: Paths.PathSet.t) (curr (** propagate a set of results, including exceptions and divergence *) let propagate_nodes_divergence tenv (pdesc: Cfg.Procdesc.t) (pset: Paths.PathSet.t) - (path: Paths.Path.t) (kind_curr_node : Cfg.Node.nodekind) (_succ_nodes: Cfg.node list) - (exn_nodes: Cfg.node list) (wl : Worklist.t) = + (succ_nodes_: Cfg.node list) (exn_nodes: Cfg.node list) (wl : Worklist.t) = let pname = Cfg.Procdesc.get_proc_name pdesc in let pset_exn, pset_ok = Paths.PathSet.partition (Tabulation.prop_is_exn pname) pset in let succ_nodes = match State.get_goto_node () with (* handle Sil.Goto_node target, if any *) | Some node_id -> - IList.filter (fun n -> Cfg.Node.get_id n = node_id) _succ_nodes - | None -> _succ_nodes in + IList.filter (fun n -> Cfg.Node.get_id n = node_id) succ_nodes_ + | None -> succ_nodes_ in if !Config.footprint && not (Paths.PathSet.is_empty (State.get_diverging_states_node ())) then begin Errdesc.warning_err (State.get_loc ()) "Propagating Divergence@."; @@ -303,7 +302,7 @@ let prop_max_size = ref (0, Prop.prop_emp) let prop_max_chain_size = ref (0, Prop.prop_emp) (* Check if the prop exceeds the current max *) -let check_prop_size p path = +let check_prop_size p _ = let size = Prop.Metrics.prop_size p in if size > fst !prop_max_size then (prop_max_size := (size, p); @@ -552,15 +551,14 @@ let forward_tabulate cfg tenv wl = let pset = do_symbolic_execution (handle_exn curr_node) cfg tenv curr_node prop path in L.d_decrease_indent 1; L.d_ln(); - propagate_nodes_divergence - tenv proc_desc pset path curr_node_kind succ_nodes exn_nodes wl; + propagate_nodes_divergence tenv proc_desc pset succ_nodes exn_nodes wl; with | exn when Exceptions.handle_exception exn && !Config.footprint -> handle_exn curr_node exn; if !Config.nonstop then propagate_nodes_divergence tenv proc_desc (Paths.PathSet.from_renamed_list [(prop, path)]) - path curr_node_kind succ_nodes exn_nodes wl; + succ_nodes exn_nodes wl; L.d_decrease_indent 1; L.d_ln ()) pathset_todo in try @@ -645,7 +643,7 @@ let vset_ref_add_path vset_ref path = Paths.Path.iter_all_nodes_nocalls (fun n -> vset_ref := Cfg.NodeSet.add n !vset_ref) path let vset_ref_add_pathset vset_ref pathset = - Paths.PathSet.iter (fun p path -> vset_ref_add_path vset_ref path) pathset + Paths.PathSet.iter (fun _ path -> vset_ref_add_path vset_ref path) pathset let compute_visited vset = let res = ref Specs.Visitedset.empty in @@ -663,7 +661,7 @@ let extract_specs tenv pdesc pathset : Prop.normal Specs.spec list = let pname = Cfg.Procdesc.get_proc_name pdesc in let sub = let fav = Sil.fav_new () in - Paths.PathSet.iter (fun prop path -> Prop.prop_fav_add fav prop) pathset; + Paths.PathSet.iter (fun prop _ -> Prop.prop_fav_add fav prop) pathset; let sub_list = IList.map (fun id -> (id, Sil.Var (Ident.create_fresh (Ident.knormal)))) (Sil.fav_to_list fav) in Sil.sub_of_list sub_list in let pre_post_visited_list = @@ -845,7 +843,7 @@ let execute_filter_prop wl cfg tenv pdesc init_node (precondition : Prop.normal let get_procs_and_defined_children call_graph = IList.map (fun (n, ns) -> (n, Procname.Set.elements ns)) (Cg.get_nodes_and_defined_children call_graph) -let pp_intra_stats wl cfg proc_desc fmt proc_name = +let pp_intra_stats wl proc_desc fmt _ = let nstates = ref 0 in let nodes = Cfg.Procdesc.get_nodes proc_desc in IList.iter (fun node -> @@ -901,7 +899,7 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t L.out "#### [FUNCTION %a] ... OK #####@\n" Procname.pp pname; L.out "#### Finished: Footprint Computation for %a %a ####@." Procname.pp pname - (pp_intra_stats wl cfg pdesc) pname; + (pp_intra_stats wl pdesc) pname; L.out "#### [FUNCTION %a] Footprint Analysis result ####@\n%a@." Procname.pp pname (Paths.PathSet.pp pe_text) results; @@ -935,7 +933,7 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t let outcome = if is_valid then "pass" else "fail" in L.out "Finished re-execution for precondition %d %a (%s)@." (Specs.Jprop.to_number p) - (pp_intra_stats wl cfg pdesc) proc_name + (pp_intra_stats wl pdesc) proc_name outcome; speco in if !Config.undo_join then @@ -967,17 +965,17 @@ let perform_analysis_phase cfg tenv (pname : Procname.t) (pdesc : Cfg.Procdesc.t | Specs.RE_EXECUTION -> re_execution pname -let set_current_language cfg proc_desc = +let set_current_language proc_desc = let language = (Cfg.Procdesc.get_attributes proc_desc).ProcAttributes.language in Config.curr_language := language (** reset counters before analysing a procedure *) -let reset_global_counters cfg proc_name proc_desc = +let reset_global_counters proc_desc = Ident.NameGenerator.reset (); SymOp.reset_total (); reset_prop_metrics (); Abs.abs_rules_reset (); - set_current_language cfg proc_desc + set_current_language proc_desc (* Collect all pairs of the kind (precondition, runtime exception) from a summary *) let exception_preconditions tenv pname summary = @@ -993,7 +991,7 @@ let exception_preconditions tenv pname summary = IList.fold_left collect_spec [] (Specs.get_specs_from_payload summary) (* Collect all pairs of the kind (precondition, custom error) from a summary *) -let custom_error_preconditions tenv pname summary = +let custom_error_preconditions summary = let collect_errors pre errors (prop, _) = match Tabulation.lookup_custom_errors prop with | None -> errors @@ -1038,7 +1036,7 @@ let is_unavoidable pre = (** Detects if there are specs of the form {precondition} proc {runtime exception} and report an error in that case, generating the trace that lead to the runtime exception if the method is called in the context { precondition } *) -let report_runtime_exceptions tenv cfg pdesc summary = +let report_runtime_exceptions tenv pdesc summary = let pname = Specs.get_proc_name summary in let is_public_method = (Specs.get_attributes summary).ProcAttributes.access = Sil.Public in @@ -1064,7 +1062,7 @@ let report_runtime_exceptions tenv cfg pdesc summary = IList.iter report (exception_preconditions tenv pname summary) -let report_custom_errors tenv cfg pdesc summary = +let report_custom_errors summary = let pname = Specs.get_proc_name summary in let report (pre, custom_error) = if is_unavoidable pre then @@ -1072,7 +1070,7 @@ let report_custom_errors tenv cfg pdesc summary = let err_desc = Localise.desc_custom_error loc in let exn = Exceptions.Custom_error (custom_error, err_desc) in Reporting.log_error pname ~pre: (Some (Specs.Jprop.to_prop pre)) exn in - IList.iter report (custom_error_preconditions tenv pname summary) + IList.iter report (custom_error_preconditions summary) (** update a summary after analysing a procedure *) @@ -1084,7 +1082,7 @@ let update_summary prev_summary specs phase proc_name elapsed res = let symops = prev_summary.Specs.stats.Specs.symops + SymOp.get_total () in let stats_failure = match res with | None -> prev_summary.Specs.stats.Specs.stats_failure - | Some failure_kind -> res in + | Some _ -> res in let stats = { prev_summary.Specs.stats with Specs.stats_time; @@ -1114,7 +1112,7 @@ let analyze_proc exe_env (proc_name: Procname.t) : Specs.summary = let proc_desc = match Cfg.Procdesc.find_from_name cfg proc_name with | Some proc_desc -> proc_desc | None -> assert false in - reset_global_counters cfg proc_name proc_desc; + reset_global_counters proc_desc; let go, get_results = perform_analysis_phase cfg tenv proc_name proc_desc in let res = Fork.Timeout.exe_timeout (Specs.get_iterations proc_name) go () in let specs, phase = get_results () in @@ -1123,9 +1121,9 @@ let analyze_proc exe_env (proc_name: Procname.t) : Specs.summary = let updated_summary = update_summary prev_summary specs phase proc_name elapsed res in if !Config.curr_language == Config.C_CPP && Config.report_custom_error then - report_custom_errors tenv cfg proc_desc updated_summary; + report_custom_errors updated_summary; if !Config.curr_language == Config.Java && !Config.report_runtime_exceptions then - report_runtime_exceptions tenv cfg proc_desc updated_summary; + report_runtime_exceptions tenv proc_desc updated_summary; updated_summary (** Perform phase transition from [FOOTPRINT] to [RE_EXECUTION] for @@ -1195,7 +1193,7 @@ let filter_out (call_graph: Cg.t) (proc_name: Procname.t) : bool = let check_skipped_procs procs_and_defined_children = let skipped_procs = ref Procname.Set.empty in - let proc_check_skips (pname, dep) = + let proc_check_skips (pname, _) = let process_skip () = let call_stats = (Specs.get_summary_unsafe "check_skipped_procs" pname).Specs.stats.Specs.call_stats in @@ -1214,7 +1212,7 @@ let check_skipped_procs procs_and_defined_children = (** create a function to filter procedures which were skips but now have a .specs file *) let filter_skipped_procs cg procs_and_defined_children = let skipped_procs_with_summary = check_skipped_procs procs_and_defined_children in - let filter (pname, dep) = + let filter (pname, _) = let calls_recurs pn = let r = try Cg.calls_recursively cg pname pn with Not_found -> false in L.err "calls recursively %a %a: %b@." Procname.pp pname Procname.pp pn r; @@ -1223,7 +1221,7 @@ let filter_skipped_procs cg procs_and_defined_children = filter (** create a function to filter procedures which were analyzed before but had no specs *) -let filter_nospecs (pname, dep) = +let filter_nospecs (pname, _) = if Specs.summary_exists pname then Specs.get_specs pname = [] else false @@ -1386,7 +1384,7 @@ let print_stats_cfg proc_shadowed proc_is_active cfg = let _print_stats exe_env = let proc_is_active proc_desc = Exe_env.proc_is_active exe_env (Cfg.Procdesc.get_proc_name proc_desc) in - Exe_env.iter_files (fun fname tenv cfg -> + Exe_env.iter_files (fun fname cfg -> let proc_shadowed proc_desc = (** return true if a proc with the same name in another module was analyzed instead *) let proc_name = Cfg.Procdesc.get_proc_name proc_desc in diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index 534208681..99639ff34 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -131,7 +131,7 @@ module Tags = struct let create () = ref [] let add tags tag value = tags := (tag, value) :: !tags let update tags tag value = - let tags' = IList.filter (fun (t, v) -> t <> tag) tags in + let tags' = IList.filter (fun (t, _) -> t <> tag) tags in (tag, value) :: tags' let get tags tag = try @@ -184,8 +184,8 @@ let error_desc_set_bucket err_desc bucket show_in_message = (** get the value tag, if any *) let get_value_line_tag tags = try - let value = snd (IList.find (fun (_tag, value) -> _tag = Tags.value) tags) in - let line = snd (IList.find (fun (_tag, value) -> _tag = Tags.line) tags) in + let value = snd (IList.find (fun (_tag, _) -> _tag = Tags.value) tags) in + let line = snd (IList.find (fun (_tag, _) -> _tag = Tags.line) tags) in Some [value; line] with Not_found -> None @@ -470,7 +470,7 @@ let dereference_string deref_str value_str access_opt loc = let line_str = string_of_int n in Tags.add tags Tags.accessed_line line_str; ["last accessed on line " ^ line_str] - | Some (Last_assigned (n, ncf)) -> + | Some (Last_assigned (n, _)) -> let line_str = string_of_int n in Tags.add tags Tags.assigned_line line_str; ["last assigned on line " ^ line_str] @@ -498,7 +498,7 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = let field_not_nullable_desc exp = let rec exp_to_string exp = match exp with - | Sil.Lfield (exp', field, typ) -> (exp_to_string exp')^" -> "^(Ident.fieldname_to_string field) + | Sil.Lfield (exp', field, _) -> (exp_to_string exp')^" -> "^(Ident.fieldname_to_string field) | Sil.Lvar pvar -> Mangled.to_string (Sil.pvar_get_name pvar) | _ -> "" in let var_s = exp_to_string exp in @@ -512,7 +512,7 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = | _ -> desc let has_tag (desc : error_desc) tag = - IList.exists (fun (tag', value) -> tag = tag') desc.tags + IList.exists (fun (tag', _) -> tag = tag') desc.tags let is_parameter_not_null_checked_desc desc = has_tag desc Tags.parameter_not_null_checked @@ -713,7 +713,7 @@ let desc_retain_cycle prop cycle loc cycle_dotty = match Str.split_delim (Str.regexp_string "&old_") s with | [_; s'] -> s' | _ -> s in - let do_edge ((se, _), f, se') = + let do_edge ((se, _), f, _) = match se with | Sil.Eexp(Sil.Lvar pvar, _) when Sil.pvar_equal pvar Sil.block_pvar -> str_cycle:=!str_cycle^" ("^(string_of_int !ct)^") a block capturing "^(Ident.fieldname_to_string f)^"; "; diff --git a/infer/src/backend/logging.ml b/infer/src/backend/logging.ml index 0e2d859dc..83efafc3d 100644 --- a/infer/src/backend/logging.ml +++ b/infer/src/backend/logging.ml @@ -69,7 +69,7 @@ let current_out_formatter = ref F.std_formatter let current_err_formatter = ref F.err_formatter (** Get the current err formatter *) -let get_err_formatter fmt = !current_err_formatter +let get_err_formatter () = !current_err_formatter (** Set the current out formatter *) let set_out_formatter fmt = diff --git a/infer/src/backend/match.ml b/infer/src/backend/match.ml index fe9c3bf16..5c9ad8bb4 100644 --- a/infer/src/backend/match.ml +++ b/infer/src/backend/match.ml @@ -52,7 +52,7 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = check_equal sub vars e1 e2 | Sil.Sizeof _, _ | _, Sil.Sizeof _ -> check_equal sub vars e1 e2 - | Sil.Cast (t1, e1'), Sil.Cast (t2, e2') -> (* we are currently ignoring cast *) + | Sil.Cast (_, e1'), Sil.Cast (_, e2') -> (* we are currently ignoring cast *) exp_match e1' sub vars e2' | Sil.Cast _, _ | _, Sil.Cast _ -> None @@ -68,7 +68,7 @@ let rec exp_match e1 sub vars e2 : (Sil.subst * Ident.t list) option = None (* Naive *) | Sil.Lvar _, _ | _, Sil.Lvar _ -> check_equal sub vars e1 e2 - | Sil.Lfield(e1', fld1, t1), Sil.Lfield(e2', fld2, t2) when (Sil.fld_equal fld1 fld2) -> + | Sil.Lfield(e1', fld1, _), Sil.Lfield(e2', fld2, _) when (Sil.fld_equal fld1 fld2) -> exp_match e1' sub vars e2' | Sil.Lfield _, _ | _, Sil.Lfield _ -> None @@ -91,7 +91,7 @@ let exp_list_match es1 sub vars es2 = sometimes forgets fields of hpred. It can possibly cause a problem. *) let rec strexp_match sexp1 sub vars sexp2 : (Sil.subst * Ident.t list) option = match sexp1, sexp2 with - | Sil.Eexp (exp1, inst1), Sil.Eexp (exp2, inst2) -> + | Sil.Eexp (exp1, _), Sil.Eexp (exp2, _) -> exp_match exp1 sub vars exp2 | Sil.Eexp _, _ | _, Sil.Eexp _ -> None @@ -180,7 +180,7 @@ let rec instantiate_to_emp p condition sub vars = function if not hpat.flag then None else match hpat.hpred with | Sil.Hpointsto _ | Sil.Hlseg (Sil.Lseg_NE, _, _, _, _) | Sil.Hdllseg (Sil.Lseg_NE, _, _, _, _, _, _) -> None - | Sil.Hlseg (k, _, e1, e2, _) -> + | Sil.Hlseg (_, _, e1, e2, _) -> let fully_instantiated = not (IList.exists (fun id -> Sil.ident_in_exp id e1) vars) in if (not fully_instantiated) then None else let e1' = Sil.exp_sub sub e1 @@ -190,7 +190,7 @@ let rec instantiate_to_emp p condition sub vars = function | Some (sub_new, vars_leftover) -> instantiate_to_emp p condition sub_new vars_leftover hpats end - | Sil.Hdllseg (k, _, iF, oB, oF, iB, _) -> + | Sil.Hdllseg (_, _, iF, oB, oF, iB, _) -> let fully_instantiated = not (IList.exists (fun id -> Sil.ident_in_exp id iF || Sil.ident_in_exp id oB) vars) in if (not fully_instantiated) then None else @@ -484,7 +484,7 @@ type iso_mode = Exact | LFieldForget | RFieldForget let rec generate_todos_from_strexp mode todos sexp1 sexp2 = match sexp1, sexp2 with - | Sil.Eexp (exp1, inst1), Sil.Eexp (exp2, inst2) -> + | Sil.Eexp (exp1, _), Sil.Eexp (exp2, _) -> let new_todos = (exp1, exp2) :: todos in Some new_todos | Sil.Eexp _, _ -> diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index b1d453f1f..3931866e7 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -116,7 +116,7 @@ let restore_global_state st = let do_analysis curr_pdesc callee_pname = let curr_pname = Cfg.Procdesc.get_proc_name curr_pdesc in - let really_do_analysis analyze_proc proc_desc = + let really_do_analysis analyze_proc = if trace () then L.stderr "[%d] really_do_analysis %a -> %a@." !nesting Procname.pp curr_pname @@ -170,8 +170,7 @@ let do_analysis curr_pdesc callee_pname = when procedure_should_be_analyzed curr_pdesc callee_pname -> begin match callbacks.get_proc_desc callee_pname with - | Some proc_desc -> - really_do_analysis callbacks.analyze_ondemand proc_desc + | Some _ -> really_do_analysis callbacks.analyze_ondemand | None -> () end | _ -> diff --git a/infer/src/backend/paths.ml b/infer/src/backend/paths.ml index 56d1de991..ba9172424 100644 --- a/infer/src/backend/paths.ml +++ b/infer/src/backend/paths.ml @@ -99,7 +99,7 @@ end = struct let get_description path = match path with - | Pnode (node, exn_opt, session, path, stats, descr_opt) -> + | Pnode (_, _, _, _, _, descr_opt) -> descr_opt | _ -> None @@ -182,9 +182,9 @@ end = struct (** restore the invariant that all the stats are dummy, so the path is ready for another traversal *) (** assumes that the stats are computed beforehand, and ensures that the invariant holds afterwards *) let rec reset_stats = function - | Pstart (node, stats) -> + | Pstart (_, stats) -> if not (stats_is_dummy stats) then set_dummy_stats stats - | Pnode (node, exn_opt, session, path, stats, _) -> + | Pnode (_, _, _, path, stats, _) -> if not (stats_is_dummy stats) then begin reset_stats path; @@ -197,7 +197,7 @@ end = struct reset_stats path2; set_dummy_stats stats end - | Pcall (path1, pname, path2, stats) -> + | Pcall (path1, _, path2, stats) -> if not (stats_is_dummy stats) then begin reset_stats path1; @@ -221,7 +221,7 @@ end = struct stats.max_length <- if found then 1 else 0; stats.linear_num <- 1.0; end - | Pnode (node, exn_opt, session, path, stats, _) -> + | Pnode (node, _, _, path, stats, _) -> if stats_is_dummy stats then begin compute_stats do_calls f path; @@ -239,7 +239,7 @@ end = struct stats.max_length <- max stats1.max_length stats2.max_length; stats.linear_num <- stats1.linear_num +. stats2.linear_num end - | Pcall (path1, pname, path2, stats) -> + | Pcall (path1, _, path2, stats) -> if stats_is_dummy stats then begin let stats2 = match do_calls with @@ -287,7 +287,7 @@ end = struct (filter: Cfg.Node.t -> bool) (path: t) : unit = let rec doit level session path prev_exn_opt = match path with | Pstart _ -> f level path session prev_exn_opt - | Pnode (node, exn_opt, session', p, _, _) -> + | Pnode (_, exn_opt, session', p, _, _) -> let next_exn_opt = if prev_exn_opt <> None then None else exn_opt in (* no two consecutive exceptions *) doit level session' p next_exn_opt; f level path session prev_exn_opt @@ -328,7 +328,7 @@ end = struct let sequence_up_to_last_seen = if !position_seen then let rec remove_until_seen = function - | ((level, p, session, exn_opt) as x):: l -> + | ((_, p, _, _) as x):: l -> if path_pos_at_path p then IList.rev (x :: l) else remove_until_seen l | [] -> [] in @@ -352,7 +352,7 @@ end = struct end | None -> () in - iter_longest_sequence (fun level p s exn_opt -> add_node (curr_node p)) None path; + iter_longest_sequence (fun _ p _ _ -> add_node (curr_node p)) None path; let max_rep_node = ref (Cfg.Node.dummy ()) in let max_rep_num = ref 0 in NodeMap.iter (fun node num -> if num > !max_rep_num then (max_rep_node := node; max_rep_num := num)) !map; @@ -405,11 +405,15 @@ end = struct let num = PathMap.find path !delayed in F.fprintf fmt "P%d" num with Not_found -> - match path with - | Pstart (node, _) -> F.fprintf fmt "n%a" Cfg.Node.pp node - | Pnode (node, exn_top, session, path, _, _) -> F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path session Cfg.Node.pp node - | Pjoin (path1, path2, _) -> F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2 - | Pcall (path1, _, path2, _) -> F.fprintf fmt "(%a{%a})" (doit (n - 1)) path1 (doit (n - 1)) path2 in + match path with + | Pstart (node, _) -> + F.fprintf fmt "n%a" Cfg.Node.pp node + | Pnode (node, _, session, path, _, _) -> + F.fprintf fmt "%a(s%d).n%a" (doit (n - 1)) path session Cfg.Node.pp node + | Pjoin (path1, path2, _) -> + F.fprintf fmt "(%a + %a)" (doit (n - 1)) path1 (doit (n - 1)) path2 + | Pcall (path1, _, path2, _) -> + F.fprintf fmt "(%a{%a})" (doit (n - 1)) path1 (doit (n - 1)) path2 in let print_delayed () = if not (PathMap.is_empty !delayed) then begin let f path num = F.fprintf fmt "P%d = %a@\n" num (doit 1) path in @@ -435,7 +439,7 @@ end = struct Errlog.lt_loc = loc; Errlog.lt_description = descr; Errlog.lt_node_tags = node_tags } in - let g level path session exn_opt = + let g level path _ exn_opt = match curr_node path with | Some curr_node -> begin @@ -585,7 +589,7 @@ module PathSet : sig end = struct type t = Path.t PropMap.t - let equal = PropMap.equal (fun p1 p2 -> true) (* only discriminate props, and ignore paths *) (* Path.equal *) + let equal = PropMap.equal (fun _ _ -> true) (* only discriminate props, and ignore paths *) let empty : t = PropMap.empty @@ -668,7 +672,7 @@ end = struct let size ps = let res = ref 0 in - let add p _ = incr res in + let add _ _ = incr res in let () = PropMap.iter add ps in !res diff --git a/infer/src/backend/preanal.ml b/infer/src/backend/preanal.ml index 80aad67c9..27739c785 100644 --- a/infer/src/backend/preanal.ml +++ b/infer/src/backend/preanal.ml @@ -19,7 +19,7 @@ module AllPreds = struct NodeHash.clear preds_table let mk_table cfg = - let do_pdesc pname pdesc = + let do_pdesc _ pdesc = let exit_node = Cfg.Procdesc.get_exit_node pdesc in let add_edge is_exn nfrom nto = if is_exn && Cfg.Node.equal nto exit_node then () @@ -90,12 +90,12 @@ let rec use_exp cfg pdesc (exp: Sil.exp) acc = and use_etl cfg pdesc (etl: (Sil.exp * Sil.typ) list) acc = IList.fold_left (fun acc (e, _) -> use_exp cfg pdesc e acc) acc etl -and use_instr cfg tenv (pdesc: Cfg.Procdesc.t) (instr: Sil.instr) acc = +and use_instr cfg (pdesc: Cfg.Procdesc.t) (instr: Sil.instr) acc = match instr with | Sil.Set (_, _, e, _) | Sil.Letderef (_, e, _, _) -> use_exp cfg pdesc e acc | Sil.Prune (e, _, _, _) -> use_exp cfg pdesc e acc - | Sil.Call (_, e, etl, _, _) -> use_etl cfg pdesc etl acc + | Sil.Call (_, _, etl, _, _) -> use_etl cfg pdesc etl acc | Sil.Nullify _ -> acc | Sil.Abstract _ | Sil.Remove_temps _ | Sil.Stackop _ | Sil.Declare_locals _ -> acc | Sil.Goto_node (e, _) -> use_exp cfg pdesc e acc @@ -144,11 +144,11 @@ let def_node cfg node acc = | Cfg.Node.Stmt_node _ -> def_instrl cfg (Cfg.Node.get_instrs node) acc -let compute_live_instr cfg tenv pdesc s instr = - use_instr cfg tenv pdesc instr (Vset.diff s (def_instr cfg instr Vset.empty)) +let compute_live_instr cfg pdesc s instr = + use_instr cfg pdesc instr (Vset.diff s (def_instr cfg instr Vset.empty)) -let compute_live_instrl cfg tenv pdesc instrs livel = - IList.fold_left (compute_live_instr cfg tenv pdesc) livel (IList.rev instrs) +let compute_live_instrl cfg pdesc instrs livel = + IList.fold_left (compute_live_instr cfg pdesc) livel (IList.rev instrs) module Worklist = struct module S = Cfg.NodeSet @@ -226,7 +226,7 @@ let compute_candidates procdesc : Vset.t * (Vset.t -> Vset.elt list) = !candidates, get_sorted_candidates (** Construct a table wich associates to each node a set of live variables *) -let analyze_proc cfg tenv pdesc cand = +let analyze_proc cfg pdesc cand = let exit_node = Cfg.Procdesc.get_exit_node pdesc in Worklist.reset (); Table.reset (); @@ -242,7 +242,7 @@ let analyze_proc cfg tenv pdesc cand = | Cfg.Node.Start_node _ | Cfg.Node.Exit_node _ | Cfg.Node.Join_node | Cfg.Node.Skip_node _ -> curr_live | Cfg.Node.Prune_node _ | Cfg.Node.Stmt_node _ -> - compute_live_instrl cfg tenv pdesc (Cfg.Node.get_instrs node) curr_live in + compute_live_instrl cfg pdesc (Cfg.Node.get_instrs node) curr_live in Table.propagate_to_preds (Vset.inter live_at_predecessors cand) preds done with Not_found -> () @@ -310,7 +310,7 @@ let add_dead_pvars_after_conditionals_join cfg n dead_pvars = (** Find the set of dead variables for the procedure pname and add nullify instructions. The variables that are possibly aliased are only considered just before the exit node. *) -let analyze_and_annotate_proc cfg tenv pname pdesc = +let analyze_and_annotate_proc cfg pname pdesc = let exit_node = Cfg.Procdesc.get_exit_node pdesc in let exit_node_is_succ node = match Cfg.Node.get_succs node with @@ -319,7 +319,7 @@ let analyze_and_annotate_proc cfg tenv pname pdesc = let cand, get_sorted_cand = compute_candidates pdesc in aliased_var:= Vset.empty; captured_var:= Vset.empty; - analyze_proc cfg tenv pdesc cand; (* as side effect it coputes the set aliased_var *) + analyze_proc cfg pdesc cand; (* as side effect it coputes the set aliased_var *) (* print_aliased_var "@.@.Aliased variable computed: " !aliased_var; L.out " PROCEDURE %s@." (Procname.to_string pname); *) let dead_pvars_added = ref 0 in @@ -383,7 +383,7 @@ let add_dispatch_calls cfg cg tenv f_translate_typ_opt = IList.exists instr_is_dispatch_call instrs in let replace_dispatch_calls = function | Sil.Call (ret_ids, (Sil.Const (Sil.Cfun callee_pname) as call_exp), - (((receiver_exp, receiver_typ) :: _) as args), loc, call_flags) as instr + (((_, receiver_typ) :: _) as args), loc, call_flags) as instr when call_flags_is_dispatch call_flags -> (* the frontend should not populate the list of targets *) assert (call_flags.Sil.cf_targets = []); @@ -392,7 +392,7 @@ let add_dispatch_calls cfg cg tenv f_translate_typ_opt = let overrides = Prover.get_overrides_of tenv receiver_typ_no_ptr callee_pname in IList.sort (fun (_, p1) (_, p2) -> Procname.compare p1 p2) overrides in (match sorted_overrides with - | ((_, target_pname) :: targets) as all_targets -> + | ((_, target_pname) :: _) as all_targets -> let targets_to_add = if Config.sound_dynamic_dispatch then IList.map snd all_targets @@ -420,7 +420,7 @@ let add_dispatch_calls cfg cg tenv f_translate_typ_opt = let doit ?(f_translate_typ=None) cfg cg tenv = AllPreds.mk_table cfg; - Cfg.iter_proc_desc cfg (analyze_and_annotate_proc cfg tenv); + Cfg.iter_proc_desc cfg (analyze_and_annotate_proc cfg); AllPreds.clear_table (); if !Config.curr_language = Config.Java then add_dispatch_calls cfg cg tenv f_translate_typ; diff --git a/infer/src/backend/printer.ml b/infer/src/backend/printer.ml index a9d520d53..ee1e199d5 100644 --- a/infer/src/backend/printer.ml +++ b/infer/src/backend/printer.ml @@ -289,7 +289,7 @@ let proc_write_log whole_seconds cfg pname = (** Creare a hash table mapping line numbers to the set of errors occurring on that line *) let create_errors_per_line err_log = let err_per_line = Hashtbl.create 17 in - let add_err node_id_key loc ml_loc_opt ekind in_footprint err_name desc severity ltr pre_opt eclass = + let add_err _ loc _ _ _ err_name desc _ _ _ _ = let err_str = Localise.to_string err_name ^ " " ^ (pp_to_string Localise.pp_error_desc desc) in try let set = Hashtbl.find err_per_line loc.Location.line in @@ -373,7 +373,7 @@ end = struct end (** Create filename.c.html with line numbers and links to nodes *) -let c_file_write_html proc_is_active linereader fname tenv cfg = +let c_file_write_html proc_is_active linereader fname cfg = let proof_cover = ref Specs.Visitedset.empty in let tbl = Hashtbl.create 11 in let process_node n = diff --git a/infer/src/backend/procname.ml b/infer/src/backend/procname.ml index 00cca66a5..f49754f3f 100644 --- a/infer/src/backend/procname.ml +++ b/infer/src/backend/procname.ml @@ -142,8 +142,8 @@ let java_sig_compare (js1: java_signature) (js2 : java_signature) = let c_function_mangled_compare mangled1 mangled2 = match mangled1, mangled2 with - | Some mangled1, None -> 1 - | None, Some mangled2 -> -1 + | Some _, None -> 1 + | None, Some _ -> -1 | None, None -> 0 | Some mangled1, Some mangled2 -> string_compare mangled1 mangled2 @@ -328,7 +328,7 @@ let java_is_anonymous_inner_class = function let java_remove_hidden_inner_class_parameter = function | Java_method js -> (match IList.rev js.parameters with - | (so, s) :: par' -> + | (_, s) :: par' -> if is_anonymous_inner_class_name s then Some (Java_method { js with parameters = IList.rev par'}) else None @@ -388,7 +388,7 @@ let is_class_initializer = function (** [is_infer_undefined pn] returns true if [pn] is a special Infer undefined proc *) let is_infer_undefined pn = match pn with - | Java_method j -> + | Java_method _ -> let regexp = Str.regexp "com.facebook.infer.models.InferUndefined" in Str.string_match regexp (java_get_class pn) 0 | _ -> @@ -439,7 +439,7 @@ let to_simplified_string ?(withclass = false) p = | C_function (c1, c2) -> to_readable_string (c1, c2) false ^ "()" | ObjC_Cpp_method osig -> c_method_to_string osig Simple - | ObjC_block name -> "block" + | ObjC_block _ -> "block" (** Convert a proc name to a filename *) let to_filename (pn : proc_name) = diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 9c0bd8f26..247563889 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -110,12 +110,12 @@ let pp_texp_simple pe = match pe.pe_opt with | PP_SIM_WITH_TYP -> Sil.pp_texp_full pe (** Pretty print a pointsto representing a stack variable as an equality *) -let pp_hpred_stackvar pe0 env f hpred = +let pp_hpred_stackvar pe0 f hpred = let pe, changed = Sil.color_pre_wrapper pe0 f hpred in begin match hpred with | Sil.Hpointsto (Sil.Lvar pvar, se, te) -> let pe' = match se with - | Sil.Eexp (Sil.Var id, inst) when not (Sil.pvar_is_global pvar) -> + | Sil.Eexp (Sil.Var _, _) when not (Sil.pvar_is_global pvar) -> { pe with pe_obj_sub = None } (* dont use obj sub on the var defining it *) | _ -> pe in (match pe'.pe_kind with @@ -177,7 +177,7 @@ let pp_sigma_simple pe env fmt sigma = let sigma_stack, sigma_nonstack = sigma_get_stack_nonstack false sigma in let pp_stack fmt _sg = let sg = IList.sort Sil.hpred_compare _sg in - if sg != [] then Format.fprintf fmt "%a" (pp_semicolon_seq pe (pp_hpred_stackvar pe env)) sg in + if sg != [] then Format.fprintf fmt "%a" (pp_semicolon_seq pe (pp_hpred_stackvar pe)) sg in let pp_nl fmt doit = if doit then (match pe.pe_kind with | PP_TEXT | PP_HTML -> Format.fprintf fmt " ;@\n" @@ -238,13 +238,13 @@ let pp_hpara_dll_simple _pe env n f pred = let create_pvar_env (sigma: sigma) : (Sil.exp -> Sil.exp) = let env = ref [] in let filter = function - | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var v, inst), _) -> + | Sil.Hpointsto (Sil.Lvar pvar, Sil.Eexp (Sil.Var v, _), _) -> if not (Sil.pvar_is_global pvar) then env := (Sil.Var v, Sil.Lvar pvar) :: !env | _ -> () in IList.iter filter sigma; let find e = try - snd (IList.find (fun (e1, e2) -> Sil.exp_equal e1 e) !env) + snd (IList.find (fun (e1, _) -> Sil.exp_equal e1 e) !env) with Not_found -> e in find @@ -287,7 +287,7 @@ let pp_prop pe0 f prop = let env = prop_pred_env prop in let iter_f n hpara = F.fprintf f "@,@[%a@]" (pp_hpara_simple pe env n) hpara in let iter_f_dll n hpara_dll = F.fprintf f "@,@[%a@]" (pp_hpara_dll_simple pe env n) hpara_dll in - let pp_predicates fmt () = + let pp_predicates _ () = if Sil.Predicates.is_empty env then () else if latex then @@ -573,7 +573,7 @@ let sym_eval abs e = eval (Sil.BinOp (Sil.PlusPI, e11, e2')) | Sil.BinOp (Sil.PlusA, - (Sil.Sizeof (Sil.Tstruct struct_typ, st) as e1), + (Sil.Sizeof (Sil.Tstruct struct_typ, _) as e1), e2) -> (* pattern for extensible structs given a struct declatead as struct s { ... t arr[n] ... }, allocation pattern malloc(sizeof(struct s) + k * siezof(t)) turn it into @@ -698,7 +698,7 @@ let sym_eval abs e = Sil.exp_int (Sil.Int.mul n m) | Sil.Const (Sil.Cfloat v), Sil.Const (Sil.Cfloat w) -> Sil.exp_float (v *. w) - | Sil.Var v, Sil.Var w -> + | Sil.Var _, Sil.Var _ -> Sil.BinOp(Sil.Mult, e1', e2') | _, _ -> if abs then Sil.exp_get_undefined false else Sil.BinOp(Sil.Mult, e1', e2') @@ -841,7 +841,7 @@ and typ_normalize sub typ = match typ with } | Sil.Tarray (t, e) -> Sil.Tarray (typ_normalize sub t, exp_normalize sub e) - | Sil.Tenum econsts -> + | Sil.Tenum _ -> typ let run_with_abs_val_eq_zero f = @@ -1003,7 +1003,7 @@ let atom_normalize sub a0 = (e1, Sil.exp_int (n1 ++ n2)) | Sil.BinOp(Sil.MinusA, Sil.Const (Sil.Cint n1), e1), Sil.Const (Sil.Cint n2) -> (* n1-e1 == n2 -> e1==n1-n2 *) (e1, Sil.exp_int (n1 -- n2)) - | Sil.Lfield (e1', fld1, typ1), Sil.Lfield (e2', fld2, typ2) -> + | Sil.Lfield (e1', fld1, _), Sil.Lfield (e2', fld2, _) -> if Sil.fld_equal fld1 fld2 then normalize_eq (e1', e2') else eq @@ -1132,9 +1132,9 @@ let mk_ptsto lexp sexp te = base for fresh identifiers. If [expand_structs] is true, initialize the fields of structs with fresh variables. *) let mk_ptsto_exp tenvo struct_init_mode (exp, te, expo) inst : Sil.hpred = let default_strexp () = match te with - | Sil.Sizeof (typ, st) -> + | Sil.Sizeof (typ, _) -> create_strexp_of_type tenvo struct_init_mode typ inst - | Sil.Var id -> + | Sil.Var _ -> Sil.Estruct ([], inst) | te -> L.err "trying to create ptsto with type: %a@\n@." (Sil.pp_texp_full pe_text) te; @@ -1161,14 +1161,19 @@ let rec hpred_normalize sub hpred = let normalized_cnt = strexp_normalize sub cnt in let normalized_te = texp_normalize sub te in begin match normalized_cnt, normalized_te with - | Sil.Earray (Sil.Sizeof (t, st1), [], inst), Sil.Sizeof (Sil.Tarray _, st2) -> - (* check for an empty array whose size expression is (Sizeof type), and turn the array into a strexp of the given type *) + | Sil.Earray (Sil.Sizeof (t, st1), [], inst), Sil.Sizeof (Sil.Tarray _, _) -> + (* check for an empty array whose size expression is (Sizeof type), and turn the array + into a strexp of the given type *) let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (t, st1), None) inst in replace_hpred hpred' - | Sil.Earray (Sil.BinOp(Sil.Mult, Sil.Sizeof (t, st1), x), esel, inst), Sil.Sizeof (Sil.Tarray _, st2) - | Sil.Earray (Sil.BinOp(Sil.Mult, x, Sil.Sizeof (t, st1)), esel, inst), Sil.Sizeof (Sil.Tarray _, st2) -> - (* check for an array whose size expression is n * (Sizeof type), and turn the array into a strexp of the given type *) - let hpred' = mk_ptsto_exp None Fld_init (root, Sil.Sizeof (Sil.Tarray(t, x), st1), None) inst in + | Sil.Earray (Sil.BinOp(Sil.Mult, Sil.Sizeof (t, st1), x), esel, inst), + Sil.Sizeof (Sil.Tarray _, _) + | Sil.Earray (Sil.BinOp(Sil.Mult, x, Sil.Sizeof (t, st1)), esel, inst), + Sil.Sizeof (Sil.Tarray _, _) -> + (* check for an array whose size expression is n * (Sizeof type), and turn the array + into a strexp of the given type *) + let hpred' = + mk_ptsto_exp None Fld_init (root, Sil.Sizeof (Sil.Tarray(t, x), st1), None) inst in replace_hpred (replace_array_contents hpred' esel) | _ -> Sil.Hpointsto (normalized_root, normalized_cnt, normalized_te) end @@ -1176,7 +1181,7 @@ let rec hpred_normalize sub hpred = let normalized_e1 = exp_normalize sub e1 in let normalized_e2 = exp_normalize sub e2 in let normalized_elist = IList.map (exp_normalize sub) elist in - let normalized_para = hpara_normalize sub para in + let normalized_para = hpara_normalize para in Sil.Hlseg (k, normalized_para, normalized_e1, normalized_e2, normalized_elist) | Sil.Hdllseg (k, para, e1, e2, e3, e4, elist) -> let norm_e1 = exp_normalize sub e1 in @@ -1184,15 +1189,15 @@ let rec hpred_normalize sub hpred = let norm_e3 = exp_normalize sub e3 in let norm_e4 = exp_normalize sub e4 in let norm_elist = IList.map (exp_normalize sub) elist in - let norm_para = hpara_dll_normalize sub para in + let norm_para = hpara_dll_normalize para in Sil.Hdllseg (k, norm_para, norm_e1, norm_e2, norm_e3, norm_e4, norm_elist) -and hpara_normalize sub para = +and hpara_normalize para = let normalized_body = IList.map (hpred_normalize Sil.sub_empty) (para.Sil.body) in let sorted_body = IList.sort Sil.hpred_compare normalized_body in { para with Sil.body = sorted_body } -and hpara_dll_normalize sub para = +and hpara_dll_normalize para = let normalized_body = IList.map (hpred_normalize Sil.sub_empty) (para.Sil.body_dll) in let sorted_body = IList.sort Sil.hpred_compare normalized_body in { para with Sil.body_dll = sorted_body } @@ -1302,7 +1307,7 @@ let pi_normalize sub sigma pi0 = not (syntactically_different (e1, e2)) | Sil.Aeq(Sil.Const c1, Sil.Const c2) -> not (Sil.const_equal c1 c2) - | a -> true in + | _ -> true in let pi' = IList.stable_sort Sil.atom_compare ((IList.filter filter_useful_atom nonineq_list) @ ineq_list) in let pi'' = pi_sorted_remove_redundant pi' in if pi_equal pi0 pi'' then pi0 else pi'' @@ -1359,7 +1364,7 @@ let lexp_normalize_prop p lexp = (** Collapse consecutive indices that should be added. For instance, this function reduces x[1][1] to x[2]. The [typ] argument is used to ensure the soundness of this collapsing. *) -let exp_collapse_consecutive_indices_prop p typ exp = +let exp_collapse_consecutive_indices_prop typ exp = let typ_is_base = function | Sil.Tint _ | Sil.Tfloat _ | Sil.Tstruct _ | Sil.Tvoid | Sil.Tfun _ -> true | _ -> false in @@ -1457,23 +1462,23 @@ let mk_ptsto_lvar tenv expand_structs inst ((pvar: Sil.pvar), texp, expo) : Sil. (** Sil.Construct a lseg predicate *) let mk_lseg k para e_start e_end es_shared = - let npara = hpara_normalize Sil.sub_empty para in + let npara = hpara_normalize para in Sil.Hlseg (k, npara, e_start, e_end, es_shared) (** Sil.Construct a dllseg predicate *) let mk_dllseg k para exp_iF exp_oB exp_oF exp_iB exps_shared = - let npara = hpara_dll_normalize Sil.sub_empty para in + let npara = hpara_dll_normalize para in Sil.Hdllseg (k, npara, exp_iF, exp_oB , exp_oF, exp_iB, exps_shared) (** Sil.Construct a hpara *) let mk_hpara root next svars evars body = let para = { Sil.root = root; Sil.next = next; Sil.svars = svars; Sil.evars = evars; Sil.body = body } in - hpara_normalize Sil.sub_empty para + hpara_normalize para (** Sil.Construct a dll_hpara *) let mk_dll_hpara iF oB oF svars evars body = let para = { Sil.cell = iF; Sil.blink = oB; Sil.flink = oF; Sil.svars_dll = svars; Sil.evars_dll = evars; Sil.body_dll = body } in - hpara_dll_normalize Sil.sub_empty para + hpara_dll_normalize para (** Proposition [true /\ emp]. *) let prop_emp : normal t = @@ -1536,7 +1541,7 @@ let get_fld_typ_path_opt src_exps snk_exp_ reachable_hpreds_ = | (_, Sil.Eexp (e, _)) -> Sil.exp_equal target_exp e | _ -> false in let extend_path hpred (snk_exp, path, reachable_hpreds) = match hpred with - | Sil.Hpointsto (lhs, Sil.Estruct (flds, inst), Sil.Sizeof (typ, _)) -> + | Sil.Hpointsto (lhs, Sil.Estruct (flds, _), Sil.Sizeof (typ, _)) -> (try let fld, _ = IList.find (fun fld -> strexp_matches snk_exp fld) flds in let reachable_hpreds' = Sil.HpredSet.remove hpred reachable_hpreds in @@ -1838,8 +1843,8 @@ let mark_vars_as_undefined prop vars_to_mark callee_pname loc path_pos = (** Remove an attribute from all the atoms in the heap *) let remove_attribute att prop = let atom_remove atom pi = match atom with - | Sil.Aneq (e, Sil.Const (Sil.Cattribute att_old)) - | Sil.Aneq (Sil.Const (Sil.Cattribute att_old), e) -> + | Sil.Aneq (_, Sil.Const (Sil.Cattribute att_old)) + | Sil.Aneq (Sil.Const (Sil.Cattribute att_old), _) -> if Sil.attribute_equal att_old att then pi else atom:: pi @@ -1862,7 +1867,7 @@ let remove_attribute_from_exp att prop exp = (* Replace an attribute OBJC_NULL($n1) with OBJC_NULL(var) when var = $n1, and also sets $n1 = 0 *) let replace_objc_null prop lhs_exp rhs_exp = match get_objc_null_attribute prop rhs_exp, rhs_exp with - | Some att, Sil.Var var -> + | Some att, Sil.Var _ -> let prop = remove_attribute_from_exp att prop rhs_exp in let prop = conjoin_eq rhs_exp Sil.exp_zero prop in add_or_replace_exp_attribute prop lhs_exp att @@ -1870,12 +1875,12 @@ let replace_objc_null prop lhs_exp rhs_exp = let rec nullify_exp_with_objc_null prop exp = match exp with - | Sil.BinOp (op, exp1, exp2) -> + | Sil.BinOp (_, exp1, exp2) -> let prop' = nullify_exp_with_objc_null prop exp1 in nullify_exp_with_objc_null prop' exp2 - | Sil.UnOp (op, exp, _) -> + | Sil.UnOp (_, exp, _) -> nullify_exp_with_objc_null prop exp - | Sil.Var name -> + | Sil.Var _ -> (match get_objc_null_attribute prop exp with | Some att -> let prop' = remove_attribute_from_exp att prop exp in @@ -2037,10 +2042,10 @@ let sigma_dfs_sort sigma = let final () = ExpStack.final () in let rec handle_strexp = function - | Sil.Eexp (e, inst) -> ExpStack.push e - | Sil.Estruct (fld_se_list, inst) -> + | Sil.Eexp (e, _) -> ExpStack.push e + | Sil.Estruct (fld_se_list, _) -> IList.iter (fun (_, se) -> handle_strexp se) fld_se_list - | Sil.Earray (_, idx_se_list, inst) -> + | Sil.Earray (_, idx_se_list, _) -> IList.iter (fun (_, se) -> handle_strexp se) idx_se_list in let rec handle_e visited seen e = function @@ -2092,10 +2097,10 @@ let prop_fav_add_dfs fav prop = let rec strexp_get_array_indices acc = function | Sil.Eexp _ -> acc - | Sil.Estruct (fsel, inst) -> + | Sil.Estruct (fsel, _) -> let se_list = IList.map snd fsel in IList.fold_left strexp_get_array_indices acc se_list - | Sil.Earray (size, isel, _) -> + | Sil.Earray (_, isel, _) -> let acc_new = IList.fold_left (fun acc' (idx, _) -> idx:: acc') acc isel in let se_list = IList.map snd isel in IList.fold_left strexp_get_array_indices acc_new se_list @@ -2245,7 +2250,7 @@ and typ_captured_ren ren typ = match typ with Sil.Tptr (typ_captured_ren ren t', pk) | Sil.Tarray (t, e) -> Sil.Tarray (typ_captured_ren ren t, exp_captured_ren ren e) - | Sil.Tenum econsts -> + | Sil.Tenum _ -> typ let atom_captured_ren ren = function @@ -2600,7 +2605,7 @@ let prop_iter_make_id_primed id iter = let rec get_eqs acc = function | [] | [_] -> IList.rev acc - | (_, e1) :: (((_, e2) :: pairs') as pairs) -> + | (_, e1) :: (((_, e2) :: _) as pairs) -> get_eqs (Sil.Aeq(e1, e2):: acc) pairs in let sub_new, sub_use, eqs_add = diff --git a/infer/src/backend/prop.mli b/infer/src/backend/prop.mli index db5c15434..54c9bd1b3 100644 --- a/infer/src/backend/prop.mli +++ b/infer/src/backend/prop.mli @@ -176,7 +176,7 @@ val exp_normalize_noabs : Sil.subst -> Sil.exp -> Sil.exp (** Collapse consecutive indices that should be added. For instance, this function reduces x[1][1] to x[2]. The [typ] argument is used to ensure the soundness of this collapsing. *) -val exp_collapse_consecutive_indices_prop : 'a t -> Sil.typ -> Sil.exp -> Sil.exp +val exp_collapse_consecutive_indices_prop : Sil.typ -> Sil.exp -> Sil.exp (** Normalize [exp] used for the address of a heap cell. This normalization does not combine two offsets inside [exp]. *) diff --git a/infer/src/backend/propgraph.ml b/infer/src/backend/propgraph.ml index 933ccb9ad..64e3d3848 100644 --- a/infer/src/backend/propgraph.ml +++ b/infer/src/backend/propgraph.ml @@ -31,7 +31,7 @@ let rec is_root = function | Sil.UnOp _ | Sil.BinOp _ | Sil.Lfield _ | Sil.Lindex _ | Sil.Sizeof _ -> false (** Return [true] if the nodes are connected. Used to compute reachability. *) -let nodes_connected g n1 n2 = +let nodes_connected n1 n2 = Sil.exp_equal n1 n2 (* Implemented as equality for now, later it might contain offset by a constant *) (** Return [true] if the edge is an hpred, and [false] if it is an atom *) @@ -44,17 +44,17 @@ let edge_is_hpred = function let edge_get_source = function | Ehpred (Sil.Hpointsto(e, _, _)) -> e | Ehpred (Sil.Hlseg(_, _, e, _, _)) -> e - | Ehpred (Sil.Hdllseg(_, _, e1, _, _, e2, _)) -> e1 (* :: e2 only one direction supported for now *) + | Ehpred (Sil.Hdllseg(_, _, e1, _, _, _, _)) -> e1 (* only one direction supported for now *) | Eatom (Sil.Aeq (e1, _)) -> e1 | Eatom (Sil.Aneq (e1, _)) -> e1 - | Esub_entry (x, e) -> Sil.Var x + | Esub_entry (x, _) -> Sil.Var x (** Return the successor nodes of the edge *) let edge_get_succs = function | Ehpred hpred -> Sil.ExpSet.elements (Prop.hpred_get_targets hpred) | Eatom (Sil.Aeq (_, e2)) -> [e2] | Eatom (Sil.Aneq (_, e2)) -> [e2] - | Esub_entry (s, e) -> [e] + | Esub_entry (_, e) -> [e] let get_sigma footprint_part g = if footprint_part then Prop.get_sigma_footprint g else Prop.get_sigma g @@ -120,7 +120,7 @@ let compute_exp_diff (e1: Sil.exp) (e2: Sil.exp) : Obj.t list = (** Compute the subobjects in [se2] which are different from those in [se1] *) let rec compute_sexp_diff (se1: Sil.strexp) (se2: Sil.strexp) : Obj.t list = match se1, se2 with - | Sil.Eexp (e1, inst1), Sil.Eexp (e2, inst2) -> if Sil.exp_equal e1 e2 then [] else [Obj.repr se2] + | Sil.Eexp (e1, _), Sil.Eexp (e2, _) -> if Sil.exp_equal e1 e2 then [] else [Obj.repr se2] | Sil.Estruct (fsel1, _), Sil.Estruct (fsel2, _) -> compute_fsel_diff fsel1 fsel2 | Sil.Earray (e1, esel1, _), Sil.Earray (e2, esel2, _) -> diff --git a/infer/src/backend/propgraph.mli b/infer/src/backend/propgraph.mli index f4c4abc72..632d97d1a 100644 --- a/infer/src/backend/propgraph.mli +++ b/infer/src/backend/propgraph.mli @@ -23,7 +23,7 @@ val from_prop : Prop.normal Prop.t -> t val is_root : node -> bool (** Return [true] if the nodes are connected. Used to compute reachability. *) -val nodes_connected : t -> node -> node -> bool +val nodes_connected : node -> node -> bool (** Return the source of the edge *) val edge_get_source : edge -> node diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 807b28024..b26d03166 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -546,7 +546,7 @@ let is_root prop base_exp exp = if check_equal prop base_exp e then Some offlist_past else None - | Sil.Cast(t, sub_exp) -> f offlist_past sub_exp + | Sil.Cast(_, sub_exp) -> f offlist_past sub_exp | Sil.Lfield(sub_exp, fldname, typ) -> f (Sil.Off_fld (fldname, typ) :: offlist_past) sub_exp | Sil.Lindex(sub_exp, e) -> f (Sil.Off_index e :: offlist_past) sub_exp in f [] exp @@ -623,14 +623,14 @@ let check_disequal prop e1 e2 = else let sigma_rest' = (IList.rev sigma_irrelevant) @ sigma_rest in f [] e2 sigma_rest') - | Sil.Hdllseg (Sil.Lseg_NE, _, iF, oB, oF, iB, _) :: sigma_rest -> + | Sil.Hdllseg (Sil.Lseg_NE, _, iF, _, _, iB, _) :: sigma_rest -> if is_root prop iF e != None || is_root prop iB e != None then let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (true, sigma_irrelevant') else let sigma_irrelevant' = (IList.rev sigma_irrelevant) @ sigma_rest in Some (false, sigma_irrelevant') - | Sil.Hdllseg (Sil.Lseg_PE, _, iF, oB, oF, iB, _) as hpred :: sigma_rest -> + | Sil.Hdllseg (Sil.Lseg_PE, _, iF, _, oF, _, _) as hpred :: sigma_rest -> (match is_root prop iF e with | None -> let sigma_irrelevant' = hpred :: sigma_irrelevant @@ -777,10 +777,11 @@ let check_inconsistency_two_hpreds prop = let e_new = Prop.exp_normalize_prop prop_new e in f e_new [] sigma_new else f e (hpred:: sigma_seen) sigma_rest - | Sil.Hdllseg (Sil.Lseg_PE, _, e1, e2, Sil.Const (Sil.Cint i), _, _) as hpred :: sigma_rest when Sil.Int.iszero i -> + | Sil.Hdllseg (Sil.Lseg_PE, _, e1, _, Sil.Const (Sil.Cint i), _, _) as hpred :: sigma_rest + when Sil.Int.iszero i -> if Sil.exp_equal e1 e then true else f e (hpred:: sigma_seen) sigma_rest - | Sil.Hdllseg (Sil.Lseg_PE, _, e1, e2, e3, e4, _) as hpred :: sigma_rest -> + | Sil.Hdllseg (Sil.Lseg_PE, _, e1, _, e3, _, _) as hpred :: sigma_rest -> if Sil.exp_equal e1 e then let prop' = Prop.normalize (Prop.from_sigma (sigma_seen@sigma_rest)) in @@ -1125,7 +1126,7 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = | e1, Sil.BinOp (Sil.PlusA, Sil.Var v2, e2) | e1, Sil.BinOp (Sil.PlusA, e2, Sil.Var v2) when Ident.is_primed v2 || Ident.is_footprint v2 -> do_imply subs (Sil.BinOp (Sil.MinusA, e1, e2)) (Sil.Var v2) - | Sil.Var v1, e2 -> + | Sil.Var _, e2 -> if calc_missing then let () = ProverState.add_missing_pi (Sil.Aeq (e1_in, e2_in)) in subs @@ -1141,7 +1142,7 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = | Sil.Const c1, Sil.Const c2 -> if (Sil.const_equal c1 c2) then subs else raise (IMPL_EXC ("constants not equal", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Const (Sil.Cint n1), Sil.BinOp (Sil.PlusPI, _, _) -> + | Sil.Const (Sil.Cint _), Sil.BinOp (Sil.PlusPI, _, _) -> raise (IMPL_EXC ("pointer+index cannot evaluate to a constant", subs, (EXC_FALSE_EXPS (e1, e2)))) | Sil.Const (Sil.Cint n1), Sil.BinOp (Sil.PlusA, f1, Sil.Const (Sil.Cint n2)) -> do_imply subs (Sil.exp_int (n1 -- n2)) f1 @@ -1153,7 +1154,7 @@ let exp_imply calc_missing subs e1_in e2_in : subst2 = do_imply subs (Sil.Lvar pv1) (Sil.BinOp (Sil.MinusA, e2, e1)) | e1, Sil.Const _ -> raise (IMPL_EXC ("lhs not constant", subs, (EXC_FALSE_EXPS (e1, e2)))) - | Sil.Lfield(e1, fd1, t1), Sil.Lfield(e2, fd2, t2) when fd1 == fd2 -> + | Sil.Lfield(e1, fd1, _), Sil.Lfield(e2, fd2, _) when fd1 == fd2 -> do_imply subs e1 e2 | Sil.Lindex(e1, f1), Sil.Lindex(e2, f2) -> do_imply (do_imply subs e1 e2) f1 f2 @@ -1171,7 +1172,7 @@ let path_to_id path = | Sil.Var id -> if Ident.is_footprint id then None else Some (Ident.name_to_string (Ident.get_name id) ^ (string_of_int (Ident.get_stamp id))) - | Sil.Lfield (e, fld, t) -> + | Sil.Lfield (e, fld, _) -> (match f e with | None -> None | Some s -> Some (s ^ "_" ^ (Ident.fieldname_to_string fld))) @@ -1179,7 +1180,7 @@ let path_to_id path = (match f e with | None -> None | Some s -> Some (s ^ "_" ^ (Sil.exp_to_string ind))) - | Sil.Lvar pv -> + | Sil.Lvar _ -> Some (Sil.exp_to_string path) | Sil.Const (Sil.Cstr s) -> Some ("_const_str_" ^ s) @@ -1214,14 +1215,14 @@ let array_size_imply calc_missing subs size1 size2 indices2 = let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subst2 * (Sil.strexp option) * (Sil.strexp option) = (* L.d_str "sexp_imply "; Sil.d_sexp se1; L.d_str " "; Sil.d_sexp se2; L.d_str " : "; Sil.d_typ_full typ2; L.d_ln(); *) match se1, se2 with - | Sil.Eexp (e1, inst1), Sil.Eexp (e2, inst2) -> + | Sil.Eexp (e1, _), Sil.Eexp (e2, _) -> (exp_imply calc_missing subs e1 e2, None, None) | Sil.Estruct (fsel1, inst1), Sil.Estruct (fsel2, _) -> let subs', fld_frame, fld_missing = struct_imply source calc_missing subs fsel1 fsel2 typ2 in let fld_frame_opt = if fld_frame != [] then Some (Sil.Estruct (fld_frame, inst1)) else None in let fld_missing_opt = if fld_missing != [] then Some (Sil.Estruct (fld_missing, inst1)) else None in subs', fld_frame_opt, fld_missing_opt - | Sil.Estruct _, Sil.Eexp (e2, inst2) -> + | Sil.Estruct _, Sil.Eexp (e2, _) -> begin let e2' = Sil.exp_sub (snd subs) e2 in match e2' with @@ -1246,14 +1247,14 @@ let rec sexp_imply source calc_index_frame calc_missing subs se1 se2 typ2 : subs | Sil.Eexp (_, inst), Sil.Estruct (fsel, inst') -> d_impl_err ("WARNING: function call with parameters of struct type, treating as unknown", subs, (EXC_FALSE_SEXPS (se1, se2))); let fsel' = - let g (f, se) = (f, Sil.Eexp (Sil.Var (Ident.create_fresh Ident.knormal), inst)) in + let g (f, _) = (f, Sil.Eexp (Sil.Var (Ident.create_fresh Ident.knormal), inst)) in IList.map g fsel in sexp_imply source calc_index_frame calc_missing subs (Sil.Estruct (fsel', inst')) se2 typ2 - | Sil.Eexp _, Sil.Earray (size, esel, inst) - | Sil.Estruct _, Sil.Earray (size, esel, inst) -> + | Sil.Eexp _, Sil.Earray (size, _, inst) + | Sil.Estruct _, Sil.Earray (size, _, inst) -> let se1' = Sil.Earray (size, [(Sil.exp_zero, se1)], inst) in sexp_imply source calc_index_frame calc_missing subs se1' se2 typ2 - | Sil.Earray (size, _, _), Sil.Eexp (e, inst) -> + | Sil.Earray (size, _, _), Sil.Eexp (_, inst) -> let se2' = Sil.Earray (size, [(Sil.exp_zero, se2)], inst) in let typ2' = Sil.Tarray (typ2, size) in sexp_imply source true calc_missing subs se1 se2' typ2' (* calculate index_frame because the rhs is a singleton array *) @@ -1317,7 +1318,7 @@ and array_imply source calc_index_frame calc_missing subs esel1 esel2 typ2 and sexp_imply_nolhs source calc_missing subs se2 typ2 = match se2 with - | Sil.Eexp (_e2, inst) -> + | Sil.Eexp (_e2, _) -> let e2 = Sil.exp_sub (snd subs) _e2 in begin match e2 with @@ -1337,9 +1338,9 @@ and sexp_imply_nolhs source calc_missing subs se2 typ2 = raise (IMPL_EXC ("exp only in rhs is not a primed var", subs, EXC_FALSE)) end | Sil.Estruct (fsel2, _) -> - (fun (x, y, z) -> x) (struct_imply source calc_missing subs [] fsel2 typ2) + (fun (x, _, _) -> x) (struct_imply source calc_missing subs [] fsel2 typ2) | Sil.Earray (_, esel2, _) -> - (fun (x, y, z) -> x) (array_imply source false calc_missing subs [] esel2 typ2) + (fun (x, _, _) -> x) (array_imply source false calc_missing subs [] esel2 typ2) let rec exp_list_imply calc_missing subs l1 l2 = match l1, l2 with | [],[] -> subs @@ -1357,11 +1358,11 @@ let filter_ne_lhs sub e0 = function | _ -> None let filter_hpred sub hpred2 hpred1 = match (Sil.hpred_sub sub hpred1), hpred2 with - | Sil.Hlseg(Sil.Lseg_NE, hpara1, e1, f1, el1), Sil.Hlseg(Sil.Lseg_PE, hpara2, e2, f2, el2) -> + | Sil.Hlseg(Sil.Lseg_NE, hpara1, e1, f1, el1), Sil.Hlseg(Sil.Lseg_PE, _, _, _, _) -> if Sil.hpred_equal (Sil.Hlseg(Sil.Lseg_PE, hpara1, e1, f1, el1)) hpred2 then Some false else None - | Sil.Hlseg(Sil.Lseg_PE, hpara1, e1, f1, el1), Sil.Hlseg(Sil.Lseg_NE, hpara2, e2, f2, el2) -> + | Sil.Hlseg(Sil.Lseg_PE, hpara1, e1, f1, el1), Sil.Hlseg(Sil.Lseg_NE, _, _, _, _) -> if Sil.hpred_equal (Sil.Hlseg(Sil.Lseg_NE, hpara1, e1, f1, el1)) hpred2 then Some true else None (* return missing disequality *) - | Sil.Hpointsto(e1, se1, te1), Sil.Hlseg(k, hpara2, e2, f2, el2) -> + | Sil.Hpointsto(e1, _, _), Sil.Hlseg(_, _, e2, _, _) -> if Sil.exp_equal e1 e2 then Some false else None | hpred1, hpred2 -> if Sil.hpred_equal hpred1 hpred2 then Some false else None @@ -1371,7 +1372,7 @@ let hpred_has_primed_lhs sub hpred = find_primed e | Sil.Lindex (e, _) -> find_primed e - | Sil.BinOp (Sil.PlusPI, e1, e2) -> + | Sil.BinOp (Sil.PlusPI, e1, _) -> find_primed e1 | _ -> Sil.fav_exists (Sil.exp_fav e) Ident.is_primed in @@ -1381,12 +1382,12 @@ let hpred_has_primed_lhs sub hpred = exp_has_primed e | Sil.Hlseg (_, _, e, _, _) -> exp_has_primed e - | Sil.Hdllseg (_, _, iF, oB, oF, iB, _) -> + | Sil.Hdllseg (_, _, iF, _, _, iB, _) -> exp_has_primed iF && exp_has_primed iB let move_primed_lhs_from_front subs sigma = match sigma with | [] -> sigma - | hpred:: sigma' -> + | hpred:: _ -> if hpred_has_primed_lhs (snd subs) hpred then let (sigma_primed, sigma_unprimed) = IList.partition (hpred_has_primed_lhs (snd subs)) sigma in match sigma_unprimed with @@ -1583,7 +1584,7 @@ end let cast_exception tenv texp1 texp2 e1 subs = let _ = match texp1, texp2 with - | Sil.Sizeof (t1, st1), Sil.Sizeof (t2, st2) -> + | Sil.Sizeof (t1, _), Sil.Sizeof (t2, st2) -> if !Config.developer_mode || (Sil.Subtype.is_cast st2 && not (Subtyping_check.check_subtype tenv t1 t2)) then @@ -1642,7 +1643,7 @@ let texp_imply tenv subs texp1 texp2 e1 calc_missing = begin match pos_type_opt with | None -> cast_exception tenv texp1 texp2 e1 subs - | Some texp1' -> + | Some _ -> if has_changed then None, pos_type_opt (* missing *) else pos_type_opt, None (* frame *) end @@ -1661,7 +1662,7 @@ let texp_imply tenv subs texp1 texp2 e1 calc_missing = (** pre-process implication between a non-array and an array: the non-array is turned into an array of size given by its type only active in type_size mode *) let sexp_imply_preprocess se1 texp1 se2 = match se1, texp1, se2 with - | Sil.Eexp (e1, inst), Sil.Sizeof _, Sil.Earray _ when !Config.type_size -> + | Sil.Eexp (_, inst), Sil.Sizeof _, Sil.Earray _ when !Config.type_size -> let se1' = Sil.Earray (texp1, [(Sil.exp_zero, se1)], inst) in L.d_strln_color Orange "sexp_imply_preprocess"; L.d_str " se1: "; Sil.d_sexp se1; L.d_ln (); L.d_str " se1': "; Sil.d_sexp se1'; L.d_ln (); se1' @@ -1687,7 +1688,9 @@ let handle_parameter_subtype tenv prop1 sigma2 subs (e1, se1, texp1) (se2, texp2 | _ -> false in if IList.exists filter sigma2 then !sub_opt else None in let add_subtype () = match texp1, texp2, se1, se2 with - | Sil.Sizeof(Sil.Tptr (_t1, _), _), Sil.Sizeof(Sil.Tptr (_t2, _), sub2), Sil.Eexp(e1', _), Sil.Eexp(e2', _) when not (is_allocated_lhs e1') -> + | Sil.Sizeof(Sil.Tptr (_t1, _), _), Sil.Sizeof(Sil.Tptr (_t2, _), _), + Sil.Eexp(e1', _), Sil.Eexp(e2', _) + when not (is_allocated_lhs e1') -> begin let t1, t2 = Sil.expand_type tenv _t1, Sil.expand_type tenv _t2 in match type_rhs e2' with @@ -1712,7 +1715,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hpointsto (_e2, se2, texp2) -> let e2 = Sil.exp_sub (snd subs) _e2 in let _ = match e2 with - | Sil.Lvar p -> () + | Sil.Lvar _ -> () | Sil.Var v -> if Ident.is_primed v then (d_impl_err ("rhs |-> not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) @@ -1753,7 +1756,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 let prop1' = Prop.prop_iter_remove_curr_then_to_prop iter1' in (subs', prop1') with - | IMPL_EXC (s, _, body) when calc_missing -> + | IMPL_EXC (s, _, _) when calc_missing -> raise (MISSING_EXC s)) | Sil.Hlseg (Sil.Lseg_NE, para1, e1, f1, elist1), _ -> (** Unroll lseg *) let n' = Sil.Var (Ident.create_fresh Ident.kprimed) in @@ -1797,7 +1800,7 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hlseg (k, para2, _e2, _f2, _elist2) -> (* for now ignore implications between PE and NE *) let e2, f2 = Sil.exp_sub (snd subs) _e2, Sil.exp_sub (snd subs) _f2 in let _ = match e2 with - | Sil.Lvar p -> () + | Sil.Lvar _ -> () | Sil.Var v -> if Ident.is_primed v then (d_impl_err ("rhs |-> not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) @@ -1852,18 +1855,19 @@ let rec hpred_imply tenv calc_index_frame calc_missing subs prop1 sigma2 hpred2 | Sil.Hdllseg (Sil.Lseg_PE, _, _, _, _, _, _) -> (d_impl_err ("rhs dllsegPE not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) - | Sil.Hdllseg (k, para2, iF2, oB2, oF2, iB2, elist2) -> (* for now ignore implications between PE and NE *) + | Sil.Hdllseg (_, para2, iF2, oB2, oF2, iB2, elist2) -> + (* for now ignore implications between PE and NE *) let iF2, oF2 = Sil.exp_sub (snd subs) iF2, Sil.exp_sub (snd subs) oF2 in let iB2, oB2 = Sil.exp_sub (snd subs) iB2, Sil.exp_sub (snd subs) oB2 in let _ = match oF2 with - | Sil.Lvar p -> () + | Sil.Lvar _ -> () | Sil.Var v -> if Ident.is_primed v then (d_impl_err ("rhs dllseg not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) | _ -> () in let _ = match oB2 with - | Sil.Lvar p -> () + | Sil.Lvar _ -> () | Sil.Var v -> if Ident.is_primed v then (d_impl_err ("rhs dllseg not implemented", subs, (EXC_FALSE_HPRED hpred2)); raise (Exceptions.Abduction_case_not_implemented __POS__)) @@ -2002,7 +2006,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * ProverState.add_missing_sigma sigma2; subs, prop1 -let prepare_prop_for_implication (sub1, sub2) pi1 sigma1 = +let prepare_prop_for_implication (_, sub2) pi1 sigma1 = let pi1' = (Prop.pi_sub sub2 (ProverState.get_missing_pi ())) @ pi1 in let sigma1' = (Prop.sigma_sub sub2 (ProverState.get_missing_sigma ())) @ sigma1 in let ep = Prop.replace_sub sub2 (Prop.replace_sigma sigma1' (Prop.from_pi pi1')) in @@ -2044,19 +2048,19 @@ let rec pre_check_pure_implication calc_missing subs pi1 pi2 = (* The commented-out condition should always hold. *) let sub2' = extend_sub (snd subs) v2 e2 in pre_check_pure_implication calc_missing (fst subs, sub2') pi1 pi2' - | e2, f2 -> + | _ -> let pi1' = Prop.pi_sub (fst subs) pi1 in let prop_for_impl = prepare_prop_for_implication subs pi1' [] in imply_atom calc_missing subs prop_for_impl (Sil.Aeq (e2_in, f2_in)); pre_check_pure_implication calc_missing subs pi1 pi2' ) - | Sil.Aeq (e1, e2) :: pi2' -> (* must be an inequality *) + | Sil.Aeq _ :: pi2' -> (* must be an inequality *) pre_check_pure_implication calc_missing subs pi1 pi2' - | Sil.Aneq (Sil.Var v, f2):: pi2' -> + | Sil.Aneq (Sil.Var v, _):: pi2' -> if not (Ident.is_primed v || calc_missing) then raise (IMPL_EXC("ineq e2=f2 in rhs with e2 not primed var", (Sil.sub_empty, Sil.sub_empty), EXC_FALSE)) else pre_check_pure_implication calc_missing subs pi1 pi2' - | Sil.Aneq (e1, e2):: pi2' -> + | Sil.Aneq _ :: pi2' -> if calc_missing then pre_check_pure_implication calc_missing subs pi1 pi2' else raise (IMPL_EXC ("ineq e2=f2 in rhs with e2 not primed var", (Sil.sub_empty, Sil.sub_empty), EXC_FALSE)) diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 60531b4c8..d6f091df8 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -30,7 +30,7 @@ let rec list_rev_and_concat l1 l2 = If the index is provably out of bound, a bound error is given. If the size is a constant and the index is not provably in bound, a warning is given. *) -let check_bad_index pname tenv p size index loc = +let check_bad_index pname p size index loc = let size_is_constant = match size with | Sil.Const _ -> true | _ -> false in @@ -73,14 +73,14 @@ let check_bad_index pname tenv p size index loc = end (** Perform bounds checking *) -let bounds_check pname tenv prop size e = +let bounds_check pname prop size e = if !Config.trace_rearrange then begin L.d_str "Bounds check index:"; Sil.d_exp e; L.d_str " size: "; Sil.d_exp size; L.d_ln() end; - check_bad_index pname tenv prop size e + check_bad_index pname prop size e let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp t (off: Sil.offset list) inst : Sil.atom list * Sil.strexp * Sil.typ = @@ -126,7 +126,7 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp | Sil.Tarray(_, size),[] -> ([], Sil.Earray(size, [], inst), t) | Sil.Tarray(t', size'), (Sil.Off_index e) :: off' -> - bounds_check pname tenv orig_prop size' e (State.get_loc ()); + bounds_check pname orig_prop size' e (State.get_loc ()); let atoms', se', res_t' = create_struct_values @@ -191,7 +191,7 @@ let rec _strexp_extend_values let off_new = Sil.Off_index(Sil.exp_zero):: off in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst - | (Sil.Off_fld (f, _)):: _, Sil.Earray _, Sil.Tarray _ -> + | (Sil.Off_fld _):: _, Sil.Earray _, Sil.Tarray _ -> let off_new = Sil.Off_index(Sil.exp_zero):: off in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst @@ -200,7 +200,7 @@ let rec _strexp_extend_values let replace_fv new_v fv = if Ident.fieldname_equal (fst fv) f then (f, new_v) else fv in let _, typ', _ = try - IList.find (fun (f', t', a') -> Ident.fieldname_equal f f') + IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') (instance_fields @ static_fields) with Not_found -> raise (Exceptions.Missing_fld (f, __POS__)) in @@ -231,7 +231,7 @@ let rec _strexp_extend_values let struct_typ = Sil.Tstruct { struct_typ with Sil.instance_fields = instance_fields' } in [(atoms', Sil.Estruct (res_fsel', inst'), struct_typ)] end - | (Sil.Off_fld (f, _)):: off', _, _ -> + | (Sil.Off_fld (_, _)):: _, _, _ -> raise (Exceptions.Bad_footprint __POS__) | (Sil.Off_index _):: _, Sil.Eexp _, Sil.Tint _ @@ -252,7 +252,7 @@ let rec _strexp_extend_values _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se_new typ_new off inst | (Sil.Off_index e):: off', Sil.Earray(size, esel, inst_arr), Sil.Tarray(typ', size_for_typ') -> - bounds_check pname tenv orig_prop size e (State.get_loc ()); + bounds_check pname orig_prop size e (State.get_loc ()); begin try let _, se' = IList.find (fun (e', _) -> Sil.exp_equal e e') esel in @@ -447,7 +447,7 @@ let mk_ptsto_exp_footprint If it exists, return None. Otherwise, return [Some fld] with [fld] the missing field. *) let prop_iter_check_fields_ptsto_shallow iter lexp = let offset = Sil.exp_get_offsets lexp in - let (e, se, t) = + let (_, se, _) = match Prop.prop_iter_current iter with | Sil.Hpointsto (e, se, t), _ -> (e, se, t) | _ -> assert false in @@ -461,7 +461,7 @@ let prop_iter_check_fields_ptsto_shallow iter lexp = check_offset se' off' with Not_found -> Some fld) | _ -> Some fld) - | (Sil.Off_index e):: off' -> None in + | (Sil.Off_index _):: _ -> None in check_offset se offset let fav_max_stamp fav = @@ -528,8 +528,9 @@ let prop_iter_extend_ptsto pname tenv orig_prop iter lexp inst = let sigma_pto, sigma_rest = IList.partition (function | Sil.Hpointsto(e', _, _) -> Sil.exp_equal e e' - | Sil.Hlseg (_, _, e1, e2, _) -> Sil.exp_equal e e1 - | Sil.Hdllseg (_, _, e_iF, e_oB, e_oF, e_iB, _) -> Sil.exp_equal e e_iF || Sil.exp_equal e e_iB + | Sil.Hlseg (_, _, e1, _, _) -> Sil.exp_equal e e1 + | Sil.Hdllseg (_, _, e_iF, _, _, e_iB, _) -> + Sil.exp_equal e e_iF || Sil.exp_equal e e_iB ) footprint_sigma in let atoms_sigma_list = match sigma_pto with @@ -797,8 +798,8 @@ let type_at_offset texp off = | (Sil.Off_fld (f, _)):: off', Sil.Tstruct { Sil.instance_fields } -> (try let typ' = - (fun (x, y, z) -> y) - (IList.find (fun (f', t', a') -> Ident.fieldname_equal f f') instance_fields) in + (fun (_, y, _) -> y) + (IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') instance_fields) in strip_offset off' typ' with Not_found -> None) | (Sil.Off_index _):: off', Sil.Tarray (typ', _) -> @@ -947,7 +948,7 @@ let check_dereference_error pdesc (prop : Prop.normal Prop.t) lexp loc = nullable_obj_str := Some (Sil.pvar_to_string pvar); (* it's ok for a non-nullable local to point to deref_exp *) is_nullable || Sil.pvar_is_local pvar - | Sil.Hpointsto (_, Sil.Estruct (flds, inst), Sil.Sizeof (typ, _)) -> + | Sil.Hpointsto (_, Sil.Estruct (flds, _), Sil.Sizeof (typ, _)) -> let fld_is_nullable fld = match Annotations.get_field_type_and_annotation fld typ with | Some (_, annot) -> Annotations.ia_is_nullable annot diff --git a/infer/src/backend/serialization.ml b/infer/src/backend/serialization.ml index 8edd6809c..223441c60 100644 --- a/infer/src/backend/serialization.ml +++ b/infer/src/backend/serialization.ml @@ -56,7 +56,7 @@ let create_serializer (key : key) : 'a serializer = let from_string (str : string) : 'a option = try match_data (Marshal.from_string str 0) "string" - with Sys_error s -> None in + with Sys_error _ -> None in let from_file (_fname : DB.filename) : 'a option = let read () = try @@ -66,7 +66,7 @@ let create_serializer (key : key) : 'a serializer = close_in inc; value_option with - | Sys_error s -> None in + | Sys_error _ -> None in let timeout = 1.0 in let catch_exn = function | End_of_file -> true diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index 1a8199cd6..115c7c9b1 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -67,7 +67,7 @@ let pp_annotation fmt annotation = F.fprintf fmt "@@%s" annotation.class_name (** Pretty print an item annotation. *) let pp_item_annotation fmt item_annotation = - let pp fmt (a, v) = pp_annotation fmt a in + let pp fmt (a, _) = pp_annotation fmt a in F.fprintf fmt "<%a>" (pp_seq pp) item_annotation let item_annotation_to_string ann = @@ -80,12 +80,9 @@ let pp_method_annotation s fmt (ia, ial) = (** Return the value of the FA_sentinel attribute in [attr_list] if it is found *) let get_sentinel_func_attribute_value attr_list = - (* Sentinel is the only kind of attributes *) - let is_sentinel a = true in - try - match IList.find is_sentinel attr_list with - | FA_sentinel (sentinel, null_pos) -> Some (sentinel, null_pos) - with Not_found -> None + match attr_list with + | FA_sentinel (sentinel, null_pos) :: _ -> Some (sentinel, null_pos) + | [] -> None (** Kind of global variables *) type pvar_kind = @@ -306,7 +303,7 @@ module Subtype = struct let compare t1 t2 = pair_compare compare_subt compare_flag t1 t2 - let equal_modulo_flag (st1, flag1) (st2, flag2) = + let equal_modulo_flag (st1, _) (st2, _) = compare_subt st1 st2 = 0 let update_flag c1 c2 flag flag' = @@ -409,16 +406,16 @@ module Subtype = struct else (None, Some st1) in (normalize_subtypes pos_st c1 c2 flag1 flag2), (normalize_subtypes neg_st c1 c2 flag1 flag2) - let case_analysis_basic (c1, st) (c2, (st2, flag2)) f = + let case_analysis_basic (c1, st) (c2, (_, flag2)) f = let (pos_st, neg_st) = if f c1 c2 then (Some st, None) else if f c2 c1 then match st with - | Exact, flag -> + | Exact, _ -> if Typename.equal c1 c2 then (Some st, None) else (None, Some st) - | Subtypes _ , flag -> + | Subtypes _ , _ -> if Typename.equal c1 c2 then (Some st, None) else (Some st, Some st) @@ -490,11 +487,11 @@ end = struct if area unsigned i = 3 then None (* not representable as signed *) else Some (false, i, ptr) - let compare (unsigned1, i1, ptr1) (unsigned2, i2, ptr2) = + let compare (unsigned1, i1, _) (unsigned2, i2, _) = let n = bool_compare unsigned1 unsigned2 in if n <> 0 then n else Int64.compare i1 i2 - let compare_value (unsigned1, i1, ptr1) (unsigned2, i2, ptr2) = + let compare_value (unsigned1, i1, _) (unsigned2, i2, _) = let area1 = area unsigned1 i1 in let area2 = area unsigned2 i2 in let n = int_compare area1 area2 in @@ -511,18 +508,18 @@ end = struct let of_int32 i = of_int64 (Int64.of_int32 i) let of_int64_unsigned i unsigned = (unsigned, i, false) let of_int i = of_int64 (Int64.of_int i) - let to_int (large, i, ptr) = Int64.to_int i + let to_int (_, i, _) = Int64.to_int i let null = (false, 0L, true) let zero = of_int 0 let one = of_int 1 let two = of_int 2 let minus_one = of_int (-1) - let isone (_, i, ptr) = i = 1L - let iszero (_, i, ptr) = i = 0L + let isone (_, i, _) = i = 1L + let iszero (_, i, _) = i = 0L let isnull (_, i, ptr) = i = 0L && ptr - let isminusone (unsigned, i, ptr) = not unsigned && i = -1L - let isnegative (unsigned, i, ptr) = not unsigned && i < 0L + let isminusone (unsigned, i, _) = not unsigned && i = -1L + let isnegative (unsigned, i, _) = not unsigned && i < 0L let neg (unsigned, i, ptr) = (unsigned, Int64.neg i, ptr) @@ -834,7 +831,7 @@ let objc_ref_counter_field = (** {2 Comparision and Inspection Functions} *) -let is_objc_ref_counter_field (fld, t, a) = +let is_objc_ref_counter_field (fld, _, a) = Ident.fieldname_is_hidden fld && (item_annotation_compare a objc_ref_counter_annot = 0) let has_objc_ref_counter hpred = @@ -886,7 +883,7 @@ let pvar_get_simplified_name pv = match string_split_character s '.' with | Some s1, s2 -> (match string_split_character s1 '.' with - | Some s3, s4 -> s4 ^ "." ^ s2 + | Some _, s4 -> s4 ^ "." ^ s2 | _ -> s) | _ -> s @@ -937,7 +934,7 @@ let mk_static_local_name pname vname = let is_static_local_name pname pvar = (* local static name is of the form procname_varname *) let var_name = Mangled.to_string(pvar_get_name pvar) in match Str.split_delim (Str.regexp_string pname) var_name with - | [s1; s2] -> true + | [_; _] -> true | _ -> false let rec pv_kind_compare k1 k2 = match k1, k2 with @@ -1511,13 +1508,13 @@ let lseg_kind_equal k1 k2 = let rec strexp_compare se1 se2 = if se1 == se2 then 0 else match se1, se2 with - | Eexp (e1, inst1), Eexp (e2, inst2) -> exp_compare e1 e2 + | Eexp (e1, _), Eexp (e2, _) -> exp_compare e1 e2 | Eexp _, _ -> - 1 | _, Eexp _ -> 1 - | Estruct (fel1, inst1), Estruct (fel2, inst2) -> fld_strexp_list_compare fel1 fel2 + | Estruct (fel1, _), Estruct (fel2, _) -> fld_strexp_list_compare fel1 fel2 | Estruct _, _ -> - 1 | _, Estruct _ -> 1 - | Earray (e1, esel1, inst1), Earray (e2, esel2, inst2) -> + | Earray (e1, esel1, _), Earray (e2, esel2, _) -> let n = exp_compare e1 e2 in if n <> 0 then n else exp_strexp_list_compare esel1 esel2 @@ -1683,11 +1680,11 @@ let pp_seq_diff pp pe0 f = let rec doit = function | [] -> () | [x] -> - let pe, changed = color_pre_wrapper pe0 f x in + let _, changed = color_pre_wrapper pe0 f x in F.fprintf f "%a" pp x; color_post_wrapper changed pe0 f | x :: l -> - let pe, changed = color_pre_wrapper pe0 f x in + let _, changed = color_pre_wrapper pe0 f x in F.fprintf f "%a" pp x; color_post_wrapper changed pe0 f; F.fprintf f ", "; @@ -1769,15 +1766,15 @@ let rec _pp_pvar f pv = let pp_pvar_latex f pv = let name = pv.pv_name in match pv.pv_kind with - | Local_var n -> + | Local_var _ -> Latex.pp_string Latex.Roman f (Mangled.to_string name) - | Callee_var n -> + | Callee_var _ -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name) (Latex.pp_string Latex.Roman) "callee" - | Abducted_retvar (n, l) -> + | Abducted_retvar _ -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name) (Latex.pp_string Latex.Roman) "abductedRetvar" - | Abducted_ref_param (n, pv, l) -> + | Abducted_ref_param _ -> F.fprintf f "%a_{%a}" (Latex.pp_string Latex.Roman) (Mangled.to_string name) (Latex.pp_string Latex.Roman) "abductedRefParam" | Global_var -> @@ -1852,7 +1849,7 @@ let rec dexp_to_string = function Procname.to_simplified_string pn | Dconst c -> exp_to_string (Const c) | Dderef de -> "*" ^ dexp_to_string de - | Dfcall (fun_dexp, args, loc, { cf_virtual = isvirtual }) -> + | Dfcall (fun_dexp, args, _, { cf_virtual = isvirtual }) -> let pp_arg fmt de = F.fprintf fmt "%s" (dexp_to_string de) in let pp_args fmt des = if eradicate_java () @@ -1882,7 +1879,7 @@ let rec dexp_to_string = function if Ident.fieldname_is_hidden f then dexp_to_string de else if java() then dexp_to_string de ^ "." ^ Ident.fieldname_to_flat_string f else dexp_to_string de ^ "->" ^ Ident.fieldname_to_string f - | Ddot (Dpvar pv, fe) when eradicate_java () -> (* static field access *) + | Ddot (Dpvar _, fe) when eradicate_java () -> (* static field access *) Ident.fieldname_to_simplified_string fe | Ddot (de, f) -> if Ident.fieldname_is_hidden f then "&" ^ dexp_to_string de @@ -1898,18 +1895,18 @@ let rec dexp_to_string = function else "&" in ampersand ^ s | Dunop (op, de) -> str_unop op ^ dexp_to_string de - | Dsizeof (typ, sub) -> pp_to_string (pp_typ_full pe_text) typ + | Dsizeof (typ, _) -> pp_to_string (pp_typ_full pe_text) typ | Dunknown -> "unknown" | Dretcall (de, _, _, _) -> "returned by " ^ (dexp_to_string de) (** Pretty print a dexp. *) -and pp_dexp pe fmt de = F.fprintf fmt "%s" (dexp_to_string de) +and pp_dexp fmt de = F.fprintf fmt "%s" (dexp_to_string de) (** Pretty print a value path *) and pp_vpath pe fmt vpath = let pp fmt = function - | Some de -> pp_dexp pe fmt de + | Some de -> pp_dexp fmt de | None -> () in if pe.pe_kind == PP_HTML then F.fprintf fmt " %a{vpath: %a}%a" Io_infer.Html.pp_start_color Orange pp vpath Io_infer.Html.pp_end_color () @@ -1952,7 +1949,7 @@ and attribute_to_string pe = function | Auntaint -> "UNTAINTED" | Alocked -> "LOCKED" | Aunlocked -> "UNLOCKED" - | Adiv0 (pn, nd_id) -> "DIV0" + | Adiv0 (_, _) -> "DIV0" | Aobjc_null exp -> let info_s = match exp with @@ -1975,7 +1972,7 @@ and pp_const pe f = function | Cattribute att -> F.fprintf f "%s" (attribute_to_string pe att) | Cexn e -> F.fprintf f "EXN %a" (pp_exp pe) e | Cclass c -> F.fprintf f "%a" Ident.pp_name c - | Cptr_to_fld (fn, typ) -> F.fprintf f "__fld_%a" Ident.pp_fieldname fn + | Cptr_to_fld (fn, _) -> F.fprintf f "__fld_%a" Ident.pp_fieldname fn | Ctuple el -> F.fprintf f "(%a)" (pp_comma_seq (pp_exp pe)) el (** Pretty print a type. Do nothing by default. *) @@ -2003,7 +2000,7 @@ and pp_type_decl pe pp_base pp_size f = function F.fprintf f "%s %a {%a} %a" (Csu.name struct_typ.csu) Mangled.pp name - (pp_seq (fun f (fld, t, ann) -> + (pp_seq (fun f (fld, t, _) -> F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) struct_typ.instance_fields @@ -2016,7 +2013,7 @@ and pp_type_decl pe pp_base pp_size f = function | Tstruct ({struct_name = None} as struct_typ) -> F.fprintf f "%s {%a} %a" (Csu.name struct_typ.csu) - (pp_seq (fun f (fld, t, ann) -> + (pp_seq (fun f (fld, t, _) -> F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) struct_typ.instance_fields @@ -2029,7 +2026,7 @@ and pp_type_decl pe pp_base pp_size f = function (pp_seq (fun f (n, e) -> F.fprintf f " (%a, %a) " Mangled.pp n (pp_const pe) e)) econsts (** Pretty print a type with all the details, using the C syntax. *) -and pp_typ_full pe = pp_type_decl pe (fun fmt () -> ()) pp_exp_full +and pp_typ_full pe = pp_type_decl pe (fun _ () -> ()) pp_exp_full (** Pretty print an expression. *) and _pp_exp pe0 pp_t f e0 = @@ -2060,7 +2057,7 @@ and _pp_exp pe0 pp_t f e0 = | BinOp (op, Const c, e2) when !Config.smt_output -> print_binop_stm_output (Const c) op e2 | BinOp (op, e1, e2) -> F.fprintf f "(%a %s %a)" pp_exp e1 (str_binop pe op) pp_exp e2 | Lvar pv -> pp_pvar pe f pv - | Lfield (e, fld, typ) -> F.fprintf f "%a.%a" pp_exp e Ident.pp_fieldname fld + | Lfield (e, fld, _) -> F.fprintf f "%a.%a" pp_exp e Ident.pp_fieldname fld | Lindex (e1, e2) -> F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2 | Sizeof (t, s) -> F.fprintf f "sizeof(%a%a)" pp_t t Subtype.pp s end); @@ -2108,7 +2105,7 @@ let d_texp_full (te: exp) = L.add_print_action (L.PTtexp_full, Obj.repr te) (** Pretty print an offset *) let pp_offset pe f = function - | Off_fld (fld, typ) -> F.fprintf f "%a" Ident.pp_fieldname fld + | Off_fld (fld, _) -> F.fprintf f "%a" Ident.pp_fieldname fld | Off_index exp -> F.fprintf f "%a" (pp_exp pe) exp (** dump an offset. *) @@ -2184,7 +2181,7 @@ let pp_instr pe0 f instr = (pp_typ pe) t (pp_exp pe) e2 Location.pp loc - | Prune (cond, loc, true_branch, ik) -> + | Prune (cond, loc, true_branch, _) -> F.fprintf f "PRUNE(%a, %b); %a" (pp_exp pe) cond true_branch Location.pp loc | Call (ret_ids, e, arg_ts, loc, cf) -> (match ret_ids with @@ -2209,7 +2206,7 @@ let pp_instr pe0 f instr = F.fprintf f "STACKOP.%s; %a" s Location.pp loc | Declare_locals (ptl, loc) -> (* let pp_pvar_typ fmt (pvar, typ) = F.fprintf fmt "%a:%a" (pp_pvar pe) pvar (pp_typ_full pe) typ in *) - let pp_pvar_typ fmt (pvar, typ) = F.fprintf fmt "%a" (pp_pvar pe) pvar in + let pp_pvar_typ fmt (pvar, _) = F.fprintf fmt "%a" (pp_pvar pe) pvar in F.fprintf f "DECLARE_LOCALS(%a); %a" (pp_comma_seq pp_pvar_typ) ptl Location.pp loc | Goto_node (e, loc) -> F.fprintf f "Goto_node %a %a" (pp_exp pe) e Location.pp loc @@ -2218,7 +2215,7 @@ let pp_instr pe0 f instr = let has_block_prefix s = match Str.split_delim (Str.regexp_string Config.anonymous_block_prefix) s with - | s1:: s2:: _ -> true + | _ :: _ :: _ -> true | _ -> false (** Check if a pvar is a local pointing to a block in objc *) @@ -2239,20 +2236,20 @@ let rec typ_iter_types (f : typ -> unit) typ = | Tvoid | Tfun _ -> () - | Tptr (t', pk) -> + | Tptr (t', _) -> typ_iter_types f t' | Tstruct struct_typ -> IList.iter (fun (_, t, _) -> typ_iter_types f t) struct_typ.instance_fields | Tarray (t, e) -> typ_iter_types f t; exp_iter_types f e - | Tenum econsts -> + | Tenum _ -> () (** Iterate over all the subtypes in the type (including the type itself) *) and exp_iter_types f e = match e with - | Var id -> () + | Var _ -> () | Const (Cexn e1) -> exp_iter_types f e1 | Const (Ctuple el) -> @@ -2262,48 +2259,48 @@ and exp_iter_types f e = | Cast (t, e1) -> typ_iter_types f t; exp_iter_types f e1 - | UnOp (op, e1, typo) -> + | UnOp (_, e1, typo) -> exp_iter_types f e1; (match typo with | Some t -> typ_iter_types f t | None -> ()) - | BinOp (op, e1, e2) -> + | BinOp (_, e1, e2) -> exp_iter_types f e1; exp_iter_types f e2 - | Lvar id -> + | Lvar _ -> () - | Lfield (e1, fld, typ) -> + | Lfield (e1, _, typ) -> exp_iter_types f e1; typ_iter_types f typ | Lindex (e1, e2) -> exp_iter_types f e1; exp_iter_types f e2 - | Sizeof (t, s) -> + | Sizeof (t, _) -> typ_iter_types f t (** Iterate over all the types (and subtypes) in the instruction *) let instr_iter_types f instr = match instr with - | Letderef (id, e, t, loc) -> + | Letderef (_, e, t, _) -> exp_iter_types f e; typ_iter_types f t - | Set (e1, t, e2, loc) -> + | Set (e1, t, e2, _) -> exp_iter_types f e1; typ_iter_types f t; exp_iter_types f e2 - | Prune (cond, loc, true_branch, ik) -> + | Prune (cond, _, _, _) -> exp_iter_types f cond - | Call (ret_ids, e, arg_ts, loc, cf) -> + | Call (_, e, arg_ts, _, _) -> exp_iter_types f e; IList.iter (fun (e, t) -> exp_iter_types f e; typ_iter_types f t) arg_ts - | Nullify (pvar, loc, deallocate) -> + | Nullify (_, _, _) -> () - | Abstract loc -> + | Abstract _ -> () - | Remove_temps (temps, loc) -> + | Remove_temps (_, _) -> () - | Stackop (stackop, loc) -> + | Stackop (_, _) -> () - | Declare_locals (ptl, loc) -> + | Declare_locals (ptl, _) -> IList.iter (fun (_, t) -> typ_iter_types f t) ptl | Goto_node _ -> () @@ -2334,8 +2331,8 @@ let pp_atom pe0 f a = F.fprintf f "%a = %a" (pp_exp pe) e1 (pp_exp pe) e2 | PP_LATEX -> F.fprintf f "%a{=}%a" (pp_exp pe) e1 (pp_exp pe) e2) - | Aneq ((Const (Cattribute a) as ea), e) - | Aneq (e, (Const (Cattribute a) as ea)) -> + | Aneq ((Const (Cattribute _) as ea), e) + | Aneq (e, (Const (Cattribute _) as ea)) -> F.fprintf f "%a(%a)" (pp_exp pe) ea (pp_exp pe) e | Aneq (e1, e2) -> (match pe.pe_kind with @@ -2435,9 +2432,9 @@ end = struct let rec process_sexp env = function | Eexp _ -> () | Earray (_, esel, _) -> - IList.iter (fun (e, se) -> process_sexp env se) esel + IList.iter (fun (_, se) -> process_sexp env se) esel | Estruct (fsel, _) -> - IList.iter (fun (f, se) -> process_sexp env se) fsel + IList.iter (fun (_, se) -> process_sexp env se) fsel (** Process one hpred, updating env *) let rec process_hpred env = function @@ -2504,15 +2501,15 @@ let inst_new_loc loc inst = match inst with | Iabstraction -> inst | Iactual_precondition -> inst | Ialloc -> inst - | Iformal (zf, ncf) -> inst + | Iformal _ -> inst | Iinitial -> inst | Ilookup -> inst | Inone -> inst | Inullify -> inst - | Irearrange (zf, ncf, n, pos) -> Irearrange (zf, ncf, loc.Location.line, pos) + | Irearrange (zf, ncf, _, pos) -> Irearrange (zf, ncf, loc.Location.line, pos) | Itaint -> inst - | Iupdate (zf, ncf, n, pos) -> Iupdate (zf, ncf, loc.Location.line, pos) - | Ireturn_from_call n -> Ireturn_from_call loc.Location.line + | Iupdate (zf, ncf, _, pos) -> Iupdate (zf, ncf, loc.Location.line, pos) + | Ireturn_from_call _ -> Ireturn_from_call loc.Location.line (** return a string representing the inst *) let inst_to_string inst = @@ -2560,14 +2557,14 @@ let inst_zero_flag = function | Iabstraction -> None | Iactual_precondition -> None | Ialloc -> None - | Iformal (zf, ncf) -> zf + | Iformal (zf, _) -> zf | Iinitial -> None | Ilookup -> None | Inone -> None | Inullify -> None - | Irearrange (zf, ncf, n, _) -> zf + | Irearrange (zf, _, _, _) -> zf | Itaint -> None - | Iupdate (zf, ncf, n, _) -> zf + | Iupdate (zf, _, _, _) -> zf | Ireturn_from_call _ -> None (** Set the null case flag of the inst. *) @@ -2652,7 +2649,7 @@ and pp_hpred_env pe0 envo f hpred = begin match hpred with | Hpointsto (e, se, te) -> let pe' = match (e, se) with - | Lvar pvar, Eexp (Var id, inst) when not (pvar_is_global pvar) -> + | Lvar pvar, Eexp (Var _, _) when not (pvar_is_global pvar) -> { pe with pe_obj_sub = None } (* dont use obj sub on the var defining it *) | _ -> pe in (match pe'.pe_kind with @@ -2844,7 +2841,7 @@ let unsome_typ s = function If not a sizeof, return the default type if given, otherwise raise an exception *) let texp_to_typ default_opt = function | Sizeof (t, _) -> t - | t -> + | _ -> unsome_typ "texp_to_typ" default_opt (** If a struct type with field f, return the type of f. @@ -2853,8 +2850,8 @@ let struct_typ_fld default_opt f = let def () = unsome_typ "struct_typ_fld" default_opt in function | Tstruct struct_typ -> - (try (fun (x, y, z) -> y) - (IList.find (fun (_f, t, ann) -> + (try (fun (_, y, _) -> y) + (IList.find (fun (_f, _, _) -> Ident.fieldname_equal _f f) struct_typ.instance_fields) with Not_found -> def ()) | _ -> def () @@ -2863,14 +2860,14 @@ let struct_typ_fld default_opt f = If not, return the default type if given, otherwise raise an exception *) let array_typ_elem default_opt = function | Tarray (t_el, _) -> t_el - | t -> + | _ -> unsome_typ "array_typ_elem" default_opt (** Return the root of [lexp]. *) let rec root_of_lexp lexp = match lexp with | Var _ -> lexp | Const _ -> lexp - | Cast (t, e) -> root_of_lexp e + | Cast (_, e) -> root_of_lexp e | UnOp _ | BinOp _ -> lexp | Lvar _ -> lexp | Lfield(e, _, _) -> root_of_lexp e @@ -2928,7 +2925,7 @@ let exp_lt e1 e2 = (** {2 Functions for computing program variables} *) let rec exp_fpv = function - | Var id -> [] + | Var _ -> [] | Const (Cexn e) -> exp_fpv e | Const (Ctuple el) -> exp_list_fpv el | Const _ -> [] @@ -2946,11 +2943,11 @@ let atom_fpv = function | Aneq (e1, e2) -> exp_fpv e1 @ exp_fpv e2 let rec strexp_fpv = function - | Eexp (e, inst) -> exp_fpv e - | Estruct (fld_se_list, inst) -> + | Eexp (e, _) -> exp_fpv e + | Estruct (fld_se_list, _) -> let f (_, se) = strexp_fpv se in IList.flatten (IList.map f fld_se_list) - | Earray (size, idx_se_list, inst) -> + | Earray (size, idx_se_list, _) -> let fpv_in_size = exp_fpv size in let f (idx, se) = exp_fpv idx @ strexp_fpv se in fpv_in_size @ IList.flatten (IList.map f idx_se_list) @@ -3096,7 +3093,7 @@ let rec exp_fav_add fav = function | Const _ -> () | Cast (_, e) | UnOp (_, e, _) -> exp_fav_add fav e | BinOp (_, e1, e2) -> exp_fav_add fav e1; exp_fav_add fav e2 - | Lvar id -> () (* do nothing since we only count non-program variables *) + | Lvar _ -> () (* do nothing since we only count non-program variables *) | Lfield (e, _, _) -> exp_fav_add fav e | Lindex (e1, e2) -> exp_fav_add fav e1; exp_fav_add fav e2 | Sizeof _ -> () @@ -3121,25 +3118,20 @@ let atom_fav = (** Atoms do not contain binders *) let atom_av_add = atom_fav_add -let hpara_fav_add fav para = () (* Global invariant: hpara is closed *) -let hpara_dll_fav_add fav para = () (* Global invariant: hpara_dll is closed *) - let rec strexp_fav_add fav = function - | Eexp (e, inst) -> exp_fav_add fav e - | Estruct (fld_se_list, inst) -> + | Eexp (e, _) -> exp_fav_add fav e + | Estruct (fld_se_list, _) -> IList.iter (fun (_, se) -> strexp_fav_add fav se) fld_se_list - | Earray (size, idx_se_list, inst) -> + | Earray (size, idx_se_list, _) -> exp_fav_add fav size; IList.iter (fun (e, se) -> exp_fav_add fav e; strexp_fav_add fav se) idx_se_list let hpred_fav_add fav = function | Hpointsto (base, sexp, te) -> exp_fav_add fav base; strexp_fav_add fav sexp; exp_fav_add fav te - | Hlseg (_, para, e1, e2, elist) -> - hpara_fav_add fav para; + | Hlseg (_, _, e1, e2, elist) -> exp_fav_add fav e1; exp_fav_add fav e2; IList.iter (exp_fav_add fav) elist - | Hdllseg (_, para, e1, e2, e3, e4, elist) -> - hpara_dll_fav_add fav para; + | Hdllseg (_, _, e1, e2, e3, e4, elist) -> exp_fav_add fav e1; exp_fav_add fav e2; exp_fav_add fav e3; exp_fav_add fav e4; IList.iter (exp_fav_add fav) elist @@ -3387,7 +3379,7 @@ let rec typ_sub (subst: subst) typ = Tptr (typ_sub subst t', pk) | Tarray (t, e) -> Tarray (typ_sub subst t, exp_sub subst e) - | Tenum econsts -> + | Tenum _ -> typ and exp_sub (subst: subst) e = @@ -3418,7 +3410,7 @@ and exp_sub (subst: subst) e = let e1' = exp_sub subst e1 in let e2' = exp_sub subst e2 in BinOp (op, e1', e2') - | Lvar id -> + | Lvar _ -> e | Lfield (e1, fld, typ) -> let e1' = exp_sub subst e1 in @@ -3447,13 +3439,13 @@ let instr_sub (subst: subst) instr = | Call (ret_ids, e, arg_ts, loc, cf) -> let arg_s (e, t) = (exp_s e, typ_s t) in Call (IList.map id_s ret_ids, exp_s e, IList.map arg_s arg_ts, loc, cf) - | Nullify (pvar, loc, deallocate) -> + | Nullify _ -> instr - | Abstract loc -> + | Abstract _ -> instr | Remove_temps (temps, loc) -> Remove_temps (IList.map id_s temps, loc) - | Stackop (stackop, loc) -> + | Stackop _ -> instr | Declare_locals (ptl, loc) -> let pt_s (pv, t) = (pv, typ_s t) in @@ -3546,7 +3538,7 @@ let rec exp_compare_structural e1 e2 exp_map = (* assume e1 and e2 equal, enforce by adding to [exp_map] *) 0, ExpMap.add e1 e2 exp_map in match (e1, e2) with - | Var id1, Var id2 -> compare_exps_with_map e1 e2 exp_map + | Var _, Var _ -> compare_exps_with_map e1 e2 exp_map | UnOp (o1, e1, to1), UnOp (o2, e2, to2) -> let n = unop_compare o1 o2 in if n <> 0 then n, exp_map @@ -3563,7 +3555,7 @@ let rec exp_compare_structural e1 e2 exp_map = | Cast (t1, e1), Cast(t2, e2) -> let n, exp_map = exp_compare_structural e1 e2 exp_map in (if n <> 0 then n else typ_compare t1 t2), exp_map - | Lvar i1, Lvar i2 -> compare_exps_with_map e1 e2 exp_map + | Lvar _, Lvar _ -> compare_exps_with_map e1 e2 exp_map | Lfield (e1, f1, t1), Lfield (e2, f2, t2) -> let n, exp_map = exp_compare_structural e1 e2 exp_map in (if n <> 0 then n @@ -3596,26 +3588,26 @@ let instr_compare_structural instr1 instr2 exp_map = ids1 ids2 in match instr1, instr2 with - | Letderef (id1, e1, t1, loc1), Letderef (id2, e2, t2, loc2) -> + | Letderef (id1, e1, t1, _), Letderef (id2, e2, t2, _) -> let n, exp_map = exp_compare_structural (Var id1) (Var id2) exp_map in if n <> 0 then n, exp_map else let n, exp_map = exp_compare_structural e1 e2 exp_map in (if n <> 0 then n else typ_compare t1 t2), exp_map - | Set (e11, t1, e21, loc1), Set (e12, t2, e22, loc2) -> + | Set (e11, t1, e21, _), Set (e12, t2, e22, _) -> let n, exp_map = exp_compare_structural e11 e12 exp_map in if n <> 0 then n, exp_map else let n = typ_compare t1 t2 in if n <> 0 then n, exp_map else exp_compare_structural e21 e22 exp_map - | Prune (cond1, loc1, true_branch1, ik1), Prune (cond2, loc2, true_branch2, ik2) -> + | Prune (cond1, _, true_branch1, ik1), Prune (cond2, _, true_branch2, ik2) -> let n, exp_map = exp_compare_structural cond1 cond2 exp_map in (if n <> 0 then n else let n = bool_compare true_branch1 true_branch2 in if n <> 0 then n else Pervasives.compare ik1 ik2), exp_map - | Call (ret_ids1, e1, arg_ts1, loc1, cf1), Call (ret_ids2, e2, arg_ts2, loc2, cf2) -> + | Call (ret_ids1, e1, arg_ts1, _, cf1), Call (ret_ids2, e2, arg_ts2, _, cf2) -> let args_compare_structural args1 args2 exp_map = let n = Pervasives.compare (IList.length args1) (IList.length args2) in if n <> 0 then n, exp_map @@ -3634,15 +3626,15 @@ let instr_compare_structural instr1 instr2 exp_map = else let n, exp_map = args_compare_structural arg_ts1 arg_ts2 exp_map in (if n <> 0 then n else call_flags_compare cf1 cf2), exp_map - | Nullify (pvar1, loc1, deallocate1), Nullify (pvar2, loc2, deallocate2) -> + | Nullify (pvar1, _, deallocate1), Nullify (pvar2, _, deallocate2) -> let n, exp_map = exp_compare_structural (Lvar pvar1) (Lvar pvar2) exp_map in (if n <> 0 then n else bool_compare deallocate1 deallocate2), exp_map - | Abstract loc1, Abstract loc2 -> 0, exp_map - | Remove_temps (temps1, loc1), Remove_temps (temps2, loc2) -> + | Abstract _, Abstract _ -> 0, exp_map + | Remove_temps (temps1, _), Remove_temps (temps2, _) -> id_list_compare_structural temps1 temps2 exp_map - | Stackop (stackop1, loc1), Stackop (stackop2, loc2) -> + | Stackop (stackop1, _), Stackop (stackop2, _) -> Pervasives.compare stackop1 stackop2, exp_map - | Declare_locals (ptl1, loc1), Declare_locals (ptl2, loc2) -> + | Declare_locals (ptl1, _), Declare_locals (ptl2, _) -> let n = Pervasives.compare (IList.length ptl1) (IList.length ptl2) in if n <> 0 then n, exp_map else @@ -3655,7 +3647,7 @@ let instr_compare_structural instr1 instr2 exp_map = (0, exp_map) ptl1 ptl2 - | Goto_node (e1, loc1), Goto_node (e2, loc2) -> + | Goto_node (e1, _), Goto_node (e2, _) -> exp_compare_structural e1 e2 exp_map | _ -> instr_compare instr1 instr2, exp_map @@ -3666,8 +3658,6 @@ let hpred_sub subst = let f (e, inst_opt) = (exp_sub subst e, inst_opt) in hpred_expmap f -let hpara_sub subst para = para - (** {2 Functions for replacing occurrences of expressions.} *) let exp_replace_exp epairs e = @@ -3888,7 +3878,7 @@ let pvar_to_callee pname pvar = match pvar.pv_kind with let exp_get_offsets exp = let rec f offlist_past e = match e with | Var _ | Const _ | UnOp _ | BinOp _ | Lvar _ | Sizeof _ -> offlist_past - | Cast(t, sub_exp) -> f offlist_past sub_exp + | Cast(_, sub_exp) -> f offlist_past sub_exp | Lfield(sub_exp, fldname, typ) -> f (Off_fld (fldname, typ):: offlist_past) sub_exp | Lindex(sub_exp, e) -> f (Off_index e :: offlist_past) sub_exp in f [] exp @@ -3927,7 +3917,7 @@ let hpara_instantiate para e1 e2 elist = try (IList.map2 g para.svars elist) with Invalid_argument _ -> assert false in let ids_evars = - let g id = Ident.create_fresh Ident.kprimed in + let g _ = Ident.create_fresh Ident.kprimed in IList.map g para.evars in let subst_for_evars = let g id id' = (id, Var id') in @@ -3946,7 +3936,7 @@ let hpara_dll_instantiate (para: hpara_dll) cell blink flink elist = try (IList.map2 g para.svars_dll elist) with Invalid_argument _ -> assert false in let ids_evars = - let g id = Ident.create_fresh Ident.kprimed in + let g _ = Ident.create_fresh Ident.kprimed in IList.map g para.evars_dll in let subst_for_evars = let g id id' = (id, Var id') in diff --git a/infer/src/backend/sil.mli b/infer/src/backend/sil.mli index 07a900b19..05cf668e8 100644 --- a/infer/src/backend/sil.mli +++ b/infer/src/backend/sil.mli @@ -852,7 +852,7 @@ val attribute_to_string : printenv -> attribute -> string val dexp_to_string : dexp -> string (** Pretty print a dexp. *) -val pp_dexp : printenv -> Format.formatter -> dexp -> unit +val pp_dexp : Format.formatter -> dexp -> unit (** Pretty print an expression. *) val pp_exp : printenv -> Format.formatter -> exp -> unit @@ -1151,8 +1151,6 @@ val hpred_fav_add : fav -> hpred -> unit val hpred_fav : hpred -> fav -val hpara_fav_add : fav -> hpara -> unit - (** Variables in hpara, excluding bound vars in the body *) val hpara_shallow_av : hpara -> fav @@ -1271,8 +1269,6 @@ val instr_sub : subst -> instr -> instr val hpred_sub : subst -> hpred -> hpred -val hpara_sub : subst -> hpara -> hpara - (** {2 Functions for replacing occurrences of expressions.} *) (** The first parameter should define a partial function. diff --git a/infer/src/backend/specs.ml b/infer/src/backend/specs.ml index 781ad02d1..9f97f925b 100644 --- a/infer/src/backend/specs.ml +++ b/infer/src/backend/specs.ml @@ -113,12 +113,12 @@ module Jprop = struct let filter (f: 'a t -> 'b option) jpl = let rec do_filter acc = function | [] -> acc - | (Prop (_, p) as jp) :: jpl -> + | (Prop _ as jp) :: jpl -> (match f jp with | Some x -> do_filter (x:: acc) jpl | None -> do_filter acc jpl) - | (Joined (_, p, jp1, jp2) as jp) :: jpl -> + | (Joined (_, _, jp1, jp2) as jp) :: jpl -> (match f jp with | Some x -> do_filter (x:: acc) jpl @@ -142,13 +142,13 @@ end module Visitedset = Set.Make (struct type t = int * int list - let compare (node_id1, line1) (node_id2, line2) = int_compare node_id1 node_id2 + let compare (node_id1, _) (node_id2, _) = int_compare node_id1 node_id2 end) let visited_str vis = let s = ref "" in let lines = ref IntSet.empty in - let do_one (node, ns) = + let do_one (_, ns) = (* if IList.length ns > 1 then begin let ss = ref "" in @@ -180,7 +180,7 @@ end = struct let spec_fav (spec: Prop.normal spec) : Sil.fav = let fav = Sil.fav_new () in Jprop.fav_add_dfs fav spec.pre; - IList.iter (fun (p, path) -> Prop.prop_fav_add_dfs fav p) spec.posts; + IList.iter (fun (p, _) -> Prop.prop_fav_add_dfs fav p) spec.posts; fav let spec_sub sub spec = @@ -432,7 +432,7 @@ let pp_summary_no_stats_specs fmt summary = F.fprintf fmt "%a@\n" pp_pair (describe_phase summary); F.fprintf fmt "Dependency_map: @[%a@]@\n" pp_dependency_map summary.dependency_map -let pp_stats_html err_log fmt stats = +let pp_stats_html err_log fmt = Errlog.pp_html [] fmt err_log let get_specs_from_payload summary = @@ -452,7 +452,7 @@ let pp_summary pe whole_seconds fmt summary = Io_infer.Html.pp_start_color fmt Black; F.fprintf fmt "@\n%a" pp_summary_no_stats_specs summary; Io_infer.Html.pp_end_color fmt (); - pp_stats_html err_log fmt summary.stats; + pp_stats_html err_log fmt; Io_infer.Html.pp_hline fmt (); F.fprintf fmt "@\n"; pp_specs pe fmt (get_specs_from_payload summary); @@ -466,7 +466,9 @@ let pp_summary pe whole_seconds fmt summary = (** Print the spec table *) let pp_spec_table pe whole_seconds fmt () = - Procname.Hash.iter (fun proc_name (summ, orig) -> F.fprintf fmt "PROC %a@\n%a@\n" Procname.pp proc_name (pp_summary pe whole_seconds) summ) spec_tbl + Procname.Hash.iter (fun proc_name (summ, _) -> + F.fprintf fmt "PROC %a@\n%a@\n" Procname.pp proc_name (pp_summary pe whole_seconds) summ + ) spec_tbl let empty_stats calls in_out_calls_opt = { stats_time = 0.0; @@ -752,7 +754,7 @@ let get_specs proc_name = let get_phase proc_name = match get_summary_origin proc_name with | None -> raise (Failure ("Specs.get_phase: " ^ (Procname.to_string proc_name) ^ " Not_found")) - | Some (summary, origin) -> summary.phase + | Some (summary, _) -> summary.phase (** Set the current status for the proc *) let set_status proc_name status = @@ -766,7 +768,7 @@ let mk_initial_dependency_map proc_list : dependency_map_t = (** Re-initialize a dependency map *) let re_initialize_dependency_map dependency_map = - Procname.Map.map (fun dep_proc -> - 1) dependency_map + Procname.Map.map (fun _ -> - 1) dependency_map (** Update the dependency map of [proc_name] with the current timestamps of the dependents *) @@ -778,7 +780,7 @@ let update_dependency_map proc_name = | Some (summary, origin) -> let current_dependency_map = Procname.Map.mapi - (fun dep_proc old_stamp -> get_timestamp summary) + (fun _ _ -> get_timestamp summary) summary.dependency_map in set_summary_origin proc_name { summary with dependency_map = current_dependency_map } origin diff --git a/infer/src/backend/state.ml b/infer/src/backend/state.ml index e52bde7a6..ab0704880 100644 --- a/infer/src/backend/state.ml +++ b/infer/src/backend/state.ml @@ -61,7 +61,7 @@ type t = { } let initial () = { - const_map = (fun node exp -> None); + const_map = (fun _ _ -> None); diverging_states_node = Paths.PathSet.empty; diverging_states_proc = Paths.PathSet.empty; goto_node = None; @@ -184,7 +184,7 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = let module S = (* set of nodes with normalized insructions *) Set.Make(struct type t = Cfg.Node.t * Sil.instr list - let compare (n1, instrs1) (n2, instrs2) = + let compare (n1, _) (n2, _) = Cfg.Node.compare n1 n2 end) in @@ -221,7 +221,7 @@ let mk_find_duplicate_nodes proc_desc : (Cfg.Node.t -> Cfg.NodeSet.t) = try let s = M.find (get_key node) map in let elements = S.elements s in - let (_, node_normalized_instrs), others = + let (_, node_normalized_instrs), _ = let filter (node', _) = Cfg.Node.equal node node' in match IList.partition filter elements with | [this], others -> this, others @@ -325,11 +325,11 @@ type log_issue = unit let process_execution_failures (log_issue : log_issue) pname = - let do_failure node fs = + let do_failure _ fs = (* L.err "Node:%a node_ok:%d node_fail:%d@." Cfg.Node.pp node fs.node_ok fs.node_fail; *) match fs.node_ok, fs.first_failure with - | 0, Some (loc, key, session, loc_trace, pre_opt, exn) -> - let ex_name, desc, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in + | 0, Some (loc, key, _, loc_trace, pre_opt, exn) -> + let ex_name, _, ml_loc_opt, _, _, _, _ = Exceptions.recognize_exception exn in let desc' = Localise.verbatim_desc ("exception: " ^ Localise.to_string ex_name) in let exn' = Exceptions.Analysis_stops (desc', ml_loc_opt) in log_issue diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 9ac123e04..fd973b88e 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -15,7 +15,7 @@ module F = Format let rec fldlist_assoc fld = function | [] -> raise Not_found - | (fld', x, a):: l -> if Sil.fld_equal fld fld' then x else fldlist_assoc fld l + | (fld', x, _):: l -> if Sil.fld_equal fld fld' then x else fldlist_assoc fld l let rec unroll_type tenv typ off = match (typ, off) with @@ -127,7 +127,7 @@ let rec apply_offlist let offlist' = (Sil.Off_index Sil.exp_zero):: offlist in apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist' f inst lookup_inst - | (Sil.Off_fld (fld, _)):: offlist', Sil.Earray _ -> + | (Sil.Off_fld _):: _, Sil.Earray _ -> let offlist_new = Sil.Off_index(Sil.exp_zero) :: offlist in apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, typ) offlist_new f inst lookup_inst @@ -183,7 +183,7 @@ let rec apply_offlist let res_e' = Sil.Var (Ident.create_fresh Ident.kprimed) in (res_e', strexp, typ, None) end - | (Sil.Off_index idx):: offlist', _ -> + | (Sil.Off_index _):: _, _ -> pp_error(); raise (Exceptions.Internal_error (Localise.verbatim_desc "Array out of bounds in Symexec")) (* This case should not happen. The rearrangement should @@ -318,7 +318,7 @@ let rec execute_nullify_se = function | Sil.Estruct (fsel, _) -> let fsel' = IList.map (fun (fld, se) -> (fld, execute_nullify_se se)) fsel in Sil.Estruct (fsel', Sil.inst_nullify) - | Sil.Earray (size, esel, inst) -> + | Sil.Earray (size, esel, _) -> let esel' = IList.map (fun (idx, se) -> (idx, execute_nullify_se se)) esel in Sil.Earray (size, esel', Sil.inst_nullify) @@ -510,7 +510,7 @@ let check_already_dereferenced pname cond prop = | None -> None in match dereferenced_line with - | Some (id, (n, pos)) -> + | Some (id, (n, _)) -> let desc = Errdesc.explain_null_test_after_dereference (Sil.Var id) (State.get_node ()) n (State.get_loc ()) in let exn = (Exceptions.Null_test_after_dereference (desc, __POS__)) in @@ -581,7 +581,7 @@ let resolve_method tenv class_name proc_name = Some right_proc_name else (match superclasses with - | super_classname:: interfaces -> + | super_classname:: _ -> if not (Typename.Set.mem super_classname !visited) then resolve super_classname else None @@ -636,7 +636,7 @@ let lookup_java_typ_from_string tenv typ_str = (** If the dynamic type of the receiver actual T_actual is a subtype of the reciever type T_formal in the signature of [pname], resolve [pname] to T_actual.[pname]. *) -let resolve_virtual_pname cfg tenv prop actuals callee_pname call_flags : Procname.t list = +let resolve_virtual_pname tenv prop actuals callee_pname call_flags : Procname.t list = let resolve receiver_exp pname prop = match resolve_typename prop receiver_exp with | Some class_name -> resolve_method tenv class_name pname | None -> pname in @@ -704,7 +704,7 @@ let redirect_shared_ptr tenv cfg pname actual_params = | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some cl_name } -> let name = Mangled.to_string cl_name in name = "shared_ptr" || name = "__shared_ptr" - | t -> false + | _ -> false with exn when exn_not_failure exn -> false in (* We pattern match over some specific library function, *) (* so we make precise matching to distinghuis between *) @@ -732,7 +732,7 @@ let redirect_shared_ptr tenv cfg pname actual_params = Procname.from_string_c_fun "__infer_shared_ptr_eqeq" | ("operator->" | "operator*"),[(_, t1)] when ptr_to_shared_ptr t1 -> Procname.from_string_c_fun "__infer_shared_ptr_arrow" - | "~shared_ptr",[(_, t1)] -> + | "~shared_ptr",[_] -> Procname.from_string_c_fun "__infer_shared_ptr_destructor" | _ -> pname in if Procname.equal pname pname' then pname @@ -780,7 +780,7 @@ let call_constructor_url_update_args pname actual_params = | [this; (Sil.Const (Sil.Cstr s), atype)] -> let parts = Str.split (Str.regexp_string "://") s in (match parts with - | frst:: parts -> + | frst:: _ -> if (frst = "http") || (frst = "ftp") || (frst = "https") || (frst = "mailto") || (frst = "jar") then [this; (Sil.Const (Sil.Cstr frst), atype)] else actual_params @@ -800,7 +800,7 @@ let handle_special_cases_call tenv cfg pname actual_params = (* This method handles ObjC method calls, in particular the fact that calling a method with nil *) (* returns nil. The exec_call function is either standard call execution or execution of ObjC *) (* getters and setters using a builtin. *) -let handle_objc_method_call actual_pars actual_params pre tenv cfg ret_ids pdesc callee_pname loc +let handle_objc_method_call actual_pars actual_params pre tenv ret_ids pdesc callee_pname loc path exec_call = let path_description = "Message "^(Procname.to_simplified_string callee_pname)^" with receiver nil returns nil." in let receiver = (match actual_pars with @@ -826,7 +826,7 @@ let handle_objc_method_call actual_pars actual_params pre tenv cfg ret_ids pdesc (* can keep track of how this object became null, so that in a NPE we can separate it into a different error type *) [(add_objc_null_attribute_or_nullify_result pre, path)] else - let res = exec_call tenv cfg ret_ids pdesc callee_pname loc actual_params pre path in + let res = exec_call tenv ret_ids pdesc callee_pname loc actual_params pre path in let is_undef = Option.is_some (Prop.get_undef_attribute pre receiver) in if !Config.footprint && not is_undef then @@ -911,7 +911,7 @@ let add_constraints_on_retval pdesc prop ret_exp typ callee_pname callee_loc = else add_ret_non_null ret_exp typ prop let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ loc prop_ = - let execute_letderef_ pdesc tenv id rhs_exp loc acc_in iter = + let execute_letderef_ pdesc tenv id loc acc_in iter = let iter_ren = Prop.prop_iter_make_id_primed id iter in let prop_ren = Prop.prop_iter_to_prop iter_ren in match Prop.prop_iter_current iter_ren with @@ -944,7 +944,7 @@ let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ assert false in try let n_rhs_exp, prop = exp_norm_check_arith pname prop_ rhs_exp in - let n_rhs_exp' = Prop.exp_collapse_consecutive_indices_prop prop typ n_rhs_exp in + let n_rhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_rhs_exp in match check_constant_string_dereference n_rhs_exp' with | Some value -> [Prop.conjoin_eq (Sil.Var id) value prop] @@ -964,7 +964,7 @@ let execute_letderef ?(report_deref_errors=true) pname pdesc tenv id rhs_exp typ else prop in let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_rhs_exp' typ prop' loc in - IList.rev (IList.fold_left (execute_letderef_ pdesc tenv id n_rhs_exp' loc) [] iter_list) + IList.rev (IList.fold_left (execute_letderef_ pdesc tenv id loc) [] iter_list) with Rearrange.ARRAY_ACCESS -> if (!Config.array_level = 0) then assert false else @@ -993,7 +993,7 @@ let execute_set ?(report_deref_errors=true) pname pdesc tenv lhs_exp typ rhs_exp let n_lhs_exp, _prop' = exp_norm_check_arith pname prop_ lhs_exp in let n_rhs_exp, prop = exp_norm_check_arith pname _prop' rhs_exp in let prop = Prop.replace_objc_null prop n_lhs_exp n_rhs_exp in - let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop prop typ n_lhs_exp in + let n_lhs_exp' = Prop.exp_collapse_consecutive_indices_prop typ n_lhs_exp in let iter_list = Rearrange.rearrange ~report_deref_errors pdesc tenv n_lhs_exp' typ prop loc in IList.rev (IList.fold_left (execute_set_ pdesc tenv n_rhs_exp) [] iter_list) with Rearrange.ARRAY_ACCESS -> @@ -1021,9 +1021,7 @@ let rec sym_exec cfg tenv 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); - call_unknown_or_scan - false cfg pdesc tenv prop path - ret_ids ret_typ_opt actual_args callee_pname loc in + call_unknown_or_scan false pdesc prop path ret_ids ret_typ_opt actual_args callee_pname loc in let instr = match _instr with | Sil.Call (ret, exp, par, loc, call_flags) -> let exp' = Prop.exp_normalize_prop _prop exp in @@ -1091,7 +1089,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path check_condition_always_true_false (); let n_cond, prop = exp_norm_check_arith pname _prop cond in ret_old_path (Propset.to_proplist (prune_prop n_cond prop)) - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun callee_pname), args, loc, call_flags) + | Sil.Call (ret_ids, Sil.Const (Sil.Cfun callee_pname), args, loc, _) when function_is_builtin callee_pname -> let sym_exe_builtin = Builtin.get_sym_exe_builtin callee_pname in sym_exe_builtin cfg pdesc instr tenv _prop path ret_ids args callee_pname loc @@ -1102,7 +1100,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path let url_handled_args = call_constructor_url_update_args callee_pname norm_args in let resolved_pnames = - resolve_virtual_pname cfg tenv norm_prop url_handled_args callee_pname call_flags in + resolve_virtual_pname tenv norm_prop url_handled_args callee_pname call_flags in let exec_one_pname pname = if !Config.ondemand_enabled then Ondemand.do_analysis pdesc pname; @@ -1127,7 +1125,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path let (prop_r, _n_actual_params) = normalize_params pname _prop actual_params in let fn, n_actual_params = handle_special_cases_call tenv cfg callee_pname _n_actual_params in let resolved_pname = - match resolve_virtual_pname cfg tenv prop_r n_actual_params fn call_flags with + match resolve_virtual_pname tenv prop_r n_actual_params fn call_flags with | resolved_pname :: _ -> resolved_pname | [] -> fn in if !Config.ondemand_enabled then @@ -1155,7 +1153,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path match objc_property_accessor with | Some objc_property_accessor -> handle_objc_method_call - n_actual_params n_actual_params prop tenv cfg ret_ids pdesc callee_pname loc path + n_actual_params n_actual_params prop tenv ret_ids pdesc callee_pname loc path (sym_exec_objc_accessor objc_property_accessor ret_typ_opt) | None -> skip_call prop path resolved_pname loc ret_ids ret_typ_opt n_actual_params @@ -1173,10 +1171,9 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path end else begin L.d_str "Unknown function pointer "; Sil.d_exp fun_exp; L.d_strln ", returning undefined value."; let callee_pname = Procname.from_string_c_fun "__function_pointer__" in - call_unknown_or_scan - false cfg pdesc tenv prop_r path ret_ids None n_actual_params callee_pname loc + call_unknown_or_scan false pdesc prop_r path ret_ids None n_actual_params callee_pname loc end - | Sil.Nullify (pvar, loc, deallocate) -> + | Sil.Nullify (pvar, _, deallocate) -> begin let eprop = Prop.expose _prop in match IList.partition @@ -1193,7 +1190,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path ret_old_path [Prop.normalize eprop_res] | _ -> assert false end - | Sil.Abstract loc -> + | Sil.Abstract _ -> let node = State.get_node () in let blocks_nullified = get_nullified_block node in IList.iter (check_block_retain_cycle cfg tenv pname _prop) blocks_nullified; @@ -1203,9 +1200,9 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path else ret_old_path [Abs.remove_redundant_array_elements pname tenv (Abs.abstract pname tenv _prop)] - | Sil.Remove_temps (temps, loc) -> + | Sil.Remove_temps (temps, _) -> ret_old_path [Prop.exist_quantify (Sil.fav_from_list temps) _prop] - | Sil.Declare_locals (ptl, loc) -> + | Sil.Declare_locals (ptl, _) -> let sigma_locals = let add_None (x, y) = (x, Sil.Sizeof (y, Sil.Subtype.exact), None) in let fp_mode = !Config.footprint in @@ -1221,7 +1218,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path ret_old_path [prop'] | Sil.Stackop _ -> (* this should be handled at the propset level *) assert false - | Sil.Goto_node (node_e, loc) -> + | Sil.Goto_node (node_e, _) -> let n_node_e, prop = exp_norm_check_arith pname _prop node_e in begin match n_node_e with @@ -1296,7 +1293,7 @@ and add_constraints_on_actuals_by_ref prop actuals_by_ref callee_pname callee_lo let filtered_sigma = IList.filter (function - | Sil.Hpointsto (lhs, _, typ_exp) when Sil.exp_equal lhs actual -> + | Sil.Hpointsto (lhs, _, _) when Sil.exp_equal lhs actual -> false | _ -> true) (Prop.get_sigma prop) in @@ -1341,10 +1338,10 @@ and check_untainted exp caller_pname callee_pname prop = else prop (** execute a call for an unknown or scan function *) -and call_unknown_or_scan is_scan cfg pdesc tenv pre path +and call_unknown_or_scan is_scan pdesc pre path ret_ids ret_type_option actual_pars callee_pname loc = let remove_file_attribute prop = - let do_exp p (e, t) = + let do_exp p (e, _) = let do_attribute q = function | Sil.Aresource res_action as res when res_action.Sil.ra_res = Sil.Rfile -> @@ -1445,7 +1442,7 @@ and sym_exe_check_variadic_sentinel_if_present cfg pdesc tenv prop path (IList.length formals) actual_params sentinel_arg callee_pname loc -and sym_exec_objc_getter field_name ret_typ_opt tenv cfg ret_ids pdesc pname loc args prop = +and sym_exec_objc_getter field_name ret_typ_opt tenv ret_ids pdesc pname loc args prop = L.d_strln ("No custom getter found. Executing the ObjC builtin getter with ivar "^ (Ident.fieldname_to_string field_name)^"."); let ret_id = @@ -1467,7 +1464,7 @@ and sym_exec_objc_getter field_name ret_typ_opt tenv cfg ret_ids pdesc pname loc ~report_deref_errors:false pname pdesc tenv ret_id field_access_exp ret_typ loc prop | _ -> raise (Exceptions.Wrong_argument_number __POS__) -and sym_exec_objc_setter field_name ret_typ_opt tenv cfg ret_ids pdesc pname loc args prop = +and sym_exec_objc_setter field_name _ tenv _ pdesc pname loc args prop = L.d_strln ("No custom setter found. Executing the ObjC builtin setter with ivar "^ (Ident.fieldname_to_string field_name)^"."); match args with @@ -1480,8 +1477,8 @@ and sym_exec_objc_setter field_name ret_typ_opt tenv cfg ret_ids pdesc pname loc execute_set ~report_deref_errors:false pname pdesc tenv field_access_exp typ2 lexp2 loc prop | _ -> raise (Exceptions.Wrong_argument_number __POS__) -and sym_exec_objc_accessor property_accesor ret_typ_opt tenv cfg ret_ids pdesc callee_pname loc args - prop path : Builtin.ret_typ = +and sym_exec_objc_accessor property_accesor ret_typ_opt tenv ret_ids pdesc _ loc args prop path + : Builtin.ret_typ = let f_accessor = match property_accesor with | ProcAttributes.Objc_getter field_name -> sym_exec_objc_getter field_name @@ -1489,7 +1486,7 @@ and sym_exec_objc_accessor property_accesor ret_typ_opt tenv cfg ret_ids pdesc c (* we want to execute in the context of the current procedure, not in the context of callee_pname, since this is the procname of the setter/getter method *) let cur_pname = Cfg.Procdesc.get_proc_name pdesc in - f_accessor ret_typ_opt tenv cfg ret_ids pdesc cur_pname loc args prop + f_accessor ret_typ_opt tenv ret_ids pdesc cur_pname loc args prop |> IList.map (fun p -> (p, path)) (** Perform symbolic execution for a function call *) @@ -1519,7 +1516,7 @@ and sym_exec_call cfg pdesc tenv pre path ret_ids actual_pars summary loc = let rec comb actual_pars formal_types = match actual_pars, formal_types with | [], [] -> actual_pars - | (e, t_e):: etl', t:: tl' -> + | (e, t_e):: etl', _:: tl' -> (e, t_e) :: comb etl' tl' | _,[] -> Errdesc.warning_err @@ -1545,11 +1542,11 @@ and sym_exec_call cfg pdesc tenv pre path ret_ids actual_pars summary loc = (* were the receiver is null and the semantics of the call is nop*) if (!Config.curr_language <> Config.Java) && !Config.objc_method_call_semantics && (Specs.get_attributes summary).ProcAttributes.is_objc_instance_method then - handle_objc_method_call actual_pars actual_params pre tenv cfg ret_ids pdesc callee_pname loc + handle_objc_method_call actual_pars actual_params pre tenv ret_ids pdesc callee_pname loc path Tabulation.exe_function_call else (* non-objective-c method call. Standard tabulation *) Tabulation.exe_function_call - tenv cfg ret_ids pdesc callee_pname loc actual_params pre path + tenv ret_ids pdesc callee_pname loc actual_params pre path end (** perform symbolic execution for a single prop, and check for junk *) @@ -1665,10 +1662,10 @@ module ModelBuiltins = struct [(prop, path)] (** model va_arg as always returning 0 *) - let execute___builtin_va_arg cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___builtin_va_arg cfg pdesc _ tenv prop path ret_ids args _ loc : Builtin.ret_typ = match args, ret_ids with - | [(lexp1, typ1); (lexp2, typ2); (lexp3, typ3)], _ -> + | [_; _; (lexp3, typ3)], _ -> let instr' = Sil.Set (lexp3, typ3, Sil.exp_zero, loc) in sym_exec_generated true cfg tenv pdesc [instr'] [(prop, path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) @@ -1693,7 +1690,7 @@ module ModelBuiltins = struct | [ret_id] -> Prop.conjoin_eq e (Sil.Var ret_id) prop | _ -> prop - let execute___get_array_size cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___get_array_size _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | [(lexp, typ)] when IList.length ret_ids <= 1 -> @@ -1706,7 +1703,7 @@ module ModelBuiltins = struct | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with - | Sil.Hpointsto(e, Sil.Earray(size, _, _), _) -> + | Sil.Hpointsto(_, Sil.Earray(size, _, _), _) -> [(return_result_for_array_size size prop ret_ids, path)] | _ -> [] with Not_found -> @@ -1726,7 +1723,7 @@ module ModelBuiltins = struct end | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute___set_array_size cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___set_array_size _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args, ret_ids with | [(lexp, typ); (size, _)], [] -> @@ -1736,7 +1733,7 @@ module ModelBuiltins = struct begin try let hpred, sigma' = IList.partition (function - | Sil.Hpointsto(e, _, t) -> Sil.exp_equal e n_lexp + | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with | [Sil.Hpointsto(e, Sil.Earray(_, esel, inst), t)] -> @@ -1762,11 +1759,11 @@ module ModelBuiltins = struct end | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute___print_value cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___print_value _ pdesc _ _ prop path _ args _ _ : Builtin.ret_typ = L.err "__print_value: "; let pname = Cfg.Procdesc.get_proc_name pdesc in - let do_arg (lexp, typ) = + let do_arg (lexp, _) = let n_lexp, _ = exp_norm_check_arith pname prop lexp in L.err "%a " (Sil.pp_exp pe_text) n_lexp in IList.iter do_arg args; @@ -1796,7 +1793,7 @@ module ModelBuiltins = struct let texp = Sil.Sizeof (typ'', Sil.Subtype.subtypes) in let hpred = Prop.mk_ptsto n_lexp sexp texp in Some hpred - | Sil.Tarray (typ', _) -> + | Sil.Tarray _ -> let size = Sil.Var(Ident.create_fresh Ident.kfootprint) in let sexp = mk_empty_array size in let texp = Sil.Sizeof (typ, Sil.Subtype.subtypes) in @@ -1827,7 +1824,7 @@ module ModelBuiltins = struct non_null_case else null_case @ non_null_case - let execute___get_type_of cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___get_type_of _ pdesc _ tenv _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | [(lexp, typ)] when IList.length ret_ids <= 1 -> @@ -1841,7 +1838,7 @@ module ModelBuiltins = struct | Sil.Hpointsto(e, _, _) -> Sil.exp_equal e n_lexp | _ -> false) (Prop.get_sigma prop) in match hpred with - | Sil.Hpointsto(e, _, texp) -> + | Sil.Hpointsto(_, _, texp) -> (return_result texp prop ret_ids), path | _ -> assert false with Not_found -> (return_result Sil.exp_zero prop ret_ids), path @@ -1865,23 +1862,22 @@ module ModelBuiltins = struct let prop''= Prop.replace_sigma_footprint (process_sigma sigma_fp) prop' in Prop.normalize prop'' - let execute___instanceof_cast - cfg pdesc instr tenv _prop path ret_ids args callee_pname loc instof + let execute___instanceof_cast _ pdesc _ tenv _prop path ret_ids args _ _ instof : Builtin.ret_typ = match args with - | [(_val1, typ1); (_texp2, typ2)] when IList.length ret_ids <= 1 -> + | [(_val1, typ1); (_texp2, _)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let val1, __prop = exp_norm_check_arith pname _prop _val1 in let texp2, prop = exp_norm_check_arith pname __prop _texp2 in let is_cast_to_reference = match typ1 with - | Sil.Tptr (base_typ, Sil.Pk_reference) -> true + | Sil.Tptr (_, Sil.Pk_reference) -> true | _ -> false in (* In Java, we throw an exception, in C++ we return 0 in case of a cast to a pointer, *) (* and throw an exception in case of a cast to a reference. *) let should_throw_exception = !Config.curr_language = Config.Java || is_cast_to_reference in - let deal_with_failed_cast val1 typ1 texp1 texp2 = + let deal_with_failed_cast val1 _ texp1 texp2 = Tabulation.raise_cast_exception __POS__ None texp1 texp2 val1 in let exe_one_prop prop = @@ -1921,7 +1917,7 @@ module ModelBuiltins = struct begin match pos_type_opt with | None -> deal_with_failed_cast val1 typ1 texp1 texp2 - | Some texp1' -> mk_res pos_type_opt val1 + | Some _ -> mk_res pos_type_opt val1 end else (* !Config.footprint = false *) begin @@ -1962,61 +1958,60 @@ module ModelBuiltins = struct [(prop', path)] (** Set the attibute of the value as file *) - let execute___set_file_attribute cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___set_file_attribute _ pdesc _ _ _prop path ret_ids args _ loc : Builtin.ret_typ = match args, ret_ids with - | [(lexp, typ)], _ -> + | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in set_resource_attribute prop path n_lexp loc Sil.Rfile | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the attibute of the value as lock *) - let execute___set_lock_attribute cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___set_lock_attribute _ pdesc _ _ _prop path ret_ids args _ loc : Builtin.ret_typ = match args, ret_ids with - | [(lexp, typ)], _ -> + | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in set_resource_attribute prop path n_lexp loc Sil.Rlock | _ -> 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 - cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___method_set_ignore_attribute _ pdesc _ _ _prop path ret_ids args _ loc : Builtin.ret_typ = match args, ret_ids with - | [_ ; (lexp, typ)], _ -> + | [_ ; (lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in set_resource_attribute prop path n_lexp loc Sil.Rignore | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Set the attibute of the value as memory *) - let execute___set_mem_attribute cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___set_mem_attribute _ pdesc _ _ _prop path ret_ids args _ loc : Builtin.ret_typ = match args, ret_ids with - | [(lexp, typ)], _ -> + | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in set_resource_attribute prop path n_lexp loc (Sil.Rmemory Sil.Mnew) | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** report an error if [lexp] is tainted; otherwise, add untained([lexp]) as a precondition *) - let execute___check_untainted cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___check_untainted _ pdesc _ _ prop path ret_ids args callee_pname _ : Builtin.ret_typ = match args, ret_ids with - | [(lexp, typ)], _ -> + | [(lexp, _)], _ -> let caller_pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith caller_pname prop lexp in [(check_untainted n_lexp caller_pname callee_pname prop, path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** take a pointer to a struct, and return the value of a hidden field in the struct *) - let execute___get_hidden_field cfg pdesc instr tenv _prop path ret_ids args callee_name loc + let execute___get_hidden_field _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with - | [(lexp, typ)] -> + | [(lexp, _)] -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in let ret_val = ref None in @@ -2033,7 +2028,8 @@ module ModelBuiltins = struct let se = Sil.Eexp(foot_e, Sil.inst_none) in let fsel' = (Ident.fieldname_hidden, se) :: fsel in Sil.Hpointsto(e, Sil.Estruct (fsel', inst), texp) - | Sil.Hpointsto(e, Sil.Estruct (fsel, _), texp) when Sil.exp_equal e n_lexp && not in_foot && has_fld_hidden fsel -> + | Sil.Hpointsto(e, Sil.Estruct (fsel, _), _) + when Sil.exp_equal e n_lexp && not in_foot && has_fld_hidden fsel -> let set_ret_val () = match IList.find filter_fld_hidden fsel with | _, Sil.Eexp(e, _) -> ret_val := Some e @@ -2049,10 +2045,10 @@ module ModelBuiltins = struct | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** take a pointer to a struct and a value, and set a hidden field in the struct to the given value *) - let execute___set_hidden_field cfg pdesc instr tenv _prop path ret_ids args callee_name loc + let execute___set_hidden_field _ pdesc _ _ _prop path _ args _ _ : Builtin.ret_typ = match args with - | [(lexp1, typ1); (lexp2, typ2)] -> + | [(lexp1, _); (lexp2, _)] -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp1, _prop1 = exp_norm_check_arith pname _prop lexp1 in let n_lexp2, prop = exp_norm_check_arith pname _prop1 lexp2 in @@ -2080,7 +2076,7 @@ module ModelBuiltins = struct (* Update the objective-c hidden counter by applying the operation op and the operand delta.*) (* Eg. op=+/- delta is an integer *) let execute___objc_counter_update - suppress_npe_report op delta cfg pdesc instr tenv _prop path ret_ids args callee_name loc + suppress_npe_report op delta cfg pdesc _ tenv _prop path _ args _ loc : Builtin.ret_typ = match args with | [(lexp, typ)] -> @@ -2114,7 +2110,7 @@ module ModelBuiltins = struct : Builtin.ret_typ = let suppress_npe_report, args' = get_suppress_npe_flag args in match args' with - | [(lexp, typ)] -> + | [(lexp, _)] -> let prop = return_result lexp _prop ret_ids in execute___objc_counter_update suppress_npe_report (Sil.PlusA) (Sil.Int.one) cfg pdesc instr tenv prop path ret_ids args' callee_name loc @@ -2147,11 +2143,10 @@ module ModelBuiltins = struct execute___objc_release_impl cfg pdesc instr tenv _prop path ret_ids args callee_name loc (** Set the attibute of the value as objc autoreleased *) - let execute___set_autorelease_attribute - cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___set_autorelease_attribute _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args, ret_ids with - | [(lexp, typ)], _ -> + | [(lexp, _)], _ -> let pname = Cfg.Procdesc.get_proc_name pdesc in let prop = return_result lexp _prop ret_ids in if !Config.objc_memory_model_on then @@ -2162,8 +2157,7 @@ module ModelBuiltins = struct | _ -> raise (Exceptions.Wrong_argument_number __POS__) (** Release all the objects in the pool *) - let execute___release_autorelease_pool - cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___release_autorelease_pool cfg pdesc instr tenv _prop path ret_ids _ callee_pname loc : Builtin.ret_typ = if !Config.objc_memory_model_on then let autoreleased_objects = Prop.get_atoms_with_attribute Sil.Aautorelease _prop in @@ -2176,7 +2170,7 @@ module ModelBuiltins = struct | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 exp | _ -> false) (Prop.get_sigma _prop) in match hpred with - | Sil.Hpointsto(_, _, Sil.Sizeof (typ, st)) -> + | Sil.Hpointsto(_, _, Sil.Sizeof (typ, _)) -> let res1 = execute___objc_release cfg pdesc instr tenv prop path ret_ids [(exp, typ)] callee_pname loc in @@ -2188,10 +2182,10 @@ module ModelBuiltins = struct else execute___no_op _prop path (** Set attibute att *) - let execute___set_attr att cfg pdesc instr tenv _prop path ret_ids args callee_name loc + let execute___set_attr att _ pdesc _ _ _prop path _ args _ _ : Builtin.ret_typ = match args with - | [(lexp, typ)] -> + | [(lexp, _)] -> let pname = Cfg.Procdesc.get_proc_name pdesc in let n_lexp, prop = exp_norm_check_arith pname _prop lexp in [(Prop.add_or_replace_exp_attribute prop n_lexp att, path)] @@ -2204,10 +2198,10 @@ module ModelBuiltins = struct execute___set_attr (Sil.Ataint pname) cfg pdesc instr tenv _prop path ret_ids args callee_name loc - let execute___objc_cast cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___objc_cast _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with - | [(_val1, typ1); (_texp2, typ2)] when IList.length ret_ids <= 1 -> + | [(_val1, _); (_texp2, _)] when IList.length ret_ids <= 1 -> let pname = Cfg.Procdesc.get_proc_name pdesc in let val1, __prop = exp_norm_check_arith pname _prop _val1 in let texp2, prop = exp_norm_check_arith pname __prop _texp2 in @@ -2216,26 +2210,26 @@ module ModelBuiltins = struct | Sil.Hpointsto(e1, _, _) -> Sil.exp_equal e1 val1 | _ -> false) (Prop.get_sigma prop) in match hpred, texp2 with - | Sil.Hpointsto(val1, _, texp1), Sil.Sizeof (typ, st) -> + | Sil.Hpointsto(val1, _, _), Sil.Sizeof (_, _) -> let prop' = replace_ptsto_texp prop val1 texp2 in [(return_result val1 prop' ret_ids, path)] | _ -> [(return_result val1 prop ret_ids, path)] with Not_found -> [(return_result val1 prop ret_ids, path)]) | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute_abort cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute_abort _ _ _ _ _ _ _ _ callee_pname _ : Builtin.ret_typ = raise (Exceptions.Precondition_not_found (Localise.verbatim_desc (Procname.to_string callee_pname), __POS__)) - let execute_exit cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute_exit _ _ _ _ prop path _ _ _ _ : Builtin.ret_typ = execute_diverge prop path - let _execute_free tenv mk loc acc iter = + let _execute_free mk loc acc iter = match Prop.prop_iter_current iter with - | (Sil.Hpointsto(lexp, se, _), []) -> + | (Sil.Hpointsto(lexp, _, _), []) -> let prop = Prop.prop_iter_remove_curr_then_to_prop iter in let pname = Sil.mem_dealloc_pname mk in let ra = { Sil.ra_kind = Sil.Rrelease; Sil.ra_res = Sil.Rmemory mk; Sil.ra_pname = pname; Sil.ra_loc = loc; Sil.ra_vpath = None } in @@ -2247,10 +2241,10 @@ module ModelBuiltins = struct lexp (Sil.Aresource ra) in p_res :: acc - | (Sil.Hpointsto _, o :: os) -> assert false (* alignment error *) + | (Sil.Hpointsto _, _ :: _) -> assert false (* alignment error *) | _ -> assert false (* should not happen *) - let _execute_free_nonzero mk pdesc tenv instr prop path lexp typ loc = + let _execute_free_nonzero mk pdesc tenv instr prop lexp typ loc = try begin match Prover.is_root prop lexp lexp with @@ -2259,7 +2253,7 @@ module ModelBuiltins = struct assert false | Some _ -> let prop_list = - IList.fold_left (_execute_free tenv mk loc) [] + IList.fold_left (_execute_free mk loc) [] (Rearrange.rearrange pdesc tenv lexp typ prop loc) in IList.rev prop_list end @@ -2272,7 +2266,7 @@ module ModelBuiltins = struct raise (Exceptions.Array_of_pointsto __POS__) end - let execute_free mk cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute_free mk _ pdesc instr tenv _prop path _ args _ loc : Builtin.ret_typ = match args with | [(lexp, typ)] -> @@ -2286,13 +2280,13 @@ module ModelBuiltins = struct let plist = prop_zero @ (* model: if 0 then skip else _execute_free_nonzero *) IList.flatten (IList.map (fun p -> - _execute_free_nonzero mk pdesc tenv instr p path + _execute_free_nonzero mk pdesc tenv instr p (Prop.exp_normalize_prop p lexp) typ loc) prop_nonzero) in IList.map (fun p -> (p, path)) plist end | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute_alloc mk can_return_null cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute_alloc mk can_return_null _ pdesc _ tenv _prop path ret_ids args _ loc : Builtin.ret_typ = let pname = Cfg.Procdesc.get_proc_name pdesc in let rec evaluate_char_sizeof e = match e with @@ -2338,10 +2332,10 @@ module ModelBuiltins = struct [(prop_alloc, path); (prop_null, path)] else [(prop_alloc, path)] - let execute_pthread_create cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute_pthread_create cfg pdesc _ tenv prop path ret_ids args _ loc : Builtin.ret_typ = match args with - | [thread; attr; start_routine; arg] -> + | [_; _; start_routine; arg] -> let routine_name = Prop.exp_normalize_prop prop (fst start_routine) in let routine_arg = Prop.exp_normalize_prop prop (fst arg) in (match routine_name, (snd start_routine) with @@ -2361,20 +2355,19 @@ module ModelBuiltins = struct [(prop, path)]) | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute_skip cfg pdesc instr tenv prop path ret_ids args callee_pname loc : Builtin.ret_typ = + let execute_skip _ _ _ _ prop path _ _ _ _ : Builtin.ret_typ = [(prop, path)] - let execute_scan_function - skip_n_arguments cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute_scan_function skip_n_arguments _ pdesc _ _ prop path ret_ids args callee_pname loc : Builtin.ret_typ = match args with | _ when IList.length args >= skip_n_arguments -> let varargs = ref args in for _ = 1 to skip_n_arguments do varargs := IList.tl !varargs done; - call_unknown_or_scan true cfg pdesc tenv prop path ret_ids None !varargs callee_pname loc + call_unknown_or_scan true pdesc prop path ret_ids None !varargs callee_pname loc | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute__unwrap_exception cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute__unwrap_exception _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | [(ret_exn, _)] -> @@ -2389,7 +2382,7 @@ module ModelBuiltins = struct end | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute_return_first_argument cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute_return_first_argument _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | (_arg1, _):: _ -> @@ -2399,13 +2392,13 @@ module ModelBuiltins = struct [(prop', path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute___split_get_nth cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___split_get_nth _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | [(lexp1, _); (lexp2, _); (lexp3, _)] -> let pname = Cfg.Procdesc.get_proc_name pdesc in - let n_lexp1, prop = exp_norm_check_arith pname _prop lexp1 in - let n_lexp2, prop = exp_norm_check_arith pname _prop lexp2 in + let n_lexp1, _ = exp_norm_check_arith pname _prop lexp1 in + let n_lexp2, _ = exp_norm_check_arith pname _prop lexp2 in let n_lexp3, prop = exp_norm_check_arith pname _prop lexp3 in (match n_lexp1, n_lexp2, n_lexp3 with | Sil.Const (Sil.Cstr str1), Sil.Const (Sil.Cstr str2), Sil.Const (Sil.Cint n_sil) -> @@ -2419,13 +2412,13 @@ module ModelBuiltins = struct | _ -> [(prop, path)]) | _ -> raise (Exceptions.Wrong_argument_number __POS__) - let execute___create_tuple cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___create_tuple _ _ _ _ prop path ret_ids args _ _ : Builtin.ret_typ = let el = IList.map fst args in let res = Sil.Const (Sil.Ctuple el) in [(return_result res prop ret_ids, path)] - let execute___tuple_get_nth cfg pdesc instr tenv _prop path ret_ids args callee_pname loc + let execute___tuple_get_nth _ pdesc _ _ _prop path ret_ids args _ _ : Builtin.ret_typ = match args with | [(lexp1, _); (lexp2, _)] -> @@ -2442,17 +2435,17 @@ module ModelBuiltins = struct (* forces the expression passed as parameter to be assumed true at the point where this builtin is called, blocks if this causes an inconsistency *) - let execute___infer_assume - cfg pdesc instr tenv prop path ret_ids args callee_pname loc: Builtin.ret_typ = + let execute___infer_assume _ _ _ _ prop path _ args _ _ + : Builtin.ret_typ = match args with - | [(lexp, typ)] -> + | [(lexp, _)] -> let prop_assume = Prop.conjoin_eq lexp (Sil.exp_bool true) prop in if Prover.check_inconsistency prop_assume then execute_diverge prop_assume path else [(prop_assume, path)] | _ -> raise (Exceptions.Wrong_argument_number __POS__) (* creates a named error state *) - let execute___infer_fail cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___infer_fail cfg pdesc _ tenv prop path _ args _ loc : Builtin.ret_typ = let error_str = match args with @@ -2469,7 +2462,7 @@ module ModelBuiltins = struct sym_exec_generated true cfg tenv pdesc [set_instr] [(prop, path)] (* translate builtin assertion failure *) - let execute___assert_fail cfg pdesc instr tenv prop path ret_ids args callee_pname loc + let execute___assert_fail cfg pdesc _ tenv prop path _ args _ loc : Builtin.ret_typ = let error_str = match args with @@ -2575,12 +2568,13 @@ module ModelBuiltins = struct let nsarray_typ = Sil.expand_type tenv nsarray_typ in execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsarray_typ loc - let execute_NSArray_arrayWithObjects_count cfg pdesc instr tenv prop path ret_ids args callee_pname loc = + let execute_NSArray_arrayWithObjects_count + cfg pdesc _ tenv prop path ret_ids args callee_pname loc = let n_formals = 1 in let res' = sym_exe_check_variadic_sentinel ~fails_on_nil: true cfg pdesc tenv prop path n_formals args (0,1) callee_pname loc in execute_objc_NSArray_alloc_no_fail cfg pdesc tenv res' ret_ids loc - let execute_NSArray_arrayWithObjects cfg pdesc instr tenv prop path ret_ids args callee_pname loc = + let execute_NSArray_arrayWithObjects cfg pdesc _ tenv prop path ret_ids args callee_pname loc = let n_formals = 1 in let res' = sym_exe_check_variadic_sentinel cfg pdesc tenv prop path n_formals args (0,1) callee_pname loc in execute_objc_NSArray_alloc_no_fail cfg pdesc tenv res' ret_ids loc @@ -2603,7 +2597,7 @@ module ModelBuiltins = struct Sil.expand_type tenv nsdictionary_typ in execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsdictionary_typ loc - let execute___objc_dictionary_literal cfg pdesc instr tenv prop path ret_ids args callee_pname loc = + let execute___objc_dictionary_literal cfg pdesc _ tenv prop path ret_ids args callee_pname loc = let n_formals = 1 in let res' = sym_exe_check_variadic_sentinel ~fails_on_nil: true cfg pdesc tenv prop path diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 1f69fb589..b3429d5bf 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -88,7 +88,7 @@ let spec_rename_vars pname spec = | Specs.Jprop.Joined (n, p, jp1, jp2) -> Specs.Jprop.Joined (n, prop_add_callee_suffix p, jp1, jp2) in let fav = Sil.fav_new () in Specs.Jprop.fav_add fav spec.Specs.pre; - IList.iter (fun (p, path) -> Prop.prop_fav_add fav p) spec.Specs.posts; + IList.iter (fun (p, _) -> Prop.prop_fav_add fav p) spec.Specs.posts; let ids = Sil.fav_to_list fav in let ids' = IList.map (fun i -> (i, Ident.create_fresh Ident.kprimed)) ids in let ren_sub = Sil.sub_of_list (IList.map (fun (i, i') -> (i, Sil.Var i')) ids') in @@ -211,7 +211,7 @@ let process_splitting actual_pre sub1 sub2 frame missing_pi missing_sigma frame_ false end else match hpred with - | Sil.Hpointsto(Sil.Var id, _, _) -> true + | Sil.Hpointsto(Sil.Var _, _, _) -> true | Sil.Hpointsto(Sil.Lvar pvar, _, _) -> Sil.pvar_is_global pvar | _ -> L.d_warning "Missing fields in complex pred: "; Sil.d_hpred hpred; L.d_ln (); @@ -336,7 +336,7 @@ let check_path_errors_in_post caller_pname post post_path = else current_path, None in (* position not found, only use the path up to the callee *) State.set_path new_path path_pos_opt; let exn = Exceptions.Divide_by_zero (desc, __POS__) in - let pre_opt = State.get_normalized_pre (fun te p -> p) (* Abs.abstract_no_symop *) in + let pre_opt = State.get_normalized_pre (fun _ p -> p) (* Abs.abstract_no_symop *) in Reporting.log_warning caller_pname ~pre: pre_opt exn | _ -> () in IList.iter check_attr (Prop.get_all_attributes post) @@ -350,8 +350,8 @@ let post_process_post | Some (Sil.Aresource ({ Sil.ra_kind = Sil.Rrelease })) -> true | _ -> false in let atom_update_alloc_attribute = function - | Sil.Aneq (e , Sil.Const (Sil.Cattribute (Sil.Aresource ({ Sil.ra_res = res } as ra)))) - | Sil.Aneq (Sil.Const (Sil.Cattribute (Sil.Aresource ({ Sil.ra_res = res } as ra))), e) + | Sil.Aneq (e , Sil.Const (Sil.Cattribute (Sil.Aresource ra))) + | Sil.Aneq (Sil.Const (Sil.Cattribute (Sil.Aresource ra)), e) when not (ra.Sil.ra_kind = Sil.Rrelease && actual_pre_has_freed_attribute e) -> (* unless it was already freed before the call *) let vpath, _ = Errdesc.vpath_find post e in let ra' = { ra with Sil.ra_pname = callee_pname; Sil.ra_loc = loc; Sil.ra_vpath = vpath } in @@ -409,9 +409,9 @@ and sexp_star_fld se1 se2 : Sil.strexp = match se1, se2 with | Sil.Estruct (fsel1, _), Sil.Estruct (fsel2, inst2) -> Sil.Estruct (fsel_star_fld fsel1 fsel2, inst2) - | Sil.Earray (size1, esel1, _), Sil.Earray (size2, esel2, inst2) -> + | Sil.Earray (size1, esel1, _), Sil.Earray (_, esel2, inst2) -> Sil.Earray (size1, esel_star_fld esel1 esel2, inst2) - | Sil.Eexp (e1, inst1), Sil.Earray (size2, esel2, _) -> + | Sil.Eexp (_, inst1), Sil.Earray (size2, esel2, _) -> let esel1 = [(Sil.exp_zero, se1)] in Sil.Earray (size2, esel_star_fld esel1 esel2, inst1) | _ -> @@ -424,7 +424,7 @@ let texp_star texp1 texp2 = let rec ftal_sub ftal1 ftal2 = match ftal1, ftal2 with | [], _ -> true | _, [] -> false - | (f1, t1, a1):: ftal1', (f2, t2, a2):: ftal2' -> + | (f1, _, _):: ftal1', (f2, _, _):: ftal2' -> begin match Ident.fieldname_compare f1 f2 with | n when n < 0 -> false | 0 -> ftal_sub ftal1' ftal2' @@ -453,7 +453,7 @@ let sigma_star_fld (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Sil.hpr (* L.out "@.@. computing %a@.STAR @.%a@.@." pp_sigma sigma1 pp_sigma sigma2; *) let rec star sg1 sg2 : Sil.hpred list = match sg1, sg2 with - | [], sigma2 -> [] + | [], _ -> [] | sigma1,[] -> sigma1 | hpred1:: sigma1', hpred2:: sigma2' -> begin @@ -470,13 +470,13 @@ let sigma_star_fld (sigma1 : Sil.hpred list) (sigma2 : Sil.hpred list) : Sil.hpr L.d_ln (); raise (Prop.Cannot_star __POS__) -let hpred_typing_lhs_compare hpred1 (e2, te2) = match hpred1 with +let hpred_typing_lhs_compare hpred1 (e2, _) = match hpred1 with | Sil.Hpointsto(e1, _, _) -> Sil.exp_compare e1 e2 | _ -> - 1 -let hpred_star_typing (hpred1 : Sil.hpred) (e2, te2) : Sil.hpred = +let hpred_star_typing (hpred1 : Sil.hpred) (_, te2) : Sil.hpred = match hpred1 with - | Sil.Hpointsto(e1, se1, te1) -> Sil.Hpointsto (e1, se1, te2) + | Sil.Hpointsto(e1, se1, _) -> Sil.Hpointsto (e1, se1, te2) | _ -> assert false (** Implementation of [*] between predicates and typings *) @@ -620,7 +620,7 @@ let include_subtrace callee_pname = (** combine the spec's post with a splitting and actual precondition *) let combine - cfg ret_ids (posts: ('a Prop.t * Paths.Path.t) list) + ret_ids (posts: ('a Prop.t * Paths.Path.t) list) actual_pre path_pre split caller_pdesc callee_pname loc = let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in @@ -688,29 +688,30 @@ let combine | None -> post_p2 | Some iter -> let filter = function - | Sil.Hpointsto (e, se, t) when Sil.exp_equal e callee_ret_pvar -> Some () + | Sil.Hpointsto (e, _, _) when Sil.exp_equal e callee_ret_pvar -> Some () | _ -> None in match Prop.prop_iter_find iter filter with | None -> post_p2 | Some iter' -> match fst (Prop.prop_iter_current iter') with - | Sil.Hpointsto (e, Sil.Eexp (e', inst), t) when exp_is_exn e' -> (* resuls is an exception: set in caller *) + | Sil.Hpointsto (_, Sil.Eexp (e', inst), _) when exp_is_exn e' -> + (* resuls is an exception: set in caller *) let p = Prop.prop_iter_remove_curr_then_to_prop iter' in prop_set_exn caller_pname p (Sil.Eexp (e', inst)) - | Sil.Hpointsto (e, Sil.Eexp (e', inst), t) when IList.length ret_ids = 1 -> + | Sil.Hpointsto (_, Sil.Eexp (e', _), _) when IList.length ret_ids = 1 -> let p = Prop.prop_iter_remove_curr_then_to_prop iter' in Prop.conjoin_eq e' (Sil.Var (IList.hd ret_ids)) p - | Sil.Hpointsto (e, Sil.Estruct (ftl, _), t) + | Sil.Hpointsto (_, Sil.Estruct (ftl, _), _) when IList.length ftl = IList.length ret_ids -> let rec do_ftl_ids p = function | [], [] -> p - | (f, Sil.Eexp (e', inst')):: ftl', ret_id:: ret_ids' -> + | (_, Sil.Eexp (e', _)):: ftl', ret_id:: ret_ids' -> let p' = Prop.conjoin_eq e' (Sil.Var ret_id) p in do_ftl_ids p' (ftl', ret_ids') | _ -> p in let p = Prop.prop_iter_remove_curr_then_to_prop iter' in do_ftl_ids p (ftl, ret_ids) - | Sil.Hpointsto (e, _, t) -> (** returning nothing or unexpected sexp, turning into nondet *) + | Sil.Hpointsto _ -> (** returning nothing or unexpected sexp, turning into nondet *) Prop.prop_iter_remove_curr_then_to_prop iter' | _ -> assert false in let post_p4 = @@ -848,7 +849,7 @@ let inconsistent_actualpre_missing actual_pre split_opt = (* perform the taint analysis check by comparing the taint atoms in [calling_pi] with the untaint atoms required by the [missing_pi] computed during abduction *) -let do_taint_check caller_pname callee_pname calling_pi missing_pi sub prop = +let do_taint_check caller_pname callee_pname calling_pi missing_pi sub = (* get a version of [missing_pi] whose var names match the names in calling pi *) let missing_pi_sub = Prop.pi_sub sub missing_pi in let combined_pi = calling_pi @ missing_pi_sub in @@ -923,7 +924,7 @@ let check_uninitialize_dangling_deref callee_pname actual_pre sub formal_params (** Perform symbolic execution for a single spec *) let exe_spec - tenv cfg ret_ids (n, nspecs) caller_pdesc callee_pname loc prop path_pre + tenv ret_ids (n, nspecs) caller_pdesc callee_pname loc prop path_pre (spec : Prop.exposed Specs.spec) actual_params formal_params : abduction_res = let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in let posts = mk_posts ret_ids prop callee_pname spec.Specs.posts in @@ -944,12 +945,12 @@ let exe_spec let do_split () = let missing_pi' = if !Config.taint_analysis then - do_taint_check caller_pname callee_pname (Prop.get_pi actual_pre) missing_pi sub2 prop + do_taint_check caller_pname callee_pname (Prop.get_pi actual_pre) missing_pi sub2 else missing_pi in process_splitting actual_pre sub1 sub2 frame missing_pi' missing_sigma frame_fld missing_fld frame_typ missing_typ in let report_valid_res split = match combine - cfg ret_ids posts + ret_ids posts actual_pre path_pre split caller_pdesc callee_pname loc with | None -> Invalid_res Cannot_combine @@ -1033,7 +1034,7 @@ let prop_pure_to_footprint (p: 'a Prop.t) : Prop.normal Prop.t = Prop.normalize (Prop.replace_pi_footprint (Prop.get_pi_footprint p @ new_footprint_atoms) p) (** post-process the raw result of a function call *) -let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop results = +let exe_call_postprocess ret_ids trace_call callee_pname loc results = let filter_valid_res = function | Invalid_res _ -> false | Valid_res _ -> true in @@ -1042,10 +1043,10 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r let valid_res = IList.map (function Valid_res cr -> cr | Invalid_res _ -> assert false) valid_res0 in let invalid_res = - IList.map (function Valid_res cr -> assert false | Invalid_res ir -> ir) invalid_res0 in + IList.map (function Valid_res _ -> assert false | Invalid_res ir -> ir) invalid_res0 in let valid_res_miss_pi, valid_res_no_miss_pi = IList.partition (fun vr -> vr.vr_pi != []) valid_res in - let valid_res_incons_pre_missing, valid_res_cons_pre_missing = + let _, valid_res_cons_pre_missing = IList.partition (fun vr -> vr.incons_pre_missing) valid_res in let deref_errors = IList.filter (function Dereference_error _ -> true | _ -> false) invalid_res in let print_pi pi = @@ -1082,11 +1083,11 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r else if Localise.is_field_not_null_checked_desc desc then raise (Exceptions.Field_not_null_checked (desc, __POS__)) else raise (Exceptions.Null_dereference (desc, __POS__)) - | Dereference_error (Deref_freed ra, desc, path_opt) -> + | Dereference_error (Deref_freed _, desc, path_opt) -> trace_call Specs.CallStats.CR_not_met; extend_path path_opt None; raise (Exceptions.Use_after_free (desc, __POS__)) - | Dereference_error (Deref_undef (s, loc, pos), desc, path_opt) -> + | Dereference_error (Deref_undef (_, _, pos), desc, path_opt) -> trace_call Specs.CallStats.CR_not_met; extend_path path_opt (Some pos); raise (Exceptions.Skip_pointer_dereference (desc, __POS__)) @@ -1156,7 +1157,7 @@ let exe_call_postprocess tenv ret_ids trace_call callee_pname loc initial_prop r | _ -> res (** Execute the function call and return the list of results with return value *) -let exe_function_call tenv cfg ret_ids caller_pdesc callee_pname loc actual_params prop path = +let exe_function_call tenv ret_ids caller_pdesc callee_pname loc actual_params prop path = let caller_pname = Cfg.Procdesc.get_proc_name caller_pdesc in let trace_call res = match Specs.get_summary caller_pname with @@ -1169,9 +1170,11 @@ let exe_function_call tenv cfg ret_ids caller_pdesc callee_pname loc actual_para L.d_strln ("Found " ^ string_of_int nspecs ^ " specs for function " ^ Procname.to_string callee_pname); L.d_strln ("START EXECUTING SPECS FOR " ^ Procname.to_string callee_pname ^ " from state"); Prop.d_prop prop; L.d_ln (); - let exe_one_spec (n, spec) = exe_spec tenv cfg ret_ids (n, nspecs) caller_pdesc callee_pname loc prop path spec actual_params formal_params in + let exe_one_spec (n, spec) = + exe_spec tenv ret_ids (n, nspecs) caller_pdesc callee_pname loc prop path + spec actual_params formal_params in let results = IList.map exe_one_spec spec_list in - exe_call_postprocess tenv ret_ids trace_call callee_pname loc prop results + exe_call_postprocess ret_ids trace_call callee_pname loc results (* let check_splitting_precondition sub1 sub2 = diff --git a/infer/src/backend/tabulation.mli b/infer/src/backend/tabulation.mli index c392eef2d..5644a2bec 100644 --- a/infer/src/backend/tabulation.mli +++ b/infer/src/backend/tabulation.mli @@ -40,7 +40,7 @@ val d_splitting : splitting -> unit (** Execute the function call and return the list of results with return value *) val exe_function_call: - Sil.tenv -> Cfg.cfg -> Ident.t list -> Cfg.Procdesc.t -> Procname.t -> Location.t -> + Sil.tenv -> Ident.t list -> Cfg.Procdesc.t -> Procname.t -> Location.t -> (Sil.exp * Sil.typ) list -> Prop.normal Prop.t -> Paths.Path.t -> (Prop.normal Prop.t * Paths.Path.t) list diff --git a/infer/src/backend/utils.ml b/infer/src/backend/utils.ml index 48dcce0e4..d8aa1e6e3 100644 --- a/infer/src/backend/utils.ml +++ b/infer/src/backend/utils.ml @@ -112,13 +112,13 @@ type printenv = { } (** Create a colormap of a given color *) -let colormap_from_color color (o: Obj.t) = color +let colormap_from_color color (_: Obj.t) = color (** standard colormap: black *) -let colormap_black (o: Obj.t) = Black +let colormap_black (_: Obj.t) = Black (** red colormap *) -let colormap_red (o: Obj.t) = Red +let colormap_red (_: Obj.t) = Red (** Default text print environment *) let pe_text = @@ -552,9 +552,9 @@ module FileNormalize = struct let rec normalize done_l todo_l = match done_l, todo_l with | _, y :: tl when y = Filename.current_dir_name -> (* path/. --> path *) normalize done_l tl - | [root], y :: tl when y = Filename.parent_dir_name -> (* /.. --> / *) + | [_], y :: tl when y = Filename.parent_dir_name -> (* /.. --> / *) normalize done_l tl - | x :: dl, y :: tl when y = Filename.parent_dir_name -> (* path/x/.. --> path *) + | _ :: dl, y :: tl when y = Filename.parent_dir_name -> (* path/x/.. --> path *) normalize dl tl | _, y :: tl -> normalize (y :: done_l) tl | _, [] -> IList.rev done_l diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 56fefacbf..283c9f9dc 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -37,7 +37,7 @@ let get_field_type_and_annotation fn = function | Sil.Tptr (Sil.Tstruct struct_typ, _) | Sil.Tstruct struct_typ -> (try - let (_, t, a) = IList.find (fun (f, t, a) -> + let (_, t, a) = IList.find (fun (f, _, _) -> Sil.fld_equal f fn) (struct_typ.Sil.instance_fields @ struct_typ.Sil.static_fields) in Some (t, a) @@ -45,7 +45,7 @@ let get_field_type_and_annotation fn = function | _ -> None let ia_iter f = - let ann_iter (a, b) = f a in + let ann_iter (a, _) = f a in IList.iter ann_iter let ma_iter f ((ia, ial) : Sil.method_annotation) = diff --git a/infer/src/checkers/callbackChecker.ml b/infer/src/checkers/callbackChecker.ml index 38b5e7207..89ff95416 100644 --- a/infer/src/checkers/callbackChecker.ml +++ b/infer/src/checkers/callbackChecker.ml @@ -67,7 +67,7 @@ let callback_checker_main Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string (Procname.java_get_class proc_name)) in match Sil.tenv_lookup tenv typename with - | Some (Sil.Tstruct { Sil.csu; struct_name = Some class_name; def_methods } as typ) -> + | Some (Sil.Tstruct { struct_name = Some _; def_methods } as typ) -> let lifecycle_typs = get_or_create_lifecycle_typs tenv in let proc_belongs_to_lifecycle_typ = IList.exists (fun lifecycle_typ -> AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv) @@ -88,7 +88,7 @@ let callback_checker_main else Procname.Set.add callback_proc callback_procs) callback_procs def_methods' - | typ -> callback_procs) + | _ -> callback_procs) !registered_callback_procs registered_callback_typs in registered_callback_procs := registered_callback_procs'; diff --git a/infer/src/checkers/checkDeadCode.ml b/infer/src/checkers/checkDeadCode.ml index cd592a619..90ce6dd3b 100644 --- a/infer/src/checkers/checkDeadCode.ml +++ b/infer/src/checkers/checkDeadCode.ml @@ -65,7 +65,7 @@ let report_error description pn pd loc = (** Check the final state at the end of the analysis. *) -let check_final_state proc_name proc_desc exit_node final_s = +let check_final_state proc_name proc_desc final_s = let proc_nodes = Cfg.Procdesc.get_nodes proc_desc in let tot_nodes = IList.length proc_nodes in let tot_visited = State.num_visited final_s in @@ -94,7 +94,7 @@ let callback_check_dead_code { Callbacks.proc_desc; proc_name } = let equal = State.equal let join = State.join let do_node = do_node - let proc_throws pn = DontKnow + let proc_throws _ = DontKnow end) in let do_check () = @@ -105,7 +105,7 @@ let callback_check_dead_code { Callbacks.proc_desc; proc_name } = match transitions exit_node with | DFDead.Transition (pre_final_s, _, _) -> let final_s = State.add_visited exit_node pre_final_s in - check_final_state proc_name proc_desc exit_node final_s + check_final_state proc_name proc_desc final_s | DFDead.Dead_state -> () end in diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 577f8dc74..972ce9862 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -170,7 +170,7 @@ let report_calls_and_accesses callback node instr = (Format.sprintf "field access %s.%s:%s in %s@." bt fn ft callee) | None -> match PatternMatch.get_java_method_call_formal_signature instr with - | Some (bt, fn, ats, rt) -> + | Some (bt, fn, _, rt) -> ST.report_error proc_name proc_desc @@ -184,7 +184,7 @@ let callback_check_access { Callbacks.proc_desc } = Cfg.Procdesc.iter_instrs (report_calls_and_accesses "PROC") proc_desc (** Report all field accesses and method calls of a class. *) -let callback_check_cluster_access all_procs get_proc_desc proc_definitions = +let callback_check_cluster_access all_procs get_proc_desc _ = IList.iter (Option.may (fun d -> Cfg.Procdesc.iter_instrs (report_calls_and_accesses "CLUSTER") d)) (IList.map get_proc_desc all_procs) @@ -211,7 +211,7 @@ let callback_check_write_to_parcel { Callbacks.proc_desc; proc_name; idenv; get_ IList.filter is_parcel_constructor def_methods | _ -> [] in - let check r_name r_desc w_name w_desc = + let check r_desc w_desc = let is_serialization_node node = match Cfg.Node.get_callees node with @@ -246,25 +246,24 @@ let callback_check_write_to_parcel { Callbacks.proc_desc; proc_name; idenv; get_ L.stdout "Serialization missmatch in %a for %a and %a@." Procname.pp proc_name Procname.pp rc Procname.pp wc else check_match (rcs, wcs) - | rc:: rcs, [] -> + | rc:: _, [] -> L.stdout "Missing write in %a: for %a@." Procname.pp proc_name Procname.pp rc - | _, wc:: wcs -> + | _, wc:: _ -> L.stdout "Missing read in %a: for %a@." Procname.pp proc_name Procname.pp wc | _ -> () in check_match (r_call_descs, w_call_descs) in - let do_instr node instr = match instr with - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (_this_exp, this_type):: args, loc, cf) -> + let do_instr _ instr = match instr with + | Sil.Call (_, Sil.Const (Sil.Cfun _), (_this_exp, this_type):: _, _, _) -> let this_exp = Idenv.expand_expr idenv _this_exp in if is_write_to_parcel this_exp this_type then begin if !verbose then L.stdout "Serialization check for %a@." Procname.pp proc_name; try match parcel_constructors this_type with - | x :: xs -> + | x :: _ -> (match get_proc_desc x with - | Some x_proc_desc -> - check x x_proc_desc proc_name proc_desc + | Some x_proc_desc -> check x_proc_desc proc_desc | None -> raise Not_found) | _ -> L.stdout "No parcel constructor found for %a@." Procname.pp proc_name with Not_found -> if !verbose then L.stdout "Methods not available@." @@ -330,8 +329,8 @@ let callback_monitor_nullcheck { Callbacks.proc_desc; idenv; proc_name } = L.stdout "%a@." (PP.pp_loc_range linereader 10 10) loc end in - let do_instr node instr = match instr with - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (_arg1, t1):: arg_ts, loc, cf) when is_nullcheck pn -> + let do_instr _ instr = match instr with + | Sil.Call (_, Sil.Const (Sil.Cfun pn), (_arg1, _):: _, _, _) when is_nullcheck pn -> let arg1 = Idenv.expand_expr idenv _arg1 in if is_formal_param arg1 then handle_check_of_formal arg1; if !verbose then L.stdout "call in %s %s: %a with first arg: %a@." (Procname.java_get_class proc_name) (Procname.java_get_method proc_name) (Sil.pp_instr pe_text) instr (Sil.pp_exp pe_text) arg1 @@ -386,30 +385,30 @@ let callback_find_deserialization { Callbacks.proc_desc; get_proc_desc; idenv; p | None -> "?" in let get_actual_arguments node instr = match instr with - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (te, tt):: args, loc, cf) -> + | Sil.Call (_, Sil.Const (Sil.Cfun _), _:: args, _, _) -> (try - let find_const exp typ = + let find_const exp = let expanded = Idenv.expand_expr idenv exp in match expanded with | Sil.Const (Sil.Cclass n) -> Ident.name_to_string n - | Sil.Lvar p -> ( + | Sil.Lvar _ -> ( let is_call_instr set call = match set, call with | Sil.Set (_, _, Sil.Var (i1), _), Sil.Call (i2::[], _, _, _, _) when Ident.equal i1 i2 -> true | _ -> false in let is_set_instr = function - | Sil.Set (e1, t, e2, l) when Sil.exp_equal expanded e1 -> true + | Sil.Set (e1, _, _, _) when Sil.exp_equal expanded e1 -> true | _ -> false in match reverse_find_instr is_set_instr node with (** Look for ivar := tmp *) | Some s -> ( match reverse_find_instr (is_call_instr s) node with (** Look for tmp := foo() *) - | Some (Sil.Call (_, Sil.Const (Sil.Cfun pn), _, l, _)) -> get_return_const pn + | Some (Sil.Call (_, Sil.Const (Sil.Cfun pn), _, _, _)) -> get_return_const pn | _ -> "?") | _ -> "?") | _ -> "?" in - let arg_name (exp, typ) = find_const exp typ in + let arg_name (exp, _) = find_const exp in Some (IList.map arg_name args) with _ -> None) | _ -> None in @@ -459,7 +458,7 @@ let callback_check_field_access { Callbacks.proc_desc } = | Sil.Cast (_, e) -> do_exp is_read e | Sil.Lvar _ -> () - | Sil.Lfield (e, fn, t) -> + | Sil.Lfield (e, fn, _) -> if not (Ident.java_fieldname_is_outer_instance fn) then L.stdout "field %s %s@." (Ident.fieldname_to_string fn) (if is_read then "reading" else "writing"); do_exp is_read e @@ -469,7 +468,7 @@ let callback_check_field_access { Callbacks.proc_desc } = | Sil.Sizeof _ -> () in let do_read_exp = do_exp true in let do_write_exp = do_exp false in - let do_instr node = function + let do_instr _ = function | Sil.Letderef (_, e, _, _) -> do_read_exp e | Sil.Set (e1, _, e2, _) -> @@ -492,7 +491,7 @@ let callback_check_field_access { Callbacks.proc_desc } = (** Print c method calls. *) let callback_print_c_method_calls { Callbacks.proc_desc; proc_name } = let do_instr node = function - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (e, t):: args, loc, cf) + | Sil.Call (_, Sil.Const (Sil.Cfun pn), (e, _):: _, loc, _) when Procname.is_c_method pn -> let receiver = match Errdesc.exp_rv_dexp node e with | Some de -> Sil.dexp_to_string de diff --git a/infer/src/checkers/codeQuery.ml b/infer/src/checkers/codeQuery.ml index 5cb572bb0..0d39ea293 100644 --- a/infer/src/checkers/codeQuery.ml +++ b/infer/src/checkers/codeQuery.ml @@ -100,7 +100,7 @@ module Match = struct | CodeQueryAst.Null, Vval e -> Sil.exp_equal e Sil.exp_zero | CodeQueryAst.Null, _ -> false | CodeQueryAst.ConstString s, (Vfun pn) -> string_contains s (Procname.to_string pn) - | CodeQueryAst.ConstString s, _ -> false + | CodeQueryAst.ConstString _, _ -> false | CodeQueryAst.Ident id, x -> env_add env id x @@ -158,7 +158,7 @@ module Match = struct | Some s -> s in Err.add_error_to_spec proc_name err_name node loc - let rec match_query show env idenv node caller_pn (rule, action) proc_name node instr = + let rec match_query show env idenv caller_pn (rule, action) proc_name node instr = match rule, instr with | CodeQueryAst.Call (ae1, ae2), Sil.Call (_, Sil.Const (Sil.Cfun pn), _, loc, _) -> if exp_match env ae1 (Vfun caller_pn) && exp_match env ae2 (Vfun pn) then @@ -168,9 +168,10 @@ module Match = struct end else false | CodeQueryAst.Call _, _ -> false - | CodeQueryAst.MethodCall (ae1, ae2, ael_opt), Sil.Call (_, Sil.Const (Sil.Cfun pn), (_e1, t1):: params, loc, { Sil.cf_virtual = true }) -> + | CodeQueryAst.MethodCall (ae1, ae2, ael_opt), + Sil.Call (_, Sil.Const (Sil.Cfun pn), (_e1, _):: params, loc, { Sil.cf_virtual = true }) -> let e1 = Idenv.expand_expr idenv _e1 in - let vl = IList.map (function _e, t -> Vval (Idenv.expand_expr idenv _e)) params in + let vl = IList.map (function _e, _ -> Vval (Idenv.expand_expr idenv _e)) params in if exp_match env ae1 (Vval e1) && exp_match env ae2 (Vfun pn) && opt_match exp_list_match env ael_opt vl then begin if show then print_action env action proc_name node loc; @@ -178,13 +179,14 @@ module Match = struct end else false | CodeQueryAst.MethodCall _, _ -> false - | CodeQueryAst.If (ae1, op, ae2, body_rule), Sil.Prune (cond, loc, true_branch, ik) -> + | CodeQueryAst.If (ae1, op, ae2, body_rule), Sil.Prune (cond, loc, true_branch, _) -> if true_branch && cond_match env idenv cond (ae1, op, ae2) then begin let found = ref false in - let iter (node', instr') = + let iter (_, instr') = let env' = env_copy env in - if not !found && match_query false env' idenv node' caller_pn (body_rule, action) proc_name node instr' + if not !found + && match_query false env' idenv caller_pn (body_rule, action) proc_name node instr' then found := true in iter_succ_nodes node iter; let line_contains_null () = @@ -206,7 +208,8 @@ end let code_query_callback { Callbacks.proc_desc; idenv; proc_name } = let do_instr node instr = let env = Match.init_env () in - let _found = Match.match_query true env idenv node proc_name (Lazy.force query_ast) proc_name node instr in + let _found = + Match.match_query true env idenv proc_name (Lazy.force query_ast) proc_name node instr in () in if verbose then L.stdout "code_query_callback on %a@." Procname.pp proc_name; Cfg.Procdesc.iter_instrs do_instr proc_desc; diff --git a/infer/src/checkers/constantPropagation.ml b/infer/src/checkers/constantPropagation.ml index 09e1b7d5c..3a240396a 100644 --- a/infer/src/checkers/constantPropagation.ml +++ b/infer/src/checkers/constantPropagation.ml @@ -14,7 +14,7 @@ let string_widening_limit = 1000 let verbose = false (* Merge two constant maps by adding keys as necessary *) -let merge_values key c1_opt c2_opt = +let merge_values _ c1_opt c2_opt = match c1_opt, c2_opt with | Some (Some c1), Some (Some c2) when Sil.const_equal c1 c2 -> Some (Some c1) | Some c, None @@ -43,7 +43,7 @@ module ConstantFlow = Dataflow.MakeDF(struct let join = ConstantMap.merge merge_values - let proc_throws pn = Dataflow.DontKnow + let proc_throws _ = Dataflow.DontKnow let do_node node constants = diff --git a/infer/src/checkers/dataflow.ml b/infer/src/checkers/dataflow.ml index c79869992..310569349 100644 --- a/infer/src/checkers/dataflow.ml +++ b/infer/src/checkers/dataflow.ml @@ -46,15 +46,15 @@ let node_throws node (proc_throws : Procname.t -> throws) : throws = let ret_pvar = Cfg.Procdesc.get_ret_var pdesc in Sil.pvar_equal pvar ret_pvar in match instr with - | Sil.Set (Sil.Lvar pvar, typ, Sil.Const (Sil.Cexn _), loc) when pvar_is_return pvar -> + | Sil.Set (Sil.Lvar pvar, _, Sil.Const (Sil.Cexn _), _) when pvar_is_return pvar -> (* assignment to return variable is an artifact of a throw instruction *) Throws - | Sil.Call (_, Sil.Const (Sil.Cfun callee_pn), args, loc, _) + | Sil.Call (_, Sil.Const (Sil.Cfun callee_pn), _, _, _) when SymExec.function_is_builtin callee_pn -> if Procname.equal callee_pn SymExec.ModelBuiltins.__cast then DontKnow else DoesNotThrow - | Sil.Call (_, Sil.Const (Sil.Cfun callee_pn), args, loc, _) -> + | Sil.Call (_, Sil.Const (Sil.Cfun callee_pn), _, _, _) -> proc_throws callee_pn | _ -> DoesNotThrow in @@ -173,11 +173,11 @@ let callback_test_dataflow { Callbacks.proc_desc } = let do_node n s = if verbose then L.stdout "visiting node %a with state %d@." Cfg.Node.pp n s; [s + 1], [s + 1] - let proc_throws pn = DoesNotThrow + let proc_throws _ = DoesNotThrow end) in let transitions = DFCount.run proc_desc 0 in let do_node node = match transitions node with - | DFCount.Transition (pre_state, _, _) -> () + | DFCount.Transition _ -> () | DFCount.Dead_state -> () in IList.iter do_node (Cfg.Procdesc.get_nodes proc_desc) diff --git a/infer/src/checkers/idenv.ml b/infer/src/checkers/idenv.ml index fcc22efda..bde322e05 100644 --- a/infer/src/checkers/idenv.ml +++ b/infer/src/checkers/idenv.ml @@ -13,10 +13,10 @@ type t = (Sil.exp Ident.IdentHash.t) Lazy.t * Cfg.cfg -let _create cfg proc_desc = +let _create proc_desc = let map = Ident.IdentHash.create 1 in - let do_instr node = function - | Sil.Letderef (id, e, t, loc) -> + let do_instr _ = function + | Sil.Letderef (id, e, _, _) -> Ident.IdentHash.add map id e | _ -> () in Cfg.Procdesc.iter_instrs do_instr proc_desc; @@ -24,12 +24,12 @@ let _create cfg proc_desc = (* lazy implementation, only create when used *) let create cfg proc_desc = - let map = lazy (_create cfg proc_desc) in + let map = lazy (_create proc_desc) in map, cfg (* create an idenv for another procedure *) let create_from_idenv (_, cfg) proc_desc = - let map = lazy (_create cfg proc_desc) in + let map = lazy (_create proc_desc) in map, cfg let lookup (_map, _) id = diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index b2b58abea..16346e4c0 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -33,7 +33,7 @@ let is_direct_subtype_of this_type super_type_name = (** The type the method is invoked on *) let get_this_type proc_attributes = match proc_attributes.ProcAttributes.formals with - | (n, t):: args -> Some t + | (_, t):: _ -> Some t | _ -> None let type_get_direct_supertypes = function @@ -137,7 +137,7 @@ let get_vararg_type_names (Sil.pvar_equal ivar iv && Ident.equal t1 t2 && Procname.equal pn (Procname.from_string_c_fun "__new_array")) || initializes_array is - | i:: is -> initializes_array is + | _:: is -> initializes_array is | _ -> false in (* Get the type name added to ivar or None *) @@ -146,10 +146,10 @@ let get_vararg_type_names match instrs with | Sil.Letderef (nv, Sil.Lfield (_, id, t), _, _):: _ when Ident.equal nv nvar -> get_field_type_name t id - | Sil.Letderef (nv, e, t, _):: _ + | Sil.Letderef (nv, _, t, _):: _ when Ident.equal nv nvar -> Some (get_type_name t) - | i:: is -> nvar_type_name nvar is + | _:: is -> nvar_type_name nvar is | _ -> None in let rec added_nvar array_nvar instrs = match instrs with @@ -157,14 +157,14 @@ let get_vararg_type_names when Ident.equal iv array_nvar -> nvar_type_name nvar (Cfg.Node.get_instrs node) | Sil.Set (Sil.Lindex (Sil.Var iv, _), _, Sil.Const c, _):: _ when Ident.equal iv array_nvar -> Some (java_get_const_type_name c) - | i:: is -> added_nvar array_nvar is + | _:: is -> added_nvar array_nvar is | _ -> None in let rec array_nvar instrs = match instrs with | Sil.Letderef (nv, Sil.Lvar iv, _, _):: _ when Sil.pvar_equal iv ivar -> added_nvar nv instrs - | i:: is -> array_nvar is + | _:: is -> array_nvar is | _ -> None in array_nvar (Cfg.Node.get_instrs node) in @@ -181,7 +181,7 @@ let get_vararg_type_names IList.rev (type_names call_node) -let has_formal_proc_argument_type_names proc_desc proc_name argument_type_names = +let has_formal_proc_argument_type_names proc_desc argument_type_names = let formals = Cfg.Procdesc.get_formals proc_desc in let equal_formal_arg (_, typ) arg_type_name = get_type_name typ = arg_type_name in IList.length formals = IList.length argument_type_names @@ -189,7 +189,7 @@ let has_formal_proc_argument_type_names proc_desc proc_name argument_type_names let has_formal_method_argument_type_names cfg proc_name argument_type_names = has_formal_proc_argument_type_names - cfg proc_name ((Procname.java_get_class proc_name):: argument_type_names) + cfg ((Procname.java_get_class proc_name):: argument_type_names) let is_getter proc_name = Str.string_match (Str.regexp "get*") (Procname.java_get_method proc_name) 0 @@ -199,16 +199,16 @@ let is_setter proc_name = (** Returns the signature of a field access (class name, field name, field type name) *) let get_java_field_access_signature = function - | Sil.Letderef (id, Sil.Lfield (e, fn, ft), bt, loc) -> + | Sil.Letderef (_, Sil.Lfield (_, fn, ft), bt, _) -> Some (get_type_name bt, Ident.java_fieldname_get_field fn, get_type_name ft) | _ -> None (** Returns the formal signature (class name, method name, argument type names and return type name) *) let get_java_method_call_formal_signature = function - | Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (te, tt):: args, loc, cf) -> + | Sil.Call (_, Sil.Const (Sil.Cfun pn), (_, tt):: args, _, _) -> (try - let arg_names = IList.map (function | e, t -> get_type_name t) args in + let arg_names = IList.map (function | _, t -> get_type_name t) args in let rt_name = Procname.java_get_return_type pn in let m_name = Procname.java_get_method pn in Some (get_type_name tt, m_name, arg_names, rt_name) @@ -262,7 +262,7 @@ let method_is_initializer | None -> false (** Get the vararg values by looking for array assignments to the pvar. *) -let java_get_vararg_values node pvar idenv pdesc = +let java_get_vararg_values node pvar idenv = let values = ref [] in let do_instr = function | Sil.Set (Sil.Lindex (array_exp, _), _, content_exp, _) @@ -274,13 +274,13 @@ let java_get_vararg_values node pvar idenv pdesc = IList.iter do_instr (Cfg.Node.get_instrs n) in let () = match Errdesc.find_program_variable_assignment node pvar with | Some (node', _) -> - Cfg.Procdesc.iter_slope_range do_node pdesc node' node + Cfg.Procdesc.iter_slope_range do_node node' node | None -> () in !values -let proc_calls resolve_attributes pname pdesc filter : (Procname.t * ProcAttributes.t) list = +let proc_calls resolve_attributes pdesc filter : (Procname.t * ProcAttributes.t) list = let res = ref [] in - let do_instruction node instr = match instr with + let do_instruction _ instr = match instr with | Sil.Call (_, Sil.Const (Sil.Cfun callee_pn), _, _, _) -> begin match resolve_attributes callee_pn with @@ -329,7 +329,7 @@ let proc_iter_overridden_methods f tenv proc_name = let get_fields_nullified procdesc = (* walk through the instructions and look for instance fields that are assigned to null *) let collect_nullified_flds (nullified_flds, this_ids) _ = function - | Sil.Set (Sil.Lfield (Sil.Var lhs, fld, _), typ, rhs, loc) + | Sil.Set (Sil.Lfield (Sil.Var lhs, fld, _), _, rhs, _) when Sil.exp_is_null_literal rhs && Ident.IdentSet.mem lhs this_ids -> (Ident.FieldSet.add fld nullified_flds, this_ids) | Sil.Letderef (id, rhs, _, _) when Sil.exp_is_this rhs -> diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index 24696c965..f563024cd 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -44,14 +44,14 @@ val is_direct_subtype_of : Sil.typ -> Typename.t -> bool val java_get_const_type_name : Sil.const -> string (** Get the values of a vararg parameter given the pvar used to assign the elements. *) -val java_get_vararg_values : Cfg.Node.t -> Sil.pvar -> Idenv.t -> Cfg.Procdesc.t -> Sil.exp list +val java_get_vararg_values : Cfg.Node.t -> Sil.pvar -> Idenv.t -> Sil.exp list val java_proc_name_with_class_method : Procname.t -> string -> string -> bool (** Return the callees that satisfy [filter]. *) val proc_calls : (Procname.t -> ProcAttributes.t option) -> - Procname.t -> Cfg.Procdesc.t -> + Cfg.Procdesc.t -> (Procname.t -> ProcAttributes.t -> bool) -> (Procname.t * ProcAttributes.t) list diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 8b916fb70..38d00ea91 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -158,16 +158,16 @@ let check_printf_args_ok match instrs, nvar with | Sil.Letderef (id, Sil.Lvar iv, _, _):: _, Sil.Var nid when Ident.equal id nid -> iv - | i:: is, _ -> array_ivar is nvar + | _:: is, _ -> array_ivar is nvar | _ -> raise Not_found in let rec fixed_nvar_type_name instrs nvar = match nvar with | Sil.Var nid -> ( match instrs with - | Sil.Letderef (id, Sil.Lvar iv, t, _):: _ + | Sil.Letderef (id, Sil.Lvar _, t, _):: _ when Ident.equal id nid -> PatternMatch.get_type_name t - | i:: is -> fixed_nvar_type_name is nvar + | _:: is -> fixed_nvar_type_name is nvar | _ -> raise Not_found) | Sil.Const c -> PatternMatch.java_get_const_type_name c | _ -> raise (Failure "Could not resolve fixed type name") in diff --git a/infer/src/checkers/repeatedCallsChecker.ml b/infer/src/checkers/repeatedCallsChecker.ml index ba57335e3..5498ca1b5 100644 --- a/infer/src/checkers/repeatedCallsChecker.ml +++ b/infer/src/checkers/repeatedCallsChecker.ml @@ -23,7 +23,7 @@ struct Set.Make(struct type t = Sil.instr let compare i1 i2 = match i1, i2 with - | Sil.Call (ret1, e1, etl1, loc1, cf1), Sil.Call (ret2, e2, etl2, loc2, cf2) -> + | Sil.Call (_, e1, etl1, _, cf1), Sil.Call (_, e2, etl2, _, cf2) -> (* ignore return ids and call flags *) let n = Sil.exp_compare e1 e2 in if n <> 0 then n else let n = IList.compare Sil.exp_typ_compare etl1 etl2 in @@ -87,7 +87,7 @@ struct | Some loc, None | None, Some loc -> if _paths = AllPaths then None else Some loc - | Some loc1, Some loc2 -> + | Some loc1, Some _ -> Some loc1 (* left priority *) let join = _join paths let do_node node lo1 = @@ -95,7 +95,7 @@ struct let lo' = (* use left priority join to implement transfer function *) _join SomePath lo1 lo2 in [lo'], [lo'] - let proc_throws pn = Dataflow.DontKnow + let proc_throws _ = Dataflow.DontKnow end) in let transitions = DFAllocCheck.run pdesc None in @@ -104,11 +104,11 @@ struct | DFAllocCheck.Dead_state -> None (** Check repeated calls to the same procedure. *) - let check_instr get_proc_desc curr_pname curr_pdesc node extension instr normalized_etl = + let check_instr get_proc_desc curr_pname curr_pdesc extension instr normalized_etl = (** Arguments are not temporary variables. *) let arguments_not_temp args = - let filter_arg (e, t) = match e with + let filter_arg (e, _) = match e with | Sil.Lvar pvar -> (* same temporary variable does not imply same value *) not (Errdesc.pvar_is_frontend_tmp pvar) @@ -158,7 +158,7 @@ struct pp = pp; } - let update_payload typestate payload = payload + let update_payload _ payload = payload end (* CheckRepeatedCalls *) module MainRepeatedCalls = diff --git a/infer/src/clang/ast_expressions.ml b/infer/src/clang/ast_expressions.ml index 75b9cf22f..f9cca0592 100644 --- a/infer/src/clang/ast_expressions.ml +++ b/infer/src/clang/ast_expressions.ml @@ -104,7 +104,7 @@ let create_struct_type struct_name = `StructType struct_name let create_pointer_type typ = `PointerOf typ -let create_integer_literal stmt_info n = +let create_integer_literal n = let stmt_info = dummy_stmt_info () in let expr_info = { Clang_ast_t.ei_type_ptr = create_int_type; @@ -151,7 +151,7 @@ let create_implicit_cast_expr stmt_info stmts typ cast_kind = Clang_ast_t.ImplicitCastExpr (stmt_info, stmts, expr_info, cast_expr_info) let create_nil stmt_info = - let integer_literal = create_integer_literal stmt_info "0" in + let integer_literal = create_integer_literal "0" in let cstyle_cast_expr = create_cstyle_cast_expr stmt_info [integer_literal] create_int_type in let paren_expr = create_parent_expr stmt_info [cstyle_cast_expr] in create_implicit_cast_expr stmt_info [paren_expr] create_id_type `NullToPointer @@ -218,7 +218,7 @@ let make_decl_ref_expr_info decl_ref = { drti_found_decl_ref = None; } -let make_objc_ivar_decl decl_info tp property_impl_decl_info ivar_name = +let make_objc_ivar_decl decl_info tp ivar_name = let field_decl_info = { Clang_ast_t.fldi_is_mutable = true; fldi_is_module_private = true; @@ -265,7 +265,7 @@ let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi = let make_next_object_exp stmt_info item items = let var_decl_ref, var_type = match item with - | Clang_ast_t.DeclStmt (stmt_info, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) -> + | Clang_ast_t.DeclStmt (_, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) -> let decl_ptr = di.Clang_ast_t.di_pointer in let decl_ref = make_decl_ref_tp `Var decl_ptr name_info false var_type in let stmt_info_var = { @@ -290,7 +290,7 @@ let make_next_object_exp stmt_info item items = (* dispatch_once(v,block_def) is transformed as: *) (* void (^block_var)()=block_def; block_var() *) -let translate_dispatch_function block_name stmt_info stmt_list ei n = +let translate_dispatch_function block_name stmt_info stmt_list n = let block_expr = try IList.nth stmt_list (n + 1) with Not_found -> assert false in @@ -300,7 +300,7 @@ let translate_dispatch_function block_name stmt_info stmt_list ei n = } in let open Clang_ast_t in match block_expr with - | BlockExpr (bsi, bsl, bei, bd) -> + | BlockExpr (_, _, bei, _) -> let tp = bei.ei_type_ptr in let cast_info = { cei_cast_kind = `BitCast; cei_base_path =[]} in let block_def = ImplicitCastExpr(stmt_info,[block_expr], bei, cast_info) in @@ -344,7 +344,7 @@ let pseudo_object_tp () = create_class_type (CFrontend_config.pseudo_object_type (* Create expression PseudoObjectExpr for 'o.m' *) let build_PseudoObjectExpr tp_m o_cast_decl_ref_exp mname = match o_cast_decl_ref_exp with - | Clang_ast_t.ImplicitCastExpr (si, stmt_list, ei, cast_expr_info) -> + | Clang_ast_t.ImplicitCastExpr (si, _, ei, _) -> let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in let ei_opre = make_expr_info (pseudo_object_tp ()) in let count_name = Ast_utils.make_name_decl CFrontend_config.count in @@ -410,7 +410,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei = let build_idx_decl pidx = match pidx with | Clang_ast_t.ParmVarDecl (di_idx, name_idx, tp_idx, _) -> - let zero = create_integer_literal stmt_info "0" in + let zero = create_integer_literal "0" in (* tp_idx idx = 0; *) let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx tp_idx name_idx (Some zero) in let idx_ei = make_expr_info tp_idx in @@ -475,7 +475,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei = (* idx assert false in (* id object = objects[idx]; *) - let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx tp_idx = + let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx = let open Clang_ast_t in match pobj with | ParmVarDecl(di_obj, name_obj, tp_obj, _) -> @@ -525,7 +525,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei = let make_object_cast_decl_ref_expr objects = match objects with - | Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (di, name, tp, vdi)]) -> + | Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (_, name, tp, _)]) -> let decl_ref = make_decl_ref_tp `Var si.Clang_ast_t.si_pointer name false tp in cast_expr decl_ref tp | _ -> assert false in @@ -574,7 +574,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei = let idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx = build_idx_decl pidx in let guard = bin_op pidx objects in let incr = un_op idx_decl_ref_exp tp_idx in - let obj_assignment = build_object_DeclStmt pobj objects idx_cast tp_idx in + let obj_assignment = build_object_DeclStmt pobj objects idx_cast in let object_cast = build_cast_decl_ref_expr_from_parm pobj in let stop_cast = build_cast_decl_ref_expr_from_parm pstop in let call_block = make_block_call block_tp object_cast idx_cast stop_cast in @@ -598,7 +598,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei = (* We translate the logical negation of an integer with a conditional*) (* !x <=> x?0:1 *) let trans_negation_with_conditional stmt_info expr_info stmt_list = - let stmt_list_cond = stmt_list @ [create_integer_literal stmt_info "0"] @ [create_integer_literal stmt_info "1"] in + 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) let create_assume_not_null_call decl_info var_name var_type = @@ -617,7 +617,7 @@ let create_assume_not_null_call decl_info var_name var_type = } in let cast_info_call = { Clang_ast_t.cei_cast_kind = `LValueToRValue; cei_base_path = [] } in let decl_ref_exp_cast = Clang_ast_t.ImplicitCastExpr (stmt_info, [var_decl_ref], expr_info, cast_info_call) in - let null_expr = create_integer_literal stmt_info "0" in + let null_expr = create_integer_literal "0" in let bin_op_expr_info = make_general_expr_info create_BOOL_type `RValue `Ordinary in let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info bin_op_expr_info boi in let parameters = [bin_op] in diff --git a/infer/src/clang/ast_expressions.mli b/infer/src/clang/ast_expressions.mli index c7891ac54..cc797b723 100644 --- a/infer/src/clang/ast_expressions.mli +++ b/infer/src/clang/ast_expressions.mli @@ -43,8 +43,7 @@ val create_struct_type : string -> type_ptr val create_pointer_type : type_ptr -> type_ptr -val make_objc_ivar_decl : decl_info -> type_ptr -> obj_c_property_impl_decl_info -> - named_decl_info -> decl +val make_objc_ivar_decl : decl_info -> type_ptr -> named_decl_info -> decl val make_stmt_info : decl_info -> stmt_info @@ -72,7 +71,7 @@ val make_obj_c_message_expr_info_class : string -> string -> pointer option -> val make_obj_c_message_expr_info_instance : string -> obj_c_message_expr_info -val translate_dispatch_function : string -> stmt_info -> stmt list -> expr_info -> int -> stmt * type_ptr +val translate_dispatch_function : string -> stmt_info -> stmt list -> int -> stmt * type_ptr val translate_block_enumerate : string -> stmt_info -> stmt list -> expr_info -> stmt * (string * Clang_ast_t.pointer * type_ptr) list diff --git a/infer/src/clang/cArithmetic_trans.ml b/infer/src/clang/cArithmetic_trans.ml index c3db97bc7..7763b6c87 100644 --- a/infer/src/clang/cArithmetic_trans.ml +++ b/infer/src/clang/cArithmetic_trans.ml @@ -18,7 +18,7 @@ open CFrontend_utils (* The difference is when the lvalue is a __strong or __autoreleasing. In those*) (* case we need to add proper retain/release.*) (* See document: "Objective-C Automatic Reference Counting" describing the semantics *) -let assignment_arc_mode context e1 typ e2 loc rhs_owning_method is_e1_decl = +let assignment_arc_mode e1 typ e2 loc rhs_owning_method is_e1_decl = let assign = Sil.Set (e1, typ, e2, loc) in let retain_pname = SymExec.ModelBuiltins.__objc_retain in let release_pname = SymExec.ModelBuiltins.__objc_release in @@ -27,7 +27,7 @@ let assignment_arc_mode context e1 typ e2 loc rhs_owning_method is_e1_decl = let bi_retain = Sil.Const (Sil.Cfun procname) in Sil.Call([], bi_retain, [(e, t)], loc, Sil.cf_default) in match typ with - | Sil.Tptr (t, Sil.Pk_pointer) when not rhs_owning_method && not is_e1_decl -> + | Sil.Tptr (_, Sil.Pk_pointer) when not rhs_owning_method && not is_e1_decl -> (* for __strong e1 = e2 the semantics is*) (* retain(e2); tmp=e1; e1=e2; release(tmp); *) let retain = mk_call retain_pname e2 typ in @@ -35,15 +35,15 @@ let assignment_arc_mode context e1 typ e2 loc rhs_owning_method is_e1_decl = let tmp_assign = Sil.Letderef(id, e1, typ, loc) in let release = mk_call release_pname (Sil.Var id) typ in (e1,[retain; tmp_assign; assign; release ], [id]) - | Sil.Tptr (t, Sil.Pk_pointer) when not rhs_owning_method && is_e1_decl -> + | Sil.Tptr (_, Sil.Pk_pointer) when not rhs_owning_method && is_e1_decl -> (* for A __strong *e1 = e2 the semantics is*) (* retain(e2); e1=e2; *) let retain = mk_call retain_pname e2 typ in (e1,[retain; assign ], []) - | Sil.Tptr (t, Sil.Pk_objc_weak) - | Sil.Tptr (t, Sil.Pk_objc_unsafe_unretained) -> + | Sil.Tptr (_, Sil.Pk_objc_weak) + | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> (e1, [assign],[]) - | Sil.Tptr (t, Sil.Pk_objc_autoreleasing) -> + | Sil.Tptr (_, Sil.Pk_objc_autoreleasing) -> (* for __autoreleasing e1 = e2 the semantics is*) (* retain(e2); autorelease(e2); e1=e2; *) let retain = mk_call retain_pname e2 typ in @@ -89,7 +89,7 @@ let compound_assignment_binary_operation_instruction boi e1 typ e2 loc = | `XorAssign -> let e1_xor_e2 = Sil.BinOp(Sil.BXor, Sil.Var id, e2) in (e1, [Sil.Set (e1, typ, e1_xor_e2, loc)]) - | bok -> assert false in + | _ -> assert false in (e_res, instr1:: instr_op, [id]) (* Returns a pair ([binary_expression], instructions). "binary_expression" *) @@ -119,7 +119,7 @@ let binary_operation_instruction context boi e1 typ e2 loc rhs_owning_method = | `LOr -> (binop_exp (Sil.LOr), [], []) | `Assign -> if !Config.arc_mode && ObjcInterface_decl.is_pointer_to_objc_class context.CContext.tenv typ then - assignment_arc_mode context e1 typ e2 loc rhs_owning_method false + assignment_arc_mode e1 typ e2 loc rhs_owning_method false else (e1, [Sil.Set (e1, typ, e2, loc)], []) | `Comma -> (e2, [], []) (* C99 6.5.17-2 *) diff --git a/infer/src/clang/cArithmetic_trans.mli b/infer/src/clang/cArithmetic_trans.mli index 4b2cf341e..7422a6c43 100644 --- a/infer/src/clang/cArithmetic_trans.mli +++ b/infer/src/clang/cArithmetic_trans.mli @@ -20,7 +20,7 @@ val unary_operation_instruction : Ident.t list * Sil.exp * Sil.instr list val assignment_arc_mode : - CContext.t -> Sil.exp -> Sil.typ -> Sil.exp -> Location.t -> bool -> bool -> + Sil.exp -> Sil.typ -> Sil.exp -> Location.t -> bool -> bool -> Sil.exp * Sil.instr list * Ident.t list val sil_const_plus_one : Sil.exp -> Sil.exp diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 8cc67c5ee..99e9893a0 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -75,7 +75,7 @@ let rec get_curr_class context = let get_curr_class_name curr_class = match curr_class with | ContextCls (name, _, _) -> name - | ContextCategory (name, cls) -> cls + | ContextCategory (_, cls) -> cls | ContextProtocol name -> name | ContextNoCls -> assert false @@ -127,12 +127,12 @@ let create_curr_class tenv class_name ck = let add_block_static_var context block_name static_var_typ = match context.outer_context, static_var_typ with - | Some outer_context, (static_var, typ) when Sil.pvar_is_global static_var -> + | Some outer_context, (static_var, _) when Sil.pvar_is_global static_var -> (let new_static_vars, duplicate = try let static_vars = Procname.Map.find block_name outer_context.blocks_static_vars in if IList.mem ( - fun (var1, typ1) (var2, typ2) -> Sil.pvar_equal var1 var2 + fun (var1, _) (var2, _) -> Sil.pvar_equal var1 var2 ) static_var_typ static_vars then static_vars, true else diff --git a/infer/src/clang/cEnum_decl.ml b/infer/src/clang/cEnum_decl.ml index 776175d5d..cee9d54e6 100644 --- a/infer/src/clang/cEnum_decl.ml +++ b/infer/src/clang/cEnum_decl.ml @@ -42,7 +42,7 @@ let enum_decl decl = ignore (add_enum_constant_to_map_if_needed decl_pointer None) | _ -> () in match decl with - | EnumDecl (decl_info, _, _, type_ptr, decl_list, _, _) -> + | EnumDecl (_, _, _, type_ptr, decl_list, _, _) -> add_enum_constants_to_map (IList.rev decl_list); let sil_type = Sil.Tint Sil.IInt in Ast_utils.update_sil_types_map type_ptr sil_type; diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index e972b8466..0b25275ad 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -60,7 +60,7 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = General_utils.append_no_duplicates_fields [field_tuple] fields in match decl_list with | [] -> [] - | ObjCPropertyDecl (_, named_decl_info, obj_c_property_decl_info) :: decl_list' -> + | ObjCPropertyDecl (_, _, obj_c_property_decl_info) :: decl_list' -> (let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in match Ast_utils.get_decl_opt_with_decl_ref ivar_decl_ref with | Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) -> @@ -69,7 +69,7 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = | _ -> get_fields type_ptr_to_sil_type tenv curr_class decl_list') | ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' -> add_field name_info type_ptr [] decl_list' - | decl :: decl_list' -> + | _ :: decl_list' -> get_fields type_ptr_to_sil_type tenv curr_class decl_list' (* Add potential extra fields defined only in the implementation of the class *) @@ -110,10 +110,10 @@ let is_ivar_atomic ivar fields = let get_property_corresponding_ivar tenv type_ptr_to_sil_type class_name property_decl = let open Clang_ast_t in match property_decl with - | ObjCPropertyDecl (decl_info, named_decl_info, obj_c_property_decl_info) -> + | ObjCPropertyDecl (_, named_decl_info, obj_c_property_decl_info) -> (let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in match Ast_utils.get_decl_opt_with_decl_ref ivar_decl_ref with - | Some ObjCIvarDecl (decl_info, named_decl_info, type_ptr, _, _) -> + | Some ObjCIvarDecl (_, named_decl_info, _, _, _) -> General_utils.mk_class_field_name named_decl_info | _ -> (* Ivar is not known, so add a default one to the tenv *) let type_ptr = obj_c_property_decl_info.Clang_ast_t.opdi_type_ptr in diff --git a/infer/src/clang/cFrontend.ml b/infer/src/clang/cFrontend.ml index 03ee2ce45..57aa8c961 100644 --- a/infer/src/clang/cFrontend.ml +++ b/infer/src/clang/cFrontend.ml @@ -29,29 +29,29 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec = let should_translate_decl = CLocation.should_translate_lib source_range in (if should_translate_decl then match dec with - | FunctionDecl(di, name_info, tp, fdecl_info) -> + | FunctionDecl(_, _, _, _) -> CMethod_declImpl.function_decl tenv cfg cg dec None - | ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, oi_decl_info) -> + | ObjCInterfaceDecl(_, name_info, decl_list, _, oi_decl_info) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in ignore (ObjcInterface_decl.interface_declaration CTypes_decl.type_ptr_to_sil_type tenv dec); CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list - | ObjCProtocolDecl(decl_info, name_info, decl_list, decl_context_info, _) -> + | ObjCProtocolDecl(_, name_info, decl_list, _, _) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = CContext.ContextProtocol name in ignore (ObjcProtocol_decl.protocol_decl CTypes_decl.type_ptr_to_sil_type tenv dec); CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list - | ObjCCategoryDecl(decl_info, name_info, decl_list, decl_context_info, ocdi) -> + | ObjCCategoryDecl(_, name_info, decl_list, _, ocdi) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in ignore (ObjcCategory_decl.category_decl CTypes_decl.type_ptr_to_sil_type tenv dec); CMethod_declImpl.process_methods tenv cg cfg curr_class decl_list - | ObjCCategoryImplDecl(decl_info, name_info, decl_list, decl_context_info, ocidi) -> + | ObjCCategoryImplDecl(_, name_info, decl_list, _, ocidi) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in ignore (ObjcCategory_decl.category_impl_decl CTypes_decl.type_ptr_to_sil_type tenv dec); @@ -63,7 +63,7 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec = CFrontend_errors.check_for_property_errors cfg cg tenv name decls | _ -> ()) - | ObjCImplementationDecl(decl_info, name_info, decl_list, decl_context_info, idi) -> + | ObjCImplementationDecl(_, _, decl_list, _, idi) -> let curr_class = ObjcInterface_decl.get_curr_class_impl idi in let type_ptr_to_sil_type = CTypes_decl.type_ptr_to_sil_type in ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec); @@ -75,10 +75,10 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec = CFrontend_errors.check_for_property_errors cfg cg tenv name decls | _ -> ()) - | CXXMethodDecl (decl_info, name_info, type_ptr, function_decl_info, _) - | CXXConstructorDecl (decl_info, name_info, type_ptr, function_decl_info, _) - | CXXConversionDecl (decl_info, name_info, type_ptr, function_decl_info, _) - | CXXDestructorDecl (decl_info, name_info, type_ptr, function_decl_info, _) -> + | CXXMethodDecl (decl_info, _, _, _, _) + | CXXConstructorDecl (decl_info, _, _, _, _) + | CXXConversionDecl (decl_info, _, _, _, _) + | CXXDestructorDecl (decl_info, _, _, _, _) -> (* di_parent_pointer has pointer to lexical context such as class.*) (* If it's not defined, then it's the same as parent in AST *) let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with @@ -93,7 +93,7 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec = CMethod_declImpl.process_methods tenv cg cfg curr_class [dec] | Some dec -> Printing.log_stats "Methods of %s skipped\n" (Ast_utils.string_of_decl dec) | None -> ()) - | dec -> ()); + | _ -> ()); match dec with (* Currently C/C++ record decl treated in the same way *) | ClassTemplateSpecializationDecl (decl_info, _, _, _, decl_list, _, _, _) @@ -109,19 +109,19 @@ let rec translate_one_declaration tenv cg cfg parent_dec dec = ignore (CTypes_decl.add_types_from_decl_to_tenv tenv dec); IList.iter (translate_one_declaration tenv cg cfg dec) method_decls | EnumDecl _ -> ignore (CEnum_decl.enum_decl dec) - | LinkageSpecDecl (decl_info, decl_list, decl_context_info) -> + | LinkageSpecDecl (_, decl_list, _) -> Printing.log_out "ADDING: LinkageSpecDecl decl list\n"; IList.iter (translate_one_declaration tenv cg cfg dec) decl_list - | NamespaceDecl (decl_info, name_info, decl_list, decl_context_info, _) -> + | NamespaceDecl (_, _, decl_list, _, _) -> IList.iter (translate_one_declaration tenv cg cfg dec) decl_list - | ClassTemplateDecl (decl_info, named_decl_info, template_decl_info) - | FunctionTemplateDecl (decl_info, named_decl_info, template_decl_info) -> + | ClassTemplateDecl (_, _, template_decl_info) + | FunctionTemplateDecl (_, _, template_decl_info) -> let decl_list = template_decl_info.Clang_ast_t.tdi_specializations in IList.iter (translate_one_declaration tenv cg cfg dec) decl_list - | dec -> () + | _ -> () (* Translates a file by translating the ast into a cfg. *) -let compute_icfg tenv source_file ast = +let compute_icfg tenv ast = match ast with | Clang_ast_t.TranslationUnitDecl(_, decl_list, _, _) -> CFrontend_config.global_translation_unit_decls := decl_list; @@ -148,7 +148,7 @@ let do_source_file source_file ast = Config.nLOC := FileLOC.file_get_loc (DB.source_file_to_string source_file); Printing.log_out "\n Start building call/cfg graph for '%s'....\n" (DB.source_file_to_string source_file); - let call_graph, cfg = compute_icfg tenv (DB.source_file_to_string source_file) ast in + let call_graph, cfg = compute_icfg tenv ast in Printing.log_out "\n End building call/cfg graph for '%s'.\n" (DB.source_file_to_string source_file); (* This part below is a boilerplate in every frontends. *) diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 755f2fef6..586f90480 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -141,7 +141,7 @@ struct | _ -> lstmt) (* given that this has not been translated, looking up for variables *) (* inside leads to inconsistencies *) - | ObjCAtCatchStmt (stmt_info, stmt_list, obj_c_message_expr_kind) -> + | ObjCAtCatchStmt _ -> [] | _ -> snd (Clang_ast_proj.get_stmt_tuple stmt) @@ -158,7 +158,7 @@ struct let get_unqualified_name name_info = let name = match name_info.Clang_ast_t.ni_qual_name with - | name :: quals -> name + | name :: _ -> name | [] -> name_info.Clang_ast_t.ni_name in fold_qual_name [name] @@ -291,7 +291,7 @@ struct let update_enum_map enum_constant_pointer sil_exp = let open Clang_ast_main in - let (predecessor_pointer_opt, sil_exp_opt) = + let (predecessor_pointer_opt, _) = try PointerMap.find enum_constant_pointer !CFrontend_config.enum_map with Not_found -> assert false in let enum_map_value = (predecessor_pointer_opt, Some sil_exp) in @@ -334,7 +334,7 @@ struct let typ = match typ_opt with Some t -> t | _ -> assert false in (* it needs extending to handle objC types *) match typ with - | Clang_ast_t.RecordType (ti, decl_ptr) -> get_decl decl_ptr + | Clang_ast_t.RecordType (_, decl_ptr) -> get_decl decl_ptr | _ -> None (*TODO take the attributes into account too. To be done after we get the attribute's arguments. *) @@ -523,7 +523,7 @@ struct if n < i then acc else aux (n -1) (n :: acc) in aux j [] ;; - let replicate n el = IList.map (fun i -> el) (list_range 0 (n -1)) + let replicate n el = IList.map (fun _ -> el) (list_range 0 (n -1)) let mk_class_field_name field_qual_name = let field_name = field_qual_name.Clang_ast_t.ni_name in diff --git a/infer/src/clang/cMain.ml b/infer/src/clang/cMain.ml index b78e492cf..abeab109b 100644 --- a/infer/src/clang/cMain.ml +++ b/infer/src/clang/cMain.ml @@ -72,7 +72,7 @@ let arg_desc = "Toot directory of the project" ; "-fobjc-arc", - Arg.Unit (fun s -> Config.arc_mode := true), + Arg.Unit (fun _ -> Config.arc_mode := true), None, "Translate with Objective-C Automatic Reference Counting (ARC)" ; @@ -92,7 +92,7 @@ let print_usage_exit () = exit(1) let () = - Utils.Arg.parse arg_desc (fun arg -> ()) usage + Utils.Arg.parse arg_desc (fun _ -> ()) usage (* This function reads the json file in fname, validates it, and encoded in the AST data structure*) (* defined in Clang_ast_t. *) diff --git a/infer/src/clang/cMethod_decl.ml b/infer/src/clang/cMethod_decl.ml index 28daf4879..1123caacb 100644 --- a/infer/src/clang/cMethod_decl.ml +++ b/infer/src/clang/cMethod_decl.ml @@ -30,7 +30,7 @@ struct (* Translates the method/function's body into nodes of the cfg. *) let add_method tenv cg cfg class_decl_opt procname body has_return_param is_objc_method - captured_vars outer_context_opt extra_instrs = + outer_context_opt extra_instrs = Printing.log_out "\n\n>>---------- ADDING METHOD: '%s' ---------<<\n@." (Procname.to_string procname); @@ -77,7 +77,7 @@ struct let return_param_typ_opt = CMethod_signature.ms_get_return_param_typ ms in if CMethod_trans.create_local_procdesc cfg tenv ms [body] captured_vars false then add_method tenv cg cfg CContext.ContextNoCls procname body return_param_typ_opt false - captured_vars outer_context_opt extra_instrs + outer_context_opt extra_instrs | None -> () let process_method_decl tenv cg cfg curr_class meth_decl ~is_objc = @@ -90,7 +90,7 @@ struct let is_objc_inst_method = is_instance && is_objc in let return_param_typ_opt = CMethod_signature.ms_get_return_param_typ ms in if CMethod_trans.create_local_procdesc cfg tenv ms [body] [] is_objc_inst_method then - add_method tenv cg cfg curr_class procname body return_param_typ_opt is_objc [] + add_method tenv cg cfg curr_class procname body return_param_typ_opt is_objc None extra_instrs | None -> () diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index a2413219d..e7d6a0888 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -101,7 +101,7 @@ let get_language function_method_decl_info = let get_parameters tenv function_method_decl_info = let par_to_ms_par par = match par with - | Clang_ast_t.ParmVarDecl (decl_info, name_info, type_ptr, var_decl_info) -> + | Clang_ast_t.ParmVarDecl (_, name_info, type_ptr, var_decl_info) -> let name = General_utils.get_var_name_string name_info var_decl_info in (name, type_ptr) | _ -> assert false in @@ -117,7 +117,7 @@ let get_return_type tenv function_method_decl_info = Ast_expressions.create_void_type, Some (Sil.Tptr (return_typ, Sil.Pk_pointer)) else return_type_ptr, None -let build_method_signature tenv decl_info procname function_method_decl_info is_anonym_block +let build_method_signature tenv decl_info procname function_method_decl_info parent_pointer pointer_to_property_opt = let source_range = decl_info.Clang_ast_t.di_source_range in let tp, return_param_type_opt = get_return_type tenv function_method_decl_info in @@ -131,7 +131,7 @@ let build_method_signature tenv decl_info procname function_method_decl_info is_ let get_assume_not_null_calls param_decls = let do_one_param decl = match decl with - | Clang_ast_t.ParmVarDecl (decl_info, name, tp, var_decl_info) + | Clang_ast_t.ParmVarDecl (decl_info, name, tp, _) when CFrontend_utils.Ast_utils.is_type_nonnull tp -> let assume_call = Ast_expressions.create_assume_not_null_call decl_info name tp in [(`ClangStmt assume_call)] @@ -151,7 +151,7 @@ let method_signature_of_decl tenv meth_decl block_data_opt = let func_decl = Func_decl_info (fdi, tp, language) in let function_info = Some (decl_info, fdi) in let procname = General_utils.mk_procname_from_function name function_info tp language in - let ms = build_method_signature tenv decl_info procname func_decl false None None in + let ms = build_method_signature tenv decl_info procname func_decl None None in let extra_instrs = get_assume_not_null_calls fdi.Clang_ast_t.fdi_parameters in ms, fdi.Clang_ast_t.fdi_body, extra_instrs | CXXMethodDecl (decl_info, name_info, tp, fdi, mdi), _ @@ -163,8 +163,7 @@ let method_signature_of_decl tenv meth_decl block_data_opt = let procname = General_utils.mk_procname_from_cpp_method class_name method_name tp in let method_decl = Cpp_Meth_decl_info (fdi, mdi, class_name, tp) in let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in - let ms = build_method_signature tenv decl_info procname method_decl false parent_pointer - None in + let ms = build_method_signature tenv decl_info procname method_decl parent_pointer None in let non_null_instrs = get_assume_not_null_calls fdi.Clang_ast_t.fdi_parameters in let init_list_instrs = get_init_list_instrs mdi in (* it will be empty for methods *) ms, fdi.Clang_ast_t.fdi_body, (init_list_instrs @ non_null_instrs) @@ -180,13 +179,13 @@ let method_signature_of_decl tenv meth_decl block_data_opt = match mdi.Clang_ast_t.omdi_property_decl with | Some decl_ref -> Some decl_ref.Clang_ast_t.dr_decl_pointer | None -> None in - let ms = build_method_signature tenv decl_info procname method_decl false + let ms = build_method_signature tenv decl_info procname method_decl parent_pointer pointer_to_property_opt in let extra_instrs = get_assume_not_null_calls mdi.omdi_parameters in ms, mdi.omdi_body, extra_instrs | BlockDecl (decl_info, bdi), Some (outer_context, tp, procname, _) -> let func_decl = Block_decl_info (bdi, tp, outer_context) in - let ms = build_method_signature tenv decl_info procname func_decl true None None in + let ms = build_method_signature tenv decl_info procname func_decl None None in let extra_instrs = get_assume_not_null_calls bdi.bdi_parameters in ms, bdi.bdi_body, extra_instrs | _ -> raise Invalid_declaration @@ -257,8 +256,8 @@ let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_inf (CTypes.classname_of_type sil_type) | `Instance -> (match act_params with - | (instance_obj, Sil.Tptr(t, _)):: _ - | (instance_obj, t):: _ -> CTypes.classname_of_type t + | (_, Sil.Tptr(t, _)):: _ + | (_, t):: _ -> CTypes.classname_of_type t | _ -> assert false) | `SuperInstance ->get_superclass_curr_class_objc context | `SuperClass -> get_superclass_curr_class_objc context @@ -276,7 +275,7 @@ let get_objc_property_accessor tenv ms = let open Clang_ast_t in let pointer_to_property_opt = CMethod_signature.ms_get_pointer_to_property_opt ms in match Ast_utils.get_decl_opt pointer_to_property_opt with - | Some (ObjCPropertyDecl (decl_info, named_decl_info, obj_c_property_decl_info) as d) -> + | Some (ObjCPropertyDecl _ as d) -> let class_name = Procname.c_get_class (CMethod_signature.ms_get_name ms) in let field_name = CField_decl.get_property_corresponding_ivar tenv CTypes_decl.type_ptr_to_sil_type class_name d in diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 4a5b89c06..3a00660b4 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -114,7 +114,7 @@ struct let fields = IList.map mk_field_from_captured_var captured_vars in let fields = CFrontend_utils.General_utils.sort_fields fields in Printing.log_out "Block %s field:\n" block_name; - IList.iter (fun (fn, ft, _) -> + IList.iter (fun (fn, _, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let mblock = Mangled.from_string block_name in let block_type = Sil.Tstruct @@ -130,7 +130,7 @@ struct Sil.tenv_add tenv block_name block_type; let trans_res = CTrans_utils.alloc_trans trans_state loc (Ast_expressions.dummy_stmt_info ()) block_type true in let id_block = match trans_res.exps with - | [(Sil.Var id, t)] -> id + | [(Sil.Var id, _)] -> id | _ -> assert false in let block_var = Sil.mk_pvar mblock procname in let declare_block_local = @@ -241,7 +241,7 @@ struct f trans_state e else f { trans_state with priority = Free } e - let mk_temp_sil_var tenv procdesc var_name_prefix = + let mk_temp_sil_var procdesc var_name_prefix = let procname = Cfg.Procdesc.get_proc_name procdesc in let id = Ident.create_fresh Ident.knormal in let pvar_mangled = Mangled.from_string (var_name_prefix ^ Ident.to_string id) in @@ -250,7 +250,7 @@ struct let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info = let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let typ = CTypes_decl.type_ptr_to_sil_type tenv type_ptr in - (mk_temp_sil_var tenv procdesc var_name_prefix, typ) + (mk_temp_sil_var procdesc var_name_prefix, typ) let create_call_instr trans_state return_type function_sil params_sil sil_loc call_flags ~is_objc_method = @@ -263,9 +263,8 @@ struct let var_exp = match trans_state.var_exp_typ with | Some (exp, _) -> exp | _ -> - let tenv = trans_state.context.CContext.tenv in let procdesc = trans_state.context.CContext.procdesc in - let pvar = mk_temp_sil_var tenv procdesc "__temp_return_" in + let pvar = mk_temp_sil_var procdesc "__temp_return_" in Cfg.Procdesc.append_locals procdesc [(Sil.pvar_get_name pvar, return_type)]; Sil.Lvar pvar in (* It is very confusing - same expression has two different types in two contexts:*) @@ -303,7 +302,7 @@ struct | Some bn -> { empty_res_trans with root_nodes = bn.continue } | _ -> assert false - let stringLiteral_trans trans_state stmt_info expr_info str = + let stringLiteral_trans trans_state expr_info str = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let exp = Sil.Const (Sil.Cstr (str)) in { empty_res_trans with exps = [(exp, typ)]} @@ -312,40 +311,40 @@ struct (* that has integral type (e.g., int or long) and is the same size and alignment as a pointer. The __null *) (* extension is typically only used by system headers, which define NULL as __null in C++ rather than using 0 *) (* (which is an integer that may not match the size of a pointer)". So we implement it as the constant zero *) - let gNUNullExpr_trans trans_state stmt_info expr_info = + let gNUNullExpr_trans trans_state expr_info = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let exp = Sil.Const (Sil.Cint (Sil.Int.zero)) in { empty_res_trans with exps = [(exp, typ)]} - let nullPtrExpr_trans trans_state stmt_info expr_info = + let nullPtrExpr_trans trans_state expr_info = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in { empty_res_trans with exps = [(Sil.exp_null, typ)]} - let objCSelectorExpr_trans trans_state stmt_info expr_info selector = - stringLiteral_trans trans_state stmt_info expr_info selector + let objCSelectorExpr_trans trans_state expr_info selector = + stringLiteral_trans trans_state expr_info selector - let objCEncodeExpr_trans trans_state stmt_info expr_info type_ptr = - stringLiteral_trans trans_state stmt_info expr_info (Ast_utils.string_of_type_ptr type_ptr) + let objCEncodeExpr_trans trans_state expr_info type_ptr = + stringLiteral_trans trans_state expr_info (Ast_utils.string_of_type_ptr type_ptr) - let objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref = + let objCProtocolExpr_trans trans_state expr_info decl_ref = let name = (match decl_ref.Clang_ast_t.dr_name with | Some s -> s.Clang_ast_t.ni_name | _ -> "") in - stringLiteral_trans trans_state stmt_info expr_info name + stringLiteral_trans trans_state expr_info name - let characterLiteral_trans trans_state stmt_info expr_info n = + let characterLiteral_trans trans_state expr_info n = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let exp = Sil.Const (Sil.Cint (Sil.Int.of_int n)) in { empty_res_trans with exps = [(exp, typ)]} - let floatingLiteral_trans trans_state stmt_info expr_info float_string = + let floatingLiteral_trans trans_state expr_info float_string = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let exp = Sil.Const (Sil.Cfloat (float_of_string float_string)) in { empty_res_trans with exps = [(exp, typ)]} (* Note currently we don't have support for different qual *) (* type like long, unsigned long, etc *) - and integerLiteral_trans trans_state stmt_info expr_info integer_literal_info = + and integerLiteral_trans trans_state expr_info integer_literal_info = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let exp, ids = try @@ -362,7 +361,7 @@ struct exps = [(exp, typ)]; ids = ids; } - let cxxScalarValueInitExpr_trans trans_state stmt_info expr_info = + let cxxScalarValueInitExpr_trans trans_state expr_info = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in (* constant will be different depending on type *) let zero_opt = match typ with @@ -374,11 +373,11 @@ struct | Some zero -> { empty_res_trans with exps = [(Sil.Const zero, typ)] } | _ -> empty_res_trans - let nullStmt_trans succ_nodes stmt_info = + let nullStmt_trans succ_nodes = { empty_res_trans with root_nodes = succ_nodes } (* The stmt seems to be always empty *) - let unaryExprOrTypeTraitExpr_trans trans_state stmt_info expr_info unary_expr_or_type_trait_expr_info = + let unaryExprOrTypeTraitExpr_trans trans_state expr_info unary_expr_or_type_trait_expr_info = let tenv = trans_state.context.CContext.tenv in let typ = CTypes_decl.type_ptr_to_sil_type tenv expr_info.Clang_ast_t.ei_type_ptr in match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with @@ -578,7 +577,7 @@ struct decl_ref.Clang_ast_t.dr_decl_pointer in print_error decl_kind; assert false - and declRefExpr_trans trans_state stmt_info expr_info decl_ref_expr_info e = + and declRefExpr_trans trans_state stmt_info decl_ref_expr_info _ = Printing.log_out " priority node free = '%s'\n@." (string_of_bool (PriorityNode.is_priority_free trans_state)); let decl_ref = match decl_ref_expr_info.Clang_ast_t.drti_decl_ref with @@ -623,7 +622,7 @@ struct let const_exp = get_enum_constant_expr context decl_ref.Clang_ast_t.dr_decl_pointer in { empty_res_trans with exps = [(const_exp, typ)] } - and arraySubscriptExpr_trans trans_state stmt_info expr_info stmt_list = + and arraySubscriptExpr_trans trans_state expr_info stmt_list = let typ = CTypes_decl.get_type_from_expr_info expr_info trans_state.context.CContext.tenv in let array_stmt, idx_stmt = (match stmt_list with | [a; i] -> a, i (* Assumption: the statement list contains 2 elements, @@ -631,9 +630,9 @@ struct | _ -> assert false) in (* Let's get notified if the assumption is wrong...*) let res_trans_a = instruction trans_state array_stmt in let res_trans_idx = instruction trans_state idx_stmt in - let (a_exp, a_typ) = extract_exp_from_list res_trans_a.exps + let (a_exp, _) = extract_exp_from_list res_trans_a.exps "WARNING: In ArraySubscriptExpr there was a problem in translating array exp.\n" in - let (i_exp, i_typ) = extract_exp_from_list res_trans_idx.exps + let (i_exp, _) = extract_exp_from_list res_trans_idx.exps "WARNING: In ArraySubscriptExpr there was a problem in translating index exp.\n" in let array_exp = Sil.Lindex (a_exp, i_exp) in @@ -673,7 +672,7 @@ struct let sil_loc = CLocation.get_sil_location stmt_info context in let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in (match stmt_list with - | [s1; ImplicitCastExpr (stmt, [CompoundLiteralExpr (cle_stmt_info, stmts, expr_info)], _, cast_expr_info)] -> + | [s1; ImplicitCastExpr (_, [CompoundLiteralExpr (_, stmts, expr_info)], _, _)] -> let decl_ref = get_decl_ref_info s1 in let pvar = CVar_decl.sil_var_of_decl_ref context decl_ref procname in let trans_state' = { trans_state with var_exp_typ = Some (Sil.Lvar pvar, typ) } in @@ -692,7 +691,9 @@ struct (* translation of s2 is done taking care of block special case *) exec_with_block_priority_exception (exec_with_self_exception instruction) trans_state' s2 stmt_info in let (sil_e1, sil_typ1) = extract_exp_from_list res_trans_e1.exps "\nWARNING: Missing LHS operand in BinOp. Returning -1. Fix needed...\n" in - let (sil_e2, sil_typ2) = extract_exp_from_list res_trans_e2.exps "\nWARNING: Missing RHS operand in BinOp. Returning -1. Fix needed...\n" in + let (sil_e2, _) = + extract_exp_from_list res_trans_e2.exps + "\nWARNING: Missing RHS operand in BinOp. Returning -1. Fix needed...\n" in let exp_op, instr_bin, ids_bin = CArithmetic_trans.binary_operation_instruction context binary_operator_info sil_e1 typ sil_e2 sil_loc rhs_owning_method in @@ -748,7 +749,7 @@ struct (* afterwards. The 'instructions' function does not do that *) let trans_state_param = { trans_state_pri with succ_nodes = []; var_exp_typ = None } in - let (sil_fe, typ_fe) = extract_exp_from_list res_trans_callee.exps + let (sil_fe, _) = extract_exp_from_list res_trans_callee.exps "WARNING: The translation of fun_exp did not return an expression. Returning -1. NEED TO BE FIXED" in let callee_pname_opt = match sil_fe with @@ -821,7 +822,7 @@ struct let sil_loc = CLocation.get_sil_location si context in (* first for method address, second for 'this' expression *) assert ((IList.length result_trans_callee.exps) = 2); - let (sil_method, typ_method) = IList.hd result_trans_callee.exps in + let (sil_method, _) = IList.hd result_trans_callee.exps in let callee_pname = match sil_method with | Sil.Const (Sil.Cfun pn) -> pn | _ -> assert false (* method pointer not implemented, this shouldn't happen *) in @@ -878,9 +879,8 @@ struct let var_exp, class_type = match trans_state.var_exp_typ with | Some exp_typ -> exp_typ | None -> - let tenv = trans_state.context.CContext.tenv in let procdesc = trans_state.context.CContext.procdesc in - let pvar = mk_temp_sil_var tenv procdesc "__temp_construct_" in + let pvar = mk_temp_sil_var procdesc "__temp_construct_" in let class_type = CTypes_decl.get_type_from_expr_info ei context.CContext.tenv in Cfg.Procdesc.append_locals procdesc [(Sil.pvar_get_name pvar, class_type)]; Sil.Lvar pvar, class_type in @@ -901,8 +901,8 @@ struct cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si Sil.Tvoid else empty_res_trans - and objCMessageExpr_trans_special_cases trans_state si obj_c_message_expr_info stmt_list - expr_info method_type trans_state_pri sil_loc act_params = + and objCMessageExpr_trans_special_cases trans_state si obj_c_message_expr_info + method_type trans_state_pri sil_loc act_params = let context = trans_state.context in let receiver_kind = obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind in let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in @@ -961,8 +961,8 @@ struct let obj_c_message_expr_info, res_trans_subexpr_list = objCMessageExpr_deal_with_static_self trans_state_param stmt_list obj_c_message_expr_info in let subexpr_exprs = collect_exprs res_trans_subexpr_list in - match objCMessageExpr_trans_special_cases trans_state si obj_c_message_expr_info stmt_list - expr_info method_type trans_state_pri sil_loc subexpr_exprs with + match objCMessageExpr_trans_special_cases trans_state si obj_c_message_expr_info + method_type trans_state_pri sil_loc subexpr_exprs with | Some res -> res | None -> let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in @@ -993,16 +993,16 @@ struct { res_trans_to_parent with exps = res_trans_call.exps } - and dispatch_function_trans trans_state stmt_info stmt_list ei n = + and dispatch_function_trans trans_state stmt_info stmt_list n = Printing.log_out "\n Call to a dispatch function treated as special case...\n"; let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in - let transformed_stmt, tp = - Ast_expressions.translate_dispatch_function (Sil.pvar_to_string pvar) stmt_info stmt_list ei n in + let transformed_stmt, _ = + Ast_expressions.translate_dispatch_function (Sil.pvar_to_string pvar) stmt_info stmt_list n in instruction trans_state transformed_stmt and block_enumeration_trans trans_state stmt_info stmt_list ei = - let declare_nullify_vars loc res_state roots preds (pvar, typ) = + let declare_nullify_vars loc preds pvar = (* Add nullify of the temp block var to the last node (predecessor or the successor nodes)*) IList.iter (fun n -> Cfg.Node.append_instrs_temps n [Sil.Nullify(pvar, loc, true)] []) preds in @@ -1011,17 +1011,16 @@ struct let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let transformed_stmt, vars_to_register = Ast_expressions.translate_block_enumerate (Sil.pvar_to_string pvar) stmt_info stmt_list ei in - let pvars_types = IList.map (fun (v, pointer, tp) -> - let pvar = Sil.mk_pvar (Mangled.from_string v) procname in - let typ = CTypes_decl.type_ptr_to_sil_type trans_state.context.CContext.tenv tp in - (pvar, typ)) vars_to_register in + let pvars = IList.map (fun (v, _, _) -> + Sil.mk_pvar (Mangled.from_string v) procname + ) vars_to_register in let loc = CLocation.get_sil_location stmt_info trans_state.context in let res_state = instruction trans_state transformed_stmt in let preds = IList.flatten (IList.map (fun n -> Cfg.Node.get_preds n) trans_state.succ_nodes) in - IList.iter (declare_nullify_vars loc res_state res_state.root_nodes preds) pvars_types; + IList.iter (declare_nullify_vars loc preds) pvars; res_state - and compoundStmt_trans trans_state stmt_info stmt_list = + and compoundStmt_trans trans_state stmt_list = instructions trans_state stmt_list and conditionalOperator_trans trans_state stmt_info stmt_list expr_info = @@ -1035,7 +1034,7 @@ struct let trans_state_pri = PriorityNode.force_claim_priority_node trans_state stmt_info in let trans_state' = { trans_state_pri with succ_nodes = [] } in let res_trans_b = instruction trans_state' stmt in - let (e', e'_typ) = extract_exp_from_list res_trans_b.exps + let (e', _) = extract_exp_from_list res_trans_b.exps "\nWARNING: Missing branch expression for Conditional operator. Need to be fixed\n" in let set_temp_var = [ Sil.Declare_locals([(pvar, var_typ)], sil_loc); @@ -1099,7 +1098,8 @@ struct (* Assumption: If it's a null_stmt, it is a loop with no bound, so we set condition to 1 *) else instruction trans_state cond in - let e', instrs' = define_condition_side_effects context res_trans_cond.exps res_trans_cond.instrs sil_loc in + let e', instrs' = + define_condition_side_effects res_trans_cond.exps res_trans_cond.instrs sil_loc in let prune_t = mk_prune_node true e' res_trans_cond.ids instrs' in let prune_f = mk_prune_node false e' res_trans_cond.ids instrs' in IList.iter (fun n' -> Cfg.Node.set_succs_exn n' [prune_t; prune_f] []) res_trans_cond.leaf_nodes; @@ -1137,7 +1137,7 @@ struct let root_nodes_to_parent = if (IList.length res_trans_s1.root_nodes) = 0 then res_trans_s1.leaf_nodes else res_trans_s1.root_nodes in let (exp1, typ1) = extract_exp res_trans_s1.exps in - let (exp2, typ2) = extract_exp res_trans_s2.exps in + let (exp2, _) = extract_exp res_trans_s2.exps in let e_cond = Sil.BinOp (binop, exp1, exp2) in { root_nodes = root_nodes_to_parent; leaf_nodes = prune_to_short_c@res_trans_s2.leaf_nodes; @@ -1149,7 +1149,7 @@ struct Printing.log_out "Translating Condition for Conditional/Loop \n"; let open Clang_ast_t in match cond with - | BinaryOperator(si, [s1; s2], expr_info, boi) -> + | BinaryOperator(_, [s1; s2], _, boi) -> (match boi.Clang_ast_t.boi_kind with | `LAnd -> short_circuit (Sil.LAnd) s1 s2 | `LOr -> short_circuit (Sil.LOr) s1 s2 @@ -1160,7 +1160,7 @@ struct and declStmt_in_condition_trans trans_state decl_stmt res_trans_cond = match decl_stmt with - | Clang_ast_t.DeclStmt(stmt_info, stmt_list, decl_list) -> + | Clang_ast_t.DeclStmt(stmt_info, _, decl_list) -> let trans_state_decl = { trans_state with succ_nodes = res_trans_cond.root_nodes } in @@ -1291,7 +1291,7 @@ struct let e_const = res_trans_case_const.exps in let e_const' = match e_const with - | [(head, typ)] -> head + | [(head, _)] -> head | _ -> assert false in let sil_eq_cond = Sil.BinOp (Sil.Eq, switch_e_cond', e_const') in let sil_loc = CLocation.get_sil_location stmt_info context in @@ -1307,7 +1307,7 @@ struct | _ -> assert false in match cases with (* top-down to handle default cases *) | [] -> next_nodes, next_prune_nodes - | CaseStmt(stmt_info, _ :: _ :: case_content) as case :: rest -> + | CaseStmt(_, _ :: _ :: case_content) as case :: rest -> let last_nodes, last_prune_nodes = translate_and_connect_cases rest next_nodes next_prune_nodes in let case_entry_point = connected_instruction (IList.rev case_content) last_nodes in (* connects between cases, then continuation has priority about breaks *) @@ -1332,7 +1332,7 @@ struct { empty_res_trans with root_nodes = top_nodes; leaf_nodes = succ_nodes } | _ -> assert false - and stmtExpr_trans trans_state stmt_info stmt_list expr_info = + and stmtExpr_trans trans_state stmt_info stmt_list = let context = trans_state.context in let stmt = extract_stmt_from_singleton stmt_list "ERROR: StmtExpr should have only one statement.\n" in let res_trans_stmt = instruction trans_state stmt in @@ -1364,7 +1364,7 @@ struct let continuation_cond = mk_cond_continuation outer_continuation in let init_incr_nodes = match loop_kind with - | Loops.For (init, decl_stmt, cond, incr, body) -> + | Loops.For (init, _, _, incr, _) -> let trans_state' = { trans_state with succ_nodes = [join_node]; @@ -1391,12 +1391,12 @@ struct let body_succ_nodes = match loop_kind with | Loops.For _ -> (match init_incr_nodes with - | Some (nodes_init, nodes_incr) -> nodes_incr + | Some (_, nodes_incr) -> nodes_incr | None -> assert false) | Loops.While _ -> [join_node] | Loops.DoWhile _ -> res_trans_cond.root_nodes in let body_continuation = match continuation, init_incr_nodes with - | Some c, Some (nodes_init, nodes_incr) -> + | Some c, Some (_, nodes_incr) -> Some { c with continue = nodes_incr } | _ -> continuation in let res_trans_body = @@ -1421,7 +1421,7 @@ struct let root_nodes = match loop_kind with | Loops.For _ -> - (match init_incr_nodes with | Some (nodes_init, nodes_incr) -> nodes_init | None -> assert false) + (match init_incr_nodes with | Some (nodes_init, _) -> nodes_init | None -> assert false) | Loops.While _ | Loops.DoWhile _ -> [join_node] in { empty_res_trans with root_nodes = root_nodes; leaf_nodes = prune_nodes_f } @@ -1509,10 +1509,10 @@ struct collect_left_hand_exprs e tvar (StringSet.add (Typename.to_string typename) tns) | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) | Sil.Tstruct { Sil.instance_fields } as type_struct -> - let lh_exprs = IList.map ( fun (fieldname, fieldtype, _) -> + let lh_exprs = IList.map ( fun (fieldname, _, _) -> Sil.Lfield (e, fieldname, type_struct) ) instance_fields in - let lh_types = IList.map ( fun (fieldname, fieldtype, _) -> fieldtype) + let lh_types = IList.map ( fun (_, fieldtype, _) -> fieldtype) instance_fields in IList.map (fun (e, t) -> IList.flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) | Sil.Tarray (arrtyp, Sil.Const (Sil.Cint n)) -> @@ -1544,7 +1544,8 @@ struct (* In arc mode, if it's a method call or we are initializing with a pointer to objc class *) (* we need to add retain/release *) let (e, instrs, ids) = - CArithmetic_trans.assignment_arc_mode context lh_exp lh_t rh_exp sil_loc rhs_owning_method true in + CArithmetic_trans.assignment_arc_mode + lh_exp lh_t rh_exp sil_loc rhs_owning_method true in ([(e, lh_t)], instrs, ids) else ([], [Sil.Set (lh_exp, lh_t, rh_exp, sil_loc)], [])) @@ -1616,7 +1617,7 @@ struct (* we need to add retain/release *) let (e, instrs, ids) = CArithmetic_trans.assignment_arc_mode - context var_exp ie_typ sil_e1' sil_loc rhs_owning_method true in + var_exp ie_typ sil_e1' sil_loc rhs_owning_method true in ([(e, ie_typ)], instrs, ids) else ([], [Sil.Set (var_exp, ie_typ, sil_e1', sil_loc)], []) in @@ -1676,13 +1677,13 @@ struct empty_res_trans in { res_trans with leaf_nodes = [] } - and objCPropertyRefExpr_trans trans_state stmt_info stmt_list = + and objCPropertyRefExpr_trans trans_state stmt_list = match stmt_list with | [stmt] -> instruction trans_state stmt | _ -> assert false (* For OpaqueValueExpr we return the translation generated from its source expression*) - and opaqueValueExpr_trans trans_state stmt_info opaque_value_expr_info = + and opaqueValueExpr_trans trans_state opaque_value_expr_info = Printing.log_out " priority node free = '%s'\n@." (string_of_bool (PriorityNode.is_priority_free trans_state)); match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with @@ -1703,7 +1704,7 @@ struct (* For example: 'x.f = a' when 'f' is a property will be translated with a call to f's setter [x f:a]*) (* the stmt_list will be [x.f = a; x; a; CallToSetter] Among all element of the list we only need*) (* to translate the CallToSetter which is how x.f = a is actually implemented by the runtime.*) - and pseudoObjectExpr_trans trans_state stmt_info stmt_list = + and pseudoObjectExpr_trans trans_state stmt_list = Printing.log_out " priority node free = '%s'\n@." (string_of_bool (PriorityNode.is_priority_free trans_state)); let rec do_semantic_elements el = @@ -1713,7 +1714,7 @@ struct | stmt :: _ -> instruction trans_state stmt | _ -> assert false in match stmt_list with - | syntactic_form :: semantic_form -> + | _ :: semantic_form -> do_semantic_elements semantic_form | _ -> assert false @@ -1737,7 +1738,7 @@ struct } (* function used in the computation for both Member_Expr and ObjCIVarRefExpr *) - and do_memb_ivar_ref_exp trans_state expr_info stmt_info stmt_list decl_ref = + and do_memb_ivar_ref_exp trans_state stmt_info stmt_list decl_ref = let exp_stmt = extract_stmt_from_singleton stmt_list "WARNING: in MemberExpr there must be only one stmt defining its expression.\n" in (* Don't pass var_exp_typ to child of MemberExpr - this may lead to initializing variable *) @@ -1747,14 +1748,14 @@ struct let result_trans_exp_stmt = exec_with_glvalue_as_reference instruction trans_state' exp_stmt in decl_ref_trans trans_state result_trans_exp_stmt stmt_info decl_ref - and objCIvarRefExpr_trans trans_state stmt_info expr_info stmt_list obj_c_ivar_ref_expr_info = + and objCIvarRefExpr_trans trans_state stmt_info stmt_list obj_c_ivar_ref_expr_info = let decl_ref = obj_c_ivar_ref_expr_info.Clang_ast_t.ovrei_decl_ref in CFrontend_errors.check_for_ivar_errors trans_state.context stmt_info obj_c_ivar_ref_expr_info; - do_memb_ivar_ref_exp trans_state expr_info stmt_info stmt_list decl_ref + do_memb_ivar_ref_exp trans_state stmt_info stmt_list decl_ref - and memberExpr_trans trans_state stmt_info expr_info stmt_list member_expr_info = + and memberExpr_trans trans_state stmt_info stmt_list member_expr_info = let decl_ref = member_expr_info.Clang_ast_t.mei_decl_ref in - do_memb_ivar_ref_exp trans_state expr_info stmt_info stmt_list decl_ref + do_memb_ivar_ref_exp trans_state stmt_info stmt_list decl_ref and unaryOperator_trans trans_state stmt_info expr_info stmt_list unary_operator_info = let context = trans_state.context in @@ -1804,7 +1805,7 @@ struct succ_nodes = []; var_exp_typ = Some (ret_exp, ret_typ) } in let res_trans_stmt = exec_with_self_exception instruction trans_state' stmt in - let (sil_expr, sil_typ) = extract_exp_from_list res_trans_stmt.exps + let (sil_expr, _) = extract_exp_from_list res_trans_stmt.exps "WARNING: There should be only one return expression.\n" in let ret_instrs = if IList.exists (Sil.exp_equal ret_exp) res_trans_stmt.initd_exps @@ -1830,7 +1831,7 @@ struct (* It may be that later on (when we treat ARC) some info can be taken from it. *) (* For ParenExpression we translate its body composed by the stmt_list. *) (* In paren expression there should be only one stmt that defines the expression *) - and parenExpr_trans trans_state stmt_info stmt_list = + and parenExpr_trans trans_state stmt_list = let stmt = extract_stmt_from_singleton stmt_list "WARNING: In ParenExpression there should be only one stmt.\n" in instruction trans_state stmt @@ -1888,7 +1889,7 @@ struct (* We ignore this item since we don't deal with the concurrency problem yet *) (* For the same reason we also ignore the stmt_info that is related with the ObjCAtSynchronizedStmt construct *) (* Finally we recursively work on the CompoundStmt, the second item of stmt_list *) - and objCAtSynchronizedStmt_trans trans_state stmt_info stmt_list = + and objCAtSynchronizedStmt_trans trans_state stmt_list = (match stmt_list with | [_; compound_stmt] -> instruction trans_state compound_stmt | _ -> assert false) @@ -1897,7 +1898,7 @@ struct let context = trans_state.context in let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in let loc = - (match stmt_info.Clang_ast_t.si_source_range with (l1, l2) -> + (match stmt_info.Clang_ast_t.si_source_range with (l1, _) -> CLocation.clang_to_sil_location l1 (Some context.CContext.procdesc)) in (* Given a captured var, return the instruction to assign it to a temp *) let assign_captured_var (cvar, typ) = @@ -1905,7 +1906,7 @@ struct let instr = Sil.Letderef (id, (Sil.Lvar cvar), typ, loc) in (id, instr) in match decl with - | Clang_ast_t.BlockDecl (decl_info, block_decl_info) -> + | Clang_ast_t.BlockDecl (_, block_decl_info) -> let open CContext in let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let block_pname = CFrontend_utils.General_utils.mk_fresh_block_procname procname in @@ -1941,7 +1942,7 @@ struct (* 1. Handle __new_array *) (* 2. Handle initialization values *) - and cxxDeleteExpr_trans trans_state stmt_info stmt_list expr_info delete_expr_info = + and cxxDeleteExpr_trans trans_state stmt_info stmt_list delete_expr_info = let context = trans_state.context in let sil_loc = CLocation.get_sil_location stmt_info context in let fname = SymExec.ModelBuiltins.__delete in @@ -1979,7 +1980,7 @@ struct let res_trans = init_expr_trans trans_state var_exp_typ stmt_info (Some temp_exp) in { res_trans with exps = [var_exp_typ] } - and compoundLiteralExpr_trans trans_state stmt_info stmt_list expr_info = + and compoundLiteralExpr_trans trans_state stmt_list expr_info = let context = trans_state.context in let procdesc = context.CContext.procdesc in let (pvar, typ) = mk_temp_sil_var_for_expr context.CContext.tenv procdesc @@ -2036,8 +2037,8 @@ struct | LabelStmt(stmt_info, stmt_list, label_name) -> labelStmt_trans trans_state stmt_info stmt_list label_name - | ArraySubscriptExpr(stmt_info, stmt_list, expr_info) -> - arraySubscriptExpr_trans trans_state stmt_info expr_info stmt_list + | ArraySubscriptExpr(_, stmt_list, expr_info) -> + arraySubscriptExpr_trans trans_state expr_info stmt_list | BinaryOperator(stmt_info, stmt_list, expr_info, binary_operator_info) -> binaryOperator_trans trans_state binary_operator_info stmt_info expr_info stmt_list @@ -2045,7 +2046,7 @@ struct | CallExpr(stmt_info, stmt_list, ei) -> (match is_dispatch_function stmt_list with | Some block_arg_pos -> - dispatch_function_trans trans_state stmt_info stmt_list ei block_arg_pos + dispatch_function_trans trans_state stmt_info stmt_list block_arg_pos | None -> callExpr_trans trans_state stmt_info stmt_list ei) @@ -2065,9 +2066,9 @@ struct else objCMessageExpr_trans trans_state stmt_info obj_c_message_expr_info stmt_list expr_info - | CompoundStmt (stmt_info, stmt_list) -> + | CompoundStmt (_, stmt_list) -> (* No node for this statement. We just collect its statement list*) - compoundStmt_trans trans_state stmt_info stmt_list + compoundStmt_trans trans_state stmt_list | ConditionalOperator(stmt_info, stmt_list, expr_info) -> (* Ternary operator "cond ? exp1 : exp2" *) @@ -2079,11 +2080,11 @@ struct | SwitchStmt (stmt_info, switch_stmt_list) -> switchStmt_trans trans_state stmt_info switch_stmt_list - | CaseStmt (stmt_info, stmt_list) -> + | CaseStmt _ -> Printing.log_out "FATAL: Passing from CaseStmt outside of SwitchStmt, terminating.\n"; assert false - | StmtExpr(stmt_info, stmt_list, expr_info) -> - stmtExpr_trans trans_state stmt_info stmt_list expr_info + | StmtExpr(stmt_info, stmt_list, _) -> + stmtExpr_trans trans_state stmt_info stmt_list | ForStmt(stmt_info, [init; decl_stmt; cond; incr; body]) -> forStmt_trans trans_state init decl_stmt cond incr body stmt_info @@ -2100,31 +2101,31 @@ struct | ObjCForCollectionStmt(stmt_info, [item; items; body]) -> objCForCollectionStmt_trans trans_state item items body stmt_info - | NullStmt(stmt_info, stmt_list) -> - nullStmt_trans trans_state.succ_nodes stmt_info + | NullStmt _ -> + nullStmt_trans trans_state.succ_nodes - | CompoundAssignOperator(stmt_info, stmt_list, expr_info, binary_operator_info, caoi) -> + | CompoundAssignOperator(stmt_info, stmt_list, expr_info, binary_operator_info, _) -> binaryOperator_trans trans_state binary_operator_info stmt_info expr_info stmt_list - | DeclStmt(stmt_info, stmt_list, decl_list) -> + | DeclStmt(stmt_info, _, decl_list) -> declStmt_trans trans_state decl_list stmt_info - | DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) as d -> - declRefExpr_trans trans_state stmt_info expr_info decl_ref_expr_info d + | DeclRefExpr(stmt_info, _, _, decl_ref_expr_info) as d -> + declRefExpr_trans trans_state stmt_info decl_ref_expr_info d - | ObjCPropertyRefExpr(stmt_info, stmt_list, expr_info, property_ref_expr_info) -> - objCPropertyRefExpr_trans trans_state stmt_info stmt_list + | ObjCPropertyRefExpr(_, stmt_list, _, _) -> + objCPropertyRefExpr_trans trans_state stmt_list | CXXThisExpr(stmt_info, _, expr_info) -> cxxThisExpr_trans trans_state stmt_info expr_info - | OpaqueValueExpr(stmt_info, stmt_list, expr_info, opaque_value_expr_info) -> - opaqueValueExpr_trans trans_state stmt_info opaque_value_expr_info + | OpaqueValueExpr(_, _, _, opaque_value_expr_info) -> + opaqueValueExpr_trans trans_state opaque_value_expr_info - | PseudoObjectExpr(stmt_info, stmt_list, expr_info) -> - pseudoObjectExpr_trans trans_state stmt_info stmt_list + | PseudoObjectExpr(_, stmt_list, _) -> + pseudoObjectExpr_trans trans_state stmt_list - | UnaryExprOrTypeTraitExpr(stmt_info, stmt_list, expr_info, ei) -> - unaryExprOrTypeTraitExpr_trans trans_state stmt_info expr_info ei + | UnaryExprOrTypeTraitExpr(_, _, expr_info, ei) -> + unaryExprOrTypeTraitExpr_trans trans_state expr_info ei | ObjCBridgedCastExpr(stmt_info, stmt_list, expr_info, cast_kind, _) -> cast_exprs_trans trans_state stmt_info stmt_list expr_info cast_kind true @@ -2136,32 +2137,32 @@ struct | CXXFunctionalCastExpr(stmt_info, stmt_list, expr_info, cast_kind, _)-> cast_exprs_trans trans_state stmt_info stmt_list expr_info cast_kind false - | IntegerLiteral(stmt_info, _, expr_info, integer_literal_info) -> - integerLiteral_trans trans_state stmt_info expr_info integer_literal_info + | IntegerLiteral(_, _, expr_info, integer_literal_info) -> + integerLiteral_trans trans_state expr_info integer_literal_info - | StringLiteral(stmt_info, stmt_list, expr_info, str) -> - stringLiteral_trans trans_state stmt_info expr_info str + | StringLiteral(_, _, expr_info, str) -> + stringLiteral_trans trans_state expr_info str - | GNUNullExpr(stmt_info, stmt_list, expr_info) -> - gNUNullExpr_trans trans_state stmt_info expr_info + | GNUNullExpr(_, _, expr_info) -> + gNUNullExpr_trans trans_state expr_info - | CXXNullPtrLiteralExpr(stmt_info, stmt_list, expr_info) -> - nullPtrExpr_trans trans_state stmt_info expr_info + | CXXNullPtrLiteralExpr(_, _, expr_info) -> + nullPtrExpr_trans trans_state expr_info - | ObjCSelectorExpr(stmt_info, stmt_list, expr_info, selector) -> - objCSelectorExpr_trans trans_state stmt_info expr_info selector + | ObjCSelectorExpr(_, _, expr_info, selector) -> + objCSelectorExpr_trans trans_state expr_info selector - | ObjCEncodeExpr(stmt_info, stmt_list, expr_info, type_ptr) -> - objCEncodeExpr_trans trans_state stmt_info expr_info type_ptr + | ObjCEncodeExpr(_, _, expr_info, type_ptr) -> + objCEncodeExpr_trans trans_state expr_info type_ptr - | ObjCProtocolExpr(stmt_info, stmt_list, expr_info, decl_ref) -> - objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref + | ObjCProtocolExpr(_, _, expr_info, decl_ref) -> + objCProtocolExpr_trans trans_state expr_info decl_ref - | ObjCIvarRefExpr(stmt_info, stmt_list, expr_info, obj_c_ivar_ref_expr_info) -> - objCIvarRefExpr_trans trans_state stmt_info expr_info stmt_list obj_c_ivar_ref_expr_info + | ObjCIvarRefExpr(stmt_info, stmt_list, _, obj_c_ivar_ref_expr_info) -> + objCIvarRefExpr_trans trans_state stmt_info stmt_list obj_c_ivar_ref_expr_info - | MemberExpr(stmt_info, stmt_list, expr_info, member_expr_info) -> - memberExpr_trans trans_state stmt_info expr_info stmt_list member_expr_info + | MemberExpr(stmt_info, stmt_list, _, member_expr_info) -> + memberExpr_trans trans_state stmt_info stmt_list member_expr_info | UnaryOperator(stmt_info, stmt_list, expr_info, unary_operator_info) -> if is_logical_negation_of_int trans_state.context.CContext.tenv expr_info unary_operator_info then @@ -2175,20 +2176,20 @@ struct (* We analyze the content of the expr. We treat ExprWithCleanups as a wrapper. *) (* It may be that later on (when we treat ARC) some info can be taken from it. *) - | ExprWithCleanups(stmt_info, stmt_list, expr_info, _) - | ParenExpr(stmt_info, stmt_list, expr_info) -> - parenExpr_trans trans_state stmt_info stmt_list + | ExprWithCleanups(_, stmt_list, _, _) + | ParenExpr(_, stmt_list, _) -> + parenExpr_trans trans_state stmt_list - | ObjCBoolLiteralExpr (stmt_info, stmts, expr_info, n) - | CharacterLiteral (stmt_info, stmts, expr_info, n) - | CXXBoolLiteralExpr (stmt_info, stmts, expr_info, n) -> - characterLiteral_trans trans_state stmt_info expr_info n + | ObjCBoolLiteralExpr (_, _, expr_info, n) + | CharacterLiteral (_, _, expr_info, n) + | CXXBoolLiteralExpr (_, _, expr_info, n) -> + characterLiteral_trans trans_state expr_info n - | FloatingLiteral (stmt_info, stmts, expr_info, float_string) -> - floatingLiteral_trans trans_state stmt_info expr_info float_string + | FloatingLiteral (_, _, expr_info, float_string) -> + floatingLiteral_trans trans_state expr_info float_string - | CXXScalarValueInitExpr (stmt_info, stmts, expr_info) -> - cxxScalarValueInitExpr_trans trans_state stmt_info expr_info + | CXXScalarValueInitExpr (_, _, expr_info) -> + cxxScalarValueInitExpr_trans trans_state expr_info | ObjCBoxedExpr (stmt_info, stmts, info, sel) -> objCBoxedExpr_trans trans_state info sel stmt_info stmts @@ -2202,14 +2203,14 @@ struct | ObjCStringLiteral(stmt_info, stmts, info) -> objCStringLiteral_trans trans_state stmt_info stmts info - | BreakStmt(stmt_info, lstmt) -> breakStmt_trans trans_state + | BreakStmt _ -> breakStmt_trans trans_state - | ContinueStmt(stmt_infr, lstmt) -> continueStmt_trans trans_state + | ContinueStmt _ -> continueStmt_trans trans_state - | ObjCAtSynchronizedStmt(stmt_info, stmt_list) -> - objCAtSynchronizedStmt_trans trans_state stmt_info stmt_list + | ObjCAtSynchronizedStmt(_, stmt_list) -> + objCAtSynchronizedStmt_trans trans_state stmt_list - | ObjCIndirectCopyRestoreExpr (stmt_info, stmt_list, _) -> + | ObjCIndirectCopyRestoreExpr (_, stmt_list, _) -> instructions trans_state stmt_list | BlockExpr(stmt_info, _ , expr_info, decl) -> @@ -2218,20 +2219,20 @@ struct | ObjCAutoreleasePoolStmt (stmt_info, stmts) -> objcAutoreleasePool_trans trans_state stmt_info stmts - | ObjCAtTryStmt (stmt_info, stmts) -> - compoundStmt_trans trans_state stmt_info stmts + | ObjCAtTryStmt (_, stmts) -> + compoundStmt_trans trans_state stmts | ObjCAtThrowStmt (stmt_info, stmts) -> returnStmt_trans trans_state stmt_info stmts - | ObjCAtFinallyStmt (stmt_info, stmts) -> - compoundStmt_trans trans_state stmt_info stmts + | ObjCAtFinallyStmt (_, stmts) -> + compoundStmt_trans trans_state stmts - | ObjCAtCatchStmt (stmt_info, stmts, obj_c_message_expr_kind) -> - compoundStmt_trans trans_state stmt_info [] + | ObjCAtCatchStmt _ -> + compoundStmt_trans trans_state [] - | PredefinedExpr (stmt_info, stmts, expr_info, predefined_expr_type) -> - stringLiteral_trans trans_state stmt_info expr_info "" + | PredefinedExpr (_, _, expr_info, _) -> + stringLiteral_trans trans_state expr_info "" | BinaryConditionalOperator (stmt_info, stmts, expr_info) -> (match stmts with @@ -2241,25 +2242,25 @@ struct "BinaryConditionalOperator not translated %s @." (Ast_utils.string_of_stmt instr); assert false) - | CXXNewExpr (stmt_info, stmt_list, expr_info, _) -> + | CXXNewExpr (stmt_info, _, expr_info, _) -> cxxNewExpr_trans trans_state stmt_info expr_info - | CXXDeleteExpr (stmt_info, stmt_list, expr_info, delete_expr_info) -> - cxxDeleteExpr_trans trans_state stmt_info stmt_list expr_info delete_expr_info + | CXXDeleteExpr (stmt_info, stmt_list, _, delete_expr_info) -> + cxxDeleteExpr_trans trans_state stmt_info stmt_list delete_expr_info | MaterializeTemporaryExpr (stmt_info, stmt_list, expr_info, _) -> materializeTemporaryExpr_trans trans_state stmt_info stmt_list expr_info - | CompoundLiteralExpr (stmt_info, stmt_list, expr_info) -> - compoundLiteralExpr_trans trans_state stmt_info stmt_list expr_info + | CompoundLiteralExpr (_, stmt_list, expr_info) -> + compoundLiteralExpr_trans trans_state stmt_list expr_info | InitListExpr (stmt_info, stmts, expr_info) -> initListExpr_trans trans_state stmt_info expr_info stmts - | CXXBindTemporaryExpr (stmt_info, stmt_list, expr_info, cxx_bind_temp_expr_info) -> + | CXXBindTemporaryExpr (_, stmt_list, _, _) -> (* right now we ignore this expression and try to translate the child node *) - parenExpr_trans trans_state stmt_info stmt_list + parenExpr_trans trans_state stmt_list - | CXXDynamicCastExpr (stmt_info, stmts, expr_info, cast_expr_info, type_ptr, _) -> + | CXXDynamicCastExpr (stmt_info, stmts, _, _, type_ptr, _) -> cxxDynamicCastExpr_trans trans_state stmt_info stmts type_ptr - | CXXDefaultArgExpr (stmt_info, stmt_list, expr_info, default_arg_info) -> + | CXXDefaultArgExpr (_, _, _, default_arg_info) -> cxxDefaultArgExpr_trans trans_state default_arg_info | s -> (Printing.log_stats diff --git a/infer/src/clang/cTrans_models.ml b/infer/src/clang/cTrans_models.ml index 3082afdac..ec9b613d9 100644 --- a/infer/src/clang/cTrans_models.ml +++ b/infer/src/clang/cTrans_models.ml @@ -35,11 +35,11 @@ let is_alloc_model typ funct = let rec get_func_type_from_stmt stmt = match stmt with - | Clang_ast_t.DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) -> + | Clang_ast_t.DeclRefExpr(_, _, expr_info, _) -> Some expr_info.Clang_ast_t.ei_type_ptr | _ -> match CFrontend_utils.Ast_utils.get_stmts_from_stmt stmt with - | stmt:: rest -> get_func_type_from_stmt stmt + | stmt:: _ -> get_func_type_from_stmt stmt | [] -> None let is_retain_predefined_model typ funct = @@ -138,7 +138,7 @@ let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname la get_predefined_ms_method condition class_name method_name Procname.Class_objc_method mk_procname lang [("x", Ast_expressions.create_char_star_type)] id_type [] None -let get_predefined_ms_retain_release class_name method_name mk_procname lang = +let get_predefined_ms_retain_release method_name mk_procname lang = let condition = is_retain_or_release method_name in let return_type = if is_retain_method method_name || is_autorelease_method method_name @@ -175,15 +175,14 @@ let get_predefined_ms_is_kind_of_class class_name method_name mk_procname lang = [] (Some SymExec.ModelBuiltins.__instanceof) let get_predefined_model_method_signature class_name method_name mk_procname lang = - let next_predefined f a = function + let next_predefined f = function | Some _ as x -> x - | None -> f a method_name mk_procname lang in - let class_type = Ast_expressions.create_class_type (class_name, `OBJC) in + | None -> f method_name mk_procname lang in get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname lang - |> next_predefined get_predefined_ms_retain_release class_type - |> next_predefined get_predefined_ms_stringWithUTF8String class_name - |> next_predefined get_predefined_ms_autoreleasepool_init class_name - |> next_predefined get_predefined_ms_is_kind_of_class class_name + |> next_predefined get_predefined_ms_retain_release + |> next_predefined (get_predefined_ms_stringWithUTF8String class_name) + |> next_predefined (get_predefined_ms_autoreleasepool_init class_name) + |> next_predefined (get_predefined_ms_is_kind_of_class class_name) let dispatch_functions = [ ("_dispatch_once", 1); diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index b4b92d68b..2825a0b3d 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -310,7 +310,7 @@ let alloc_trans trans_state loc stmt_info function_type is_cf_non_null_alloc = let objc_new_trans trans_state loc stmt_info cls_name function_type = let fname = SymExec.ModelBuiltins.__objc_alloc_no_fail in - let (alloc_ret_type, alloc_ret_id, alloc_stmt_call, alloc_exp) = + let (alloc_ret_type, alloc_ret_id, alloc_stmt_call, _) = create_alloc_instrs trans_state.context loc function_type fname in let init_ret_id = Ident.create_fresh Ident.knormal in let is_instance = true in @@ -440,7 +440,7 @@ let trans_assume_false sil_loc context succ_nodes = Cfg.Node.set_succs_exn prune_node succ_nodes []; { empty_res_trans with root_nodes = [prune_node]; leaf_nodes = [prune_node] } -let define_condition_side_effects context e_cond instrs_cond sil_loc = +let define_condition_side_effects e_cond instrs_cond sil_loc = let (e', typ) = extract_exp_from_list e_cond "\nWARNING: Missing expression in IfStmt. Need to be fixed\n" in match e' with | Sil.Lvar pvar -> @@ -575,7 +575,7 @@ let rec is_owning_method s = let rec is_method_call s = match s with - | Clang_ast_t.ObjCMessageExpr (_, _ , _, mei) -> true + | Clang_ast_t.ObjCMessageExpr _ -> true | _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with | [] -> false | s'':: _ -> is_method_call s'') @@ -588,14 +588,14 @@ let get_info_from_decl_ref decl_ref = let rec get_decl_ref_info s = match s with - | Clang_ast_t.DeclRefExpr (stmt_info, stmt_list, expr_info, decl_ref_expr_info) -> + | Clang_ast_t.DeclRefExpr (_, _, _, decl_ref_expr_info) -> (match decl_ref_expr_info.Clang_ast_t.drti_decl_ref with | Some decl_ref -> decl_ref | None -> assert false) | _ -> match Clang_ast_proj.get_stmt_tuple s with - | stmt_info, [] -> assert false - | stmt_info, s'':: _ -> + | _, [] -> assert false + | _, s'':: _ -> get_decl_ref_info s'' let rec contains_opaque_value_expr s = @@ -624,7 +624,7 @@ let is_dispatch_function stmt_list = let s = name_info.Clang_ast_t.ni_name in (match (CTrans_models.is_dispatch_function_name s) with | None -> None - | Some (dispatch_function, block_arg_pos) -> + | Some (_, block_arg_pos) -> try (match IList.nth stmts block_arg_pos with | BlockExpr _ -> Some block_arg_pos diff --git a/infer/src/clang/cTrans_utils.mli b/infer/src/clang/cTrans_utils.mli index de8727652..bf53e568e 100644 --- a/infer/src/clang/cTrans_utils.mli +++ b/infer/src/clang/cTrans_utils.mli @@ -55,7 +55,7 @@ val fix_param_exps_mismatch : 'a list -> (Sil.exp * Sil.typ) list -> (Sil.exp * val get_selector_receiver : Clang_ast_t.obj_c_message_expr_info -> string * Clang_ast_t.receiver_kind val define_condition_side_effects : - CContext.t -> (Sil.exp * Sil.typ) list -> Sil.instr list -> Location.t -> + (Sil.exp * Sil.typ) list -> Sil.instr list -> Location.t -> (Sil.exp * Sil.typ) list * Sil.instr list val extract_stmt_from_singleton : Clang_ast_t.stmt list -> string -> Clang_ast_t.stmt diff --git a/infer/src/clang/cType_to_sil_type.ml b/infer/src/clang/cType_to_sil_type.ml index e7c841909..f6e4abaa4 100644 --- a/infer/src/clang/cType_to_sil_type.ml +++ b/infer/src/clang/cType_to_sil_type.ml @@ -68,7 +68,7 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info = match type_info.Clang_ast_t.ti_desugared_type with | Some type_ptr -> (match Ast_utils.get_type type_ptr with - | Some Clang_ast_t.ObjCObjectPointerType (type_info', type_ptr') -> + | Some Clang_ast_t.ObjCObjectPointerType (_, type_ptr') -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr' in Sil.Tptr (typ, pointer_attribute_of_objc_attribute attr_info) | _ -> type_ptr_to_sil_type translate_decl tenv type_ptr) @@ -77,44 +77,44 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info = and sil_type_of_c_type translate_decl tenv c_type = let open Clang_ast_t in match c_type with - | NoneType (type_info) -> Sil.Tvoid - | BuiltinType (type_info, builtin_type_kind) -> + | NoneType _ -> Sil.Tvoid + | BuiltinType (_, builtin_type_kind) -> sil_type_of_builtin_type_kind builtin_type_kind - | PointerType (type_info, type_ptr) - | ObjCObjectPointerType (type_info, type_ptr) -> + | PointerType (_, type_ptr) + | ObjCObjectPointerType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in if Sil.typ_equal typ (get_builtin_objc_type `ObjCClass) then typ else Sil.Tptr (typ, Sil.Pk_pointer) - | ObjCObjectType (type_info, objc_object_type_info) -> + | ObjCObjectType (_, objc_object_type_info) -> type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type - | BlockPointerType (type_info, type_ptr) -> + | BlockPointerType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in Sil.Tptr (typ, Sil.Pk_pointer) - | IncompleteArrayType (type_info, type_ptr) - | DependentSizedArrayType (type_info, type_ptr) - | VariableArrayType (type_info, type_ptr) -> + | IncompleteArrayType (_, type_ptr) + | DependentSizedArrayType (_, type_ptr) + | VariableArrayType (_, type_ptr) -> build_array_type translate_decl tenv type_ptr (-1) - | ConstantArrayType (type_info, type_ptr, n) -> + | ConstantArrayType (_, type_ptr, n) -> build_array_type translate_decl tenv type_ptr n - | FunctionProtoType (type_info, function_type_info, _) - | FunctionNoProtoType (type_info, function_type_info) -> + | FunctionProtoType _ + | FunctionNoProtoType _ -> Sil.Tfun false - | ParenType (type_info, type_ptr) -> + | ParenType (_, type_ptr) -> type_ptr_to_sil_type translate_decl tenv type_ptr - | DecayedType (type_info, type_ptr) -> + | DecayedType (_, type_ptr) -> type_ptr_to_sil_type translate_decl tenv type_ptr - | RecordType (type_info, pointer) - | EnumType (type_info, pointer) -> + | RecordType (_, pointer) + | EnumType (_, pointer) -> decl_ptr_to_sil_type translate_decl tenv pointer | ElaboratedType (type_info) -> (match type_info.Clang_ast_t.ti_desugared_type with Some type_ptr -> type_ptr_to_sil_type translate_decl tenv type_ptr | None -> Sil.Tvoid) - | ObjCInterfaceType (type_info, pointer) -> + | ObjCInterfaceType (_, pointer) -> decl_ptr_to_sil_type translate_decl tenv pointer - | RValueReferenceType (type_info, type_ptr) - | LValueReferenceType (type_info, type_ptr) -> + | RValueReferenceType (_, type_ptr) + | LValueReferenceType (_, type_ptr) -> let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in Sil.Tptr (typ, Sil.Pk_reference) | AttributedType (type_info, attr_info) -> diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 1b407b8c0..b87604f55 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -44,7 +44,7 @@ let classname_of_type typ = let search_enum_type_by_name tenv name = let found = ref None in let mname = Mangled.from_string name in - let f tn typ = + let f _ typ = match typ with | Sil.Tenum enum_constants -> IList.iter (fun (c, v) -> if Mangled.equal c mname then found:= Some v else ()) enum_constants @@ -68,10 +68,10 @@ let is_class typ = let rec return_type_of_function_type_ptr type_ptr = let open Clang_ast_t in match Ast_utils.get_type type_ptr with - | Some FunctionProtoType (type_info, function_type_info, _) - | Some FunctionNoProtoType (type_info, function_type_info) -> + | Some FunctionProtoType (_, function_type_info, _) + | Some FunctionNoProtoType (_, function_type_info) -> function_type_info.Clang_ast_t.fti_return_type - | Some BlockPointerType (type_info, in_type_ptr) -> + | Some BlockPointerType (_, in_type_ptr) -> return_type_of_function_type_ptr in_type_ptr | Some _ -> Printing.log_err "Warning: Type pointer %s is not a function type." @@ -108,7 +108,7 @@ let rec expand_structured_type tenv typ = typ else expand_structured_type tenv t | None -> typ) - | Sil.Tptr(t, _) -> typ (*do not expand types under pointers *) + | Sil.Tptr _ -> typ (*do not expand types under pointers *) | _ -> typ (* To be called with strings of format "*" *) diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 750fe1987..1c7ffa79f 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -41,7 +41,7 @@ let add_predefined_objc_types tenv = (* Whenever new type are added manually to the translation in ast_expressions, *) (* they should be added here too!! *) -let add_predefined_basic_types tenv = +let add_predefined_basic_types () = let open Ast_expressions in let add_basic_type tp basic_type_kind = let sil_type = CType_to_sil_type.sil_type_of_builtin_type_kind basic_type_kind in @@ -71,16 +71,16 @@ let add_predefined_basic_types tenv = let add_predefined_types tenv = add_predefined_objc_types tenv; - add_predefined_basic_types tenv + add_predefined_basic_types () let create_csu opt_type = match opt_type with | `Type s -> (let buf = Str.split (Str.regexp "[ \t]+") s in match buf with - | "struct":: l ->Csu.Struct - | "class":: l -> Csu.Class Csu.CPP - | "union":: l -> Csu.Union + | "struct":: _ ->Csu.Struct + | "class":: _ -> Csu.Class Csu.CPP + | "union":: _ -> Csu.Union | _ -> Csu.Struct) | _ -> assert false @@ -90,8 +90,8 @@ let get_record_name_csu decl = let name_info, csu = match decl with | RecordDecl (_, name_info, opt_type, _, _, _, _) -> name_info, create_csu opt_type - | CXXRecordDecl (_, name_info, opt_type, _, _, _, _, _) - | ClassTemplateSpecializationDecl (_, name_info, opt_type, _, _, _, _, _) -> + | CXXRecordDecl (_, name_info, _, _, _, _, _, _) + | ClassTemplateSpecializationDecl (_, name_info, _, _, _, _, _, _) -> (* we use Csu.Class for C++ because we expect Csu.Class csu from *) (* types that have methods. And in C++ struct/class/union can have methods *) name_info, Csu.Class Csu.CPP @@ -101,12 +101,12 @@ let get_record_name_csu decl = let get_record_name decl = snd (get_record_name_csu decl) -let get_class_methods tenv class_name decl_list = +let get_class_methods class_name decl_list = let process_method_decl = function - | Clang_ast_t.CXXMethodDecl (decl_info, name_info, tp, function_decl_info, _) - | Clang_ast_t.CXXConstructorDecl (decl_info, name_info, tp, function_decl_info, _) - | Clang_ast_t.CXXConversionDecl (decl_info, name_info, tp, function_decl_info, _) - | Clang_ast_t.CXXDestructorDecl (decl_info, name_info, tp, function_decl_info, _) -> + | Clang_ast_t.CXXMethodDecl (_, name_info, tp, _, _) + | Clang_ast_t.CXXConstructorDecl (_, name_info, tp, _, _) + | Clang_ast_t.CXXConversionDecl (_, name_info, tp, _, _) + | Clang_ast_t.CXXDestructorDecl (_, name_info, tp, _, _) -> let method_name = name_info.Clang_ast_t.ni_name in Printing.log_out " ...Declaring method '%s'.\n" method_name; let method_proc = General_utils.mk_procname_from_cpp_method class_name method_name tp in @@ -186,7 +186,7 @@ and get_struct_cpp_class_declaration_type tenv decl = General_utils.append_no_duplicates_fields extra_fields non_static_fields in let sorted_non_static_fields = General_utils.sort_fields non_static_fields' in let static_fields = [] in (* Note: We treat static field same as global variables *) - let def_methods = get_class_methods tenv name decl_list in (* C++ methods only *) + let def_methods = get_class_methods name decl_list in (* C++ methods only *) let superclasses = get_superclass_list_cpp decl in let sil_type = Sil.Tstruct { Sil.instance_fields = sorted_non_static_fields; diff --git a/infer/src/clang/cVar_decl.ml b/infer/src/clang/cVar_decl.ml index dc64d926a..d994aa260 100644 --- a/infer/src/clang/cVar_decl.ml +++ b/infer/src/clang/cVar_decl.ml @@ -58,7 +58,7 @@ let sil_var_of_decl_ref context decl_ref procname = let add_var_to_locals procdesc var_decl sil_typ pvar = let open Clang_ast_t in match var_decl with - | VarDecl (di, var_name, type_ptr, vdi) -> + | VarDecl (_, _, _, vdi) -> if not vdi.Clang_ast_t.vdi_is_global then Cfg.Procdesc.append_locals procdesc [(Sil.pvar_get_name pvar, sil_typ)] | _ -> assert false @@ -67,7 +67,7 @@ let rec compute_autorelease_pool_vars context stmts = let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in match stmts with | [] -> [] - | Clang_ast_t.DeclRefExpr (si, sl, ei, drei):: stmts' -> + | Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' -> (let res = compute_autorelease_pool_vars context stmts' in match drei.Clang_ast_t.drti_decl_ref with | Some decl_ref -> diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index 0001fb4dd..0ba6bf39e 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -52,15 +52,15 @@ let get_base_class_name_from_category decl = let open Clang_ast_t in let base_class_pointer_opt = match decl with - | ObjCCategoryDecl (decl_info, name_info, decl_list, decl_context_info, cdi) -> + | ObjCCategoryDecl (_, _, _, _, cdi) -> cdi.Clang_ast_t.odi_class_interface - | ObjCCategoryImplDecl (decl_info, name_info, decl_list, decl_context_info, cii) -> + | ObjCCategoryImplDecl (_, _, _, _, cii) -> cii.Clang_ast_t.ocidi_class_interface | _ -> None in match base_class_pointer_opt with | Some decl_ref -> (match Ast_utils.get_decl decl_ref.Clang_ast_t.dr_decl_pointer with - | Some ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) -> + | Some ObjCInterfaceDecl (_, name_info, _, _, _) -> Some (Ast_utils.get_qualified_name name_info) | _ -> None) | None -> None @@ -98,7 +98,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = let category_decl type_ptr_to_sil_type tenv decl = let open Clang_ast_t in match decl with - | ObjCCategoryDecl (decl_info, name_info, decl_list, decl_context_info, cdi) -> + | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = get_curr_class_from_category_decl name cdi in Printing.log_out "ADDING: ObjCCategoryDecl for '%s'\n" name; @@ -111,7 +111,7 @@ let category_decl type_ptr_to_sil_type tenv decl = let category_impl_decl type_ptr_to_sil_type tenv decl = let open Clang_ast_t in match decl with - | ObjCCategoryImplDecl (decl_info, name_info, decl_list, decl_context_info, cii) -> + | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) -> let name = Ast_utils.get_qualified_name name_info in let curr_class = get_curr_class_from_category_impl name cii in Printing.log_out "ADDING: ObjCCategoryImplDecl for '%s'\n" name; diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 43f5d2099..3aa9c2436 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -87,7 +87,7 @@ let get_interface_superclasses super_opt protocols = let super_classes = super_class@protocol_names in super_classes -let create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list class_name +let create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list otdi_super otdi_protocols = let super = get_super_interface_decl otdi_super in let protocols = get_protocols otdi_protocols in @@ -102,7 +102,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name); let superclasses, fields = - create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list class_name + create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list ocidi.Clang_ast_t.otdi_super ocidi.Clang_ast_t.otdi_protocols in let methods = ObjcProperty_decl.get_methods curr_class decl_list in @@ -123,7 +123,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name let fields = General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in let fields = General_utils.sort_fields fields in Printing.log_out "Class %s field:\n" class_name; - IList.iter (fun (fn, ft, _) -> + IList.iter (fun (fn, _, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = Sil.Tstruct { @@ -151,8 +151,8 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class = (match Sil.tenv_lookup tenv class_tn_name with | Some Sil.Tstruct ({ Sil.static_fields = []; - csu = Csu.Class ck; - struct_name = Some name; + csu = Csu.Class _; + struct_name = Some _; def_methods; } as struct_typ) -> let methods = General_utils.append_no_duplicates_methods def_methods methods in @@ -185,7 +185,7 @@ let interface_declaration type_ptr_to_sil_type tenv decl = let interface_impl_declaration type_ptr_to_sil_type tenv decl = let open Clang_ast_t in match decl with - | ObjCImplementationDecl (decl_info, name_info, decl_list, decl_context_info, idi) -> + | ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) -> let class_name = Ast_utils.get_qualified_name name_info in Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name; let _ = add_class_decl type_ptr_to_sil_type tenv idi in diff --git a/infer/src/clang/objcProperty_decl.ml b/infer/src/clang/objcProperty_decl.ml index 43042ecf0..b05fa2320 100644 --- a/infer/src/clang/objcProperty_decl.ml +++ b/infer/src/clang/objcProperty_decl.ml @@ -28,7 +28,7 @@ let get_methods curr_class decl_list = let class_name = CContext.get_curr_class_name curr_class in let get_method decl list_methods = match decl with - | Clang_ast_t.ObjCMethodDecl (decl_info, name_info, method_decl_info) -> + | Clang_ast_t.ObjCMethodDecl (_, name_info, method_decl_info) -> let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in let method_kind = Procname.objc_method_kind_of_bool is_instance in let method_name = name_info.Clang_ast_t.ni_name in diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index 80853ae44..f1ba2987d 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -49,5 +49,5 @@ let protocol_decl type_ptr_to_sil_type tenv decl = let is_protocol decl = let open Clang_ast_t in match decl with - | ObjCProtocolDecl(decl_info, name_info, decl_list, _, obj_c_protocol_decl_info) -> true + | ObjCProtocolDecl _ -> true | _ -> false diff --git a/infer/src/eradicate/eradicate.ml b/infer/src/eradicate/eradicate.ml index 506191399..53834d2f9 100644 --- a/infer/src/eradicate/eradicate.ml +++ b/infer/src/eradicate/eradicate.ml @@ -69,7 +69,7 @@ struct | None -> () let callback1 - find_canonical_duplicate calls_this checks get_proc_desc idenv tenv curr_pname + find_canonical_duplicate calls_this checks get_proc_desc idenv curr_pname curr_pdesc annotated_signature linereader proc_loc : bool * Extension.extension TypeState.t option = let mk_pvar s = Sil.mk_pvar s curr_pname in @@ -100,7 +100,7 @@ struct checks.TypeCheck.check_ret_type; if checks.TypeCheck.eradicate then EradicateChecks.check_return_annotation - find_canonical_duplicate curr_pname curr_pdesc exit_node ret_range + find_canonical_duplicate curr_pname exit_node ret_range ret_ia ret_implicitly_nullable loc in let do_before_dataflow initial_typestate = @@ -131,7 +131,7 @@ struct (TypeState.pp Extension.ext) typestate_succ) typestates_succ; typestates_succ, typestates_exn - let proc_throws pn = DontKnow + let proc_throws _ = DontKnow end) in let initial_typestate = get_initial_typestate () in do_before_dataflow initial_typestate; @@ -181,7 +181,7 @@ struct }, ref false in callback1 find_canonical_duplicate calls_this' checks' get_proc_desc idenv_pn - tenv pname pdesc ann_sig linereader loc in + pname pdesc ann_sig linereader loc in let module Initializers = struct type init = Procname.t * Cfg.Procdesc.t @@ -201,8 +201,8 @@ struct get_class_opt init_pn = get_class_opt callee_pn in is_private && same_class in let private_called = PatternMatch.proc_calls - Specs.proc_resolve_attributes init_pn init_pd filter in - let do_called (callee_pn, callee_attributes) = + Specs.proc_resolve_attributes init_pd filter in + let do_called (callee_pn, _) = match get_proc_desc callee_pn with | Some callee_pd -> res := (callee_pn, callee_pd) :: !res @@ -260,7 +260,7 @@ struct (** Typestates after the current procedure and all initializer procedures. *) let final_initializer_typestates_lazy = lazy begin - let is_initializer pname proc_attributes = + let is_initializer proc_attributes = PatternMatch.method_is_initializer tenv proc_attributes || let ia, _ = (Models.get_modelled_annotated_signature proc_attributes).Annotations.ret in @@ -268,7 +268,7 @@ struct let initializers_current_class = pname_and_pdescs_with (function (pname, proc_attributes) -> - is_initializer pname proc_attributes && + is_initializer proc_attributes && Procname.java_get_class pname = Procname.java_get_class curr_pname) in final_typestates ((curr_pname, curr_pdesc) :: initializers_current_class) @@ -279,7 +279,7 @@ struct begin let constructors_current_class = pname_and_pdescs_with - (fun (pname, proc_attributes) -> + (fun (pname, _) -> Procname.is_constructor pname && Procname.java_get_class pname = Procname.java_get_class curr_pname) in final_typestates constructors_current_class @@ -317,7 +317,7 @@ struct do_final_typestate final_typestate_opt calls_this; if checks.TypeCheck.eradicate then EradicateChecks.check_overridden_annotations - find_canonical_duplicate get_proc_desc + find_canonical_duplicate tenv curr_pname curr_pdesc annotated_signature; @@ -367,9 +367,9 @@ struct type extension = unit let ext = let empty = () in - let check_instr get_proc_desc proc_name proc_desc node ext instr param = ext in + let check_instr _ _ _ ext _ _ = ext in let join () () = () in - let pp fmt () = () in + let pp _ () = () in { TypeState.empty = empty; check_instr = check_instr; diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 04c5592ad..e9c33c8df 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -118,7 +118,7 @@ type from_call = | From_containsKey (** x.containsKey *) (** Check the normalized "is zero" or "is not zero" condition of a prune instruction. *) -let check_condition case_zero find_canonical_duplicate get_proc_desc curr_pname +let check_condition case_zero find_canonical_duplicate curr_pname node e typ ta true_branch from_call idenv linereader loc instr_ref : unit = let is_fun_nonnull ta = match TypeAnnotation.get_origin ta with | TypeOrigin.Proc proc_origin -> @@ -186,7 +186,7 @@ let check_nonzero find_canonical_duplicate = check_condition false find_canonica (** Check an assignment to a field. *) let check_field_assignment find_canonical_duplicate curr_pname node instr_ref typestate exp_lhs - exp_rhs typ loc fname t_ia_opt typecheck_expr print_current_state : unit = + exp_rhs typ loc fname t_ia_opt typecheck_expr : unit = let (t_lhs, ta_lhs, _) = typecheck_expr node instr_ref curr_pname typestate exp_lhs (typ, TypeAnnotation.const Annotations.Nullable false TypeOrigin.ONone, [loc]) loc in @@ -253,7 +253,7 @@ let check_constructor_initialization then begin match PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc) with | Some (Sil.Tptr (Sil.Tstruct { Sil.instance_fields; struct_name } as ts, _)) -> - let do_field (fn, ft, ia) = + let do_field (fn, ft, _) = let annotated_with f = match get_field_annotation fn ts with | None -> false | Some (_, ia) -> f ia in @@ -347,7 +347,7 @@ let spec_make_return_nullable curr_pname = (** Check the annotations when returning from a method. *) let check_return_annotation - find_canonical_duplicate curr_pname curr_pdesc exit_node ret_range + find_canonical_duplicate curr_pname exit_node ret_range ret_ia ret_implicitly_nullable loc : unit = let ret_annotated_nullable = Annotations.ia_is_nullable ret_ia in let ret_annotated_present = Annotations.ia_is_present ret_ia in @@ -414,11 +414,10 @@ let check_call_receiver typestate call_params callee_pname - callee_loc (instr_ref : TypeErr.InstrRef.t) loc typecheck_expr - print_current_state : unit = + : unit = match call_params with | ((original_this_e, this_e), typ) :: _ -> let (_, this_ta, _) = @@ -447,8 +446,7 @@ let check_call_receiver (** Check the parameters of a call. *) let check_call_parameters find_canonical_duplicate curr_pname node typestate callee_attributes - sig_params call_params loc annotated_signature - instr_ref typecheck_expr print_current_state : unit = + sig_params call_params loc instr_ref typecheck_expr : unit = let callee_pname = callee_attributes.ProcAttributes.proc_name in let has_this = is_virtual sig_params in let tot_param_num = IList.length sig_params - (if has_this then 1 else 0) in @@ -515,7 +513,7 @@ let check_call_parameters (** Checks if the annotations are consistent with the inherited class or with the implemented interfaces *) let check_overridden_annotations - find_canonical_duplicate get_proc_desc tenv proc_name proc_desc annotated_signature = + find_canonical_duplicate tenv proc_name proc_desc annotated_signature = let start_node = Cfg.Procdesc.get_start_node proc_desc in let loc = Cfg.Node.get_loc start_node in @@ -537,8 +535,8 @@ let check_overridden_annotations and check_params overriden_proc_name overriden_signature = let compare pos current_param overriden_param : int = - let current_name, current_ia, current_type = current_param in - let _, overriden_ia, overriden_type = overriden_param in + let current_name, current_ia, _ = current_param in + let _, overriden_ia, _ = overriden_param in let () = if not (Annotations.ia_is_nullable current_ia) && Annotations.ia_is_nullable overriden_ia then diff --git a/infer/src/eradicate/modelTables.ml b/infer/src/eradicate/modelTables.ml index ed2170b97..32db8b988 100644 --- a/infer/src/eradicate/modelTables.ml +++ b/infer/src/eradicate/modelTables.ml @@ -48,7 +48,7 @@ let check_not_null_parameter_list, check_not_null_list = 1, (o, [n]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object):java.lang.Object"; 1, (o, [n; o]), "com.facebook.infer.annotation.Assertions.assumeNotNull(java.lang.Object,java.lang.String):java.lang.Object"; ] in - IList.map (fun (x, y, z) -> (x, z)) list, IList.map (fun (x, y, z) -> (y, z)) list + IList.map (fun (x, _, z) -> (x, z)) list, IList.map (fun (_, y, z) -> (y, z)) list let check_state_list = [ diff --git a/infer/src/eradicate/typeCheck.ml b/infer/src/eradicate/typeCheck.ml index fd5262af3..f05018011 100644 --- a/infer/src/eradicate/typeCheck.ml +++ b/infer/src/eradicate/typeCheck.ml @@ -43,7 +43,7 @@ module ComplexExpressions = struct let procname_optional_isPresent = Models.is_optional_isPresent let procname_instanceof = Procname.equal SymExec.ModelBuiltins.__instanceof - let procname_is_false_on_null get_proc_desc pn = + let procname_is_false_on_null pn = match Specs.proc_resolve_attributes pn with | Some proc_attributes -> let annotated_signature = @@ -53,7 +53,7 @@ module ComplexExpressions = struct | None -> false - let procname_is_true_on_null get_proc_desc pn = + let procname_is_true_on_null pn = let annotated_true_on_null () = match Specs.proc_resolve_attributes pn with | Some proc_attributes -> @@ -102,8 +102,8 @@ module ComplexExpressions = struct pp_to_string (Sil.pp_const pe_text) c | Sil.Dderef de -> dexp_to_string de - | Sil.Dfcall (fun_dexp, args, loc, { Sil.cf_virtual = isvirtual }) - | Sil.Dretcall (fun_dexp, args, loc, { Sil.cf_virtual = isvirtual }) + | Sil.Dfcall (fun_dexp, args, _, { Sil.cf_virtual = isvirtual }) + | Sil.Dretcall (fun_dexp, args, _, { Sil.cf_virtual = isvirtual }) when functions_idempotent () -> let pp_arg fmt de = F.fprintf fmt "%s" (dexp_to_string de) in let pp_args fmt des = (pp_comma_seq) pp_arg fmt des in @@ -117,13 +117,13 @@ module ComplexExpressions = struct | Sil.Dpvar pv | Sil.Dpvaraddr pv when not (Errdesc.pvar_is_frontend_tmp pv) -> Sil.pvar_to_string pv - | Sil.Dpvar pv - | Sil.Dpvaraddr pv (* front-end variable -- this should not happen) *) -> + | Sil.Dpvar _ + | Sil.Dpvaraddr _ (* front-end variable -- this should not happen) *) -> case_not_handled () | Sil.Dunop (op, de) -> Sil.str_unop op ^ dexp_to_string de - | Sil.Dsizeof (typ, sub) -> + | Sil.Dsizeof _ -> case_not_handled () | Sil.Dunknown -> case_not_handled () in @@ -180,7 +180,7 @@ let rec typecheck_expr find_canonical_duplicate visited checks node instr_ref curr_pname typestate e1 tr_default loc - | Sil.Const c -> + | Sil.Const _ -> let (typ, _, locs) = tr_default in (typ, TypeAnnotation.const Annotations.Nullable false (TypeOrigin.Const loc), locs) | Sil.Lfield (exp, fn, typ) -> @@ -238,16 +238,16 @@ let rec typecheck_expr (** Typecheck an instruction. *) let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc curr_pname curr_pdesc find_canonical_duplicate annotated_signature instr_ref linereader typestate instr = - let print_current_state () = - L.stdout "Current Typestate in node %a@\n%a@." - Cfg.Node.pp (TypeErr.InstrRef.get_node instr_ref) - (TypeState.pp ext) typestate; - L.stdout " %a@." (Sil.pp_instr pe_text) instr in + (* let print_current_state () = *) + (* L.stdout "Current Typestate in node %a@\n%a@." *) + (* Cfg.Node.pp (TypeErr.InstrRef.get_node instr_ref) *) + (* (TypeState.pp ext) typestate; *) + (* L.stdout " %a@." (Sil.pp_instr pe_text) instr in *) (** Handle the case where a field access X.f happens via a temporary variable $Txxx. This has been observed in assignments this.f = exp when exp contains an ifthenelse. Reconstuct the original expression knowing: the origin of $Txxx is 'this'. *) - let handle_field_access_via_temporary typestate exp loc = + let handle_field_access_via_temporary typestate exp = let name_is_temporary name = let prefix = "$T" in Utils.string_is_prefix prefix name in @@ -278,11 +278,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc (** Convert a complex expressions into a pvar. When [is_assigment] is true, update the relevant annotations for the pvar. *) let convert_complex_exp_to_pvar node' is_assignment _exp typestate loc = - let exp = - handle_field_access_via_temporary - typestate - (Idenv.expand_expr idenv _exp) - loc in + let exp = handle_field_access_via_temporary typestate (Idenv.expand_expr idenv _exp) in let default = exp, typestate in (* If this is an assignment, update the typestate for a field access pvar. *) @@ -342,14 +338,14 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | _ -> default end - | Sil.Lvar pvar -> + | Sil.Lvar _ -> default | Sil.Lfield (_exp, fn, typ) when ComplexExpressions.parameter_and_static_field () -> let exp' = Idenv.expand_expr_temps idenv node _exp in let is_parameter_field pvar = (* parameter.field *) let name = Sil.pvar_get_name pvar in - let filter (s, ia, typ) = Mangled.equal s name in + let filter (s, _, _) = Mangled.equal s name in IList.exists filter annotated_signature.Annotations.params in let is_static_field pvar = (* static field *) @@ -365,7 +361,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let pvar = Sil.mk_pvar (Mangled.from_string fld_name) curr_pname in let typestate' = update_typestate_fld pvar fn typ in (Sil.Lvar pvar, typestate') - | Sil.Lfield (_exp', fn', typ') when Ident.java_fieldname_is_outer_instance fn' -> + | Sil.Lfield (_exp', fn', _) when Ident.java_fieldname_is_outer_instance fn' -> (** handle double dereference when accessing a field from an outer class *) let fld_name = Ident.fieldname_to_string fn' ^ "_" ^ Ident.fieldname_to_string fn in let pvar = Sil.mk_pvar (Mangled.from_string fld_name) curr_pname in @@ -396,12 +392,12 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let pname = proc_attributes.ProcAttributes.proc_name in if Procname.is_constructor pname then match PatternMatch.get_this_type proc_attributes with - | Some this_type -> + | Some _ -> begin constructor_check_calls_this calls_this pname; (* Drop reference parameters to this and outer objects. *) - let is_hidden_parameter (n, t) = + let is_hidden_parameter (n, _) = let n_str = Mangled.to_string n in n_str = "this" || Str.string_match (Str.regexp "$bcvar[0-9]+") n_str 0 in @@ -468,7 +464,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc ignore (typecheck_expr_simple typestate1 exp1 Sil.Tvoid TypeOrigin.Undef loc1) in match instr with - | Sil.Remove_temps (idl, loc) -> + | Sil.Remove_temps (idl, _) -> if remove_temps then IList.fold_right TypeState.remove_id idl typestate else typestate | Sil.Declare_locals _ @@ -480,7 +476,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc TypeState.add_id id (typecheck_expr_simple typestate' e' typ TypeOrigin.Undef loc) typestate' - | Sil.Set (Sil.Lvar pvar, typ, Sil.Const (Sil.Cexn _), loc) when pvar_is_return pvar -> + | Sil.Set (Sil.Lvar pvar, _, Sil.Const (Sil.Cexn _), _) when pvar_is_return pvar -> (* skip assignment to return variable where it is an artifact of a throw instruction *) typestate | Sil.Set (e1, typ, e2, loc) -> @@ -494,7 +490,6 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc find_canonical_duplicate curr_pname node instr_ref typestate1 e1' e2 typ loc fn t_ia_opt (typecheck_expr find_canonical_duplicate calls_this checks) - print_current_state | _ -> () in let typestate2 = match e1' with @@ -503,7 +498,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc pvar (typecheck_expr_simple typestate1 e2 typ TypeOrigin.Undef loc) typestate1 - | Sil.Lfield (_, fn, styp) -> + | Sil.Lfield _ -> typestate1 | _ -> typestate1 in @@ -567,7 +562,6 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc match Specs.proc_resolve_attributes (* AttributesTable.load_attributes *) callee_pname with | Some proc_attributes -> proc_attributes | None -> assert false in - let callee_loc = callee_attributes.ProcAttributes.loc in let etl = drop_unchecked_params calls_this callee_attributes _etl in let call_params, typestate1 = @@ -614,7 +608,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let clear_nullable_flag typestate'' pvar = (* remove the nullable flag for the given pvar *) match TypeState.lookup_pvar pvar typestate'' with - | Some (t, ta, locs) -> + | Some (t, ta, _) -> let should_report = EradicateChecks.activate_condition_redundant && TypeAnnotation.get_value Annotations.Nullable ta = false && @@ -642,14 +636,14 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | _ -> None in match find_parameter parameter_num call_params with - | Some (pvar, typ) -> + | Some (pvar, _) -> if is_vararg then let do_vararg_value e ts = match Idenv.expand_expr idenv e with | Sil.Lvar pvar1 -> pvar_apply loc clear_nullable_flag ts pvar1 | _ -> ts in - let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv curr_pdesc in + let vararg_values = PatternMatch.java_get_vararg_values node pvar idenv in IList.fold_right do_vararg_value vararg_values typestate' else pvar_apply loc clear_nullable_flag typestate' pvar @@ -693,7 +687,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc set_flag pvar' Annotations.Present true | _ -> () in match call_params with - | ((_, Sil.Lvar pvar), typ):: _ -> + | ((_, Sil.Lvar pvar), _):: _ -> (* temporary variable for the value of the boolean condition *) begin let curr_node = TypeErr.InstrRef.get_node instr_ref in @@ -711,7 +705,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc () | Some (node', id) -> let () = match Errdesc.find_normal_variable_funcall node' id with - | Some (Sil.Const (Sil.Cfun pn), [e], loc, call_flags) + | Some (Sil.Const (Sil.Cfun pn), [e], _, _) when ComplexExpressions.procname_optional_isPresent pn -> handle_optional_isPresent node' e | _ -> () in @@ -733,8 +727,8 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc object_t) parameters in match call_params with - | ((_, Sil.Lvar pv_map), typ_map) :: - ((_, exp_key), typ_key) :: + | ((_, Sil.Lvar pv_map), _) :: + ((_, exp_key), _) :: ((_, exp_value), typ_value) :: _ -> (* Convert the dexp for k to the dexp for m.get(k) *) let convert_dexp_key_to_dexp_get = function @@ -779,11 +773,9 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc typestate1 call_params callee_pname - callee_loc instr_ref loc - (typecheck_expr find_canonical_duplicate calls_this checks) - print_current_state; + (typecheck_expr find_canonical_duplicate calls_this checks); if checks.eradicate then EradicateChecks.check_call_parameters find_canonical_duplicate @@ -794,18 +786,15 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc signature_params call_params loc - annotated_signature instr_ref - (typecheck_expr find_canonical_duplicate calls_this checks) - print_current_state; + (typecheck_expr find_canonical_duplicate calls_this checks); let typestate2 = if checks.check_extension then let etl' = IList.map (fun ((_, e), t) -> (e, t)) call_params in let extension = TypeState.get_extension typestate1 in let extension' = ext.TypeState.check_instr - get_proc_desc curr_pname curr_pdesc node - extension instr etl' in + get_proc_desc curr_pname curr_pdesc extension instr etl' in TypeState.set_extension typestate1 extension' else typestate1 in if Models.is_check_not_null callee_pname then @@ -833,7 +822,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc do_return loc typestate2 | Sil.Call _ -> typestate - | Sil.Prune (cond, loc, true_branch, ik) -> + | Sil.Prune (cond, loc, true_branch, _) -> let rec check_condition node' c : _ TypeState.t = (* check if the expression is coming from a call, and return the argument *) let from_call filter_callee e : Sil.exp option = @@ -841,7 +830,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | Sil.Var id -> begin match Errdesc.find_normal_variable_funcall node' id with - | Some (Sil.Const (Sil.Cfun pn), e1:: _, loc, call_flags) when + | Some (Sil.Const (Sil.Cfun pn), e1:: _, _, _) when filter_callee pn -> Some e1 | _ -> None @@ -858,11 +847,11 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc (* check if the expression is coming from a procedure returning false on null *) let from_is_false_on_null e : Sil.exp option = - from_call (ComplexExpressions.procname_is_false_on_null get_proc_desc) e in + from_call ComplexExpressions.procname_is_false_on_null e in (* check if the expression is coming from a procedure returning true on null *) let from_is_true_on_null e : Sil.exp option = - from_call (ComplexExpressions.procname_is_true_on_null get_proc_desc) e in + from_call ComplexExpressions.procname_is_true_on_null e in (* check if the expression is coming from Map.containsKey *) let from_containsKey e : Sil.exp option = @@ -925,7 +914,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc if checks.eradicate then EradicateChecks.check_zero - find_canonical_duplicate get_proc_desc curr_pname + find_canonical_duplicate curr_pname node' e' typ ta true_branch EradicateChecks.From_condition idenv linereader loc instr_ref; @@ -959,7 +948,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc | None -> begin match from_containsKey e with - | Some e1 when ComplexExpressions.functions_idempotent () -> + | Some _ when ComplexExpressions.functions_idempotent () -> handle_containsKey e | _ -> typestate, e, EradicateChecks.From_condition @@ -971,7 +960,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc typecheck_expr_simple typestate2 e' Sil.Tvoid TypeOrigin.ONone loc in if checks.eradicate then - EradicateChecks.check_nonzero find_canonical_duplicate get_proc_desc curr_pname + EradicateChecks.check_nonzero find_canonical_duplicate curr_pname node e' typ ta true_branch from_call idenv linereader loc instr_ref; begin match from_call with @@ -1020,7 +1009,7 @@ let typecheck_instr ext calls_this checks (node: Cfg.Node.t) idenv get_proc_desc let node', c1' = normalize_cond _node c1 in let node'', c2' = normalize_cond node' c2 in node'', Sil.BinOp (bop, c1', c2') - | Sil.Var id -> + | Sil.Var _ -> let c' = Idenv.expand_expr idenv _cond in if not (Sil.exp_equal c' _cond) then normalize_cond _node c' else _node, c' diff --git a/infer/src/eradicate/typeErr.ml b/infer/src/eradicate/typeErr.ml index 1180b4a60..8333b6af1 100644 --- a/infer/src/eradicate/typeErr.ml +++ b/infer/src/eradicate/typeErr.ml @@ -35,8 +35,8 @@ struct let equal (n1, i1) (n2, i2) = Cfg.Node.equal n1 n2 && i1 = i2 let hash (n, i) = Hashtbl.hash (Cfg.Node.hash n, i) - let get_node (n, i) = n - let replace_node (n, i) n' = (n', i) + let get_node (n, _) = n + let replace_node (_, i) n' = (n', i) let create_generator n = (n, ref 0) let gen instr_ref_gen = let (node, ir) = instr_ref_gen in @@ -88,11 +88,12 @@ module H = Hashtbl.Make(struct Procname.equal pn1 pn2 | Field_not_initialized (_, _), _ | _, Field_not_initialized (_, _) -> false - | Field_not_mutable (fn1, od1), Field_not_mutable (fn2, od2) -> + | Field_not_mutable (fn1, _), Field_not_mutable (fn2, _) -> Ident.fieldname_equal fn1 fn2 | Field_not_mutable _, _ | _, Field_not_mutable _ -> false - | Field_annotation_inconsistent (ann1, fn1, od1), Field_annotation_inconsistent (ann2, fn2, od2) -> + | Field_annotation_inconsistent (ann1, fn1, _), + Field_annotation_inconsistent (ann2, fn2, _) -> ann1 = ann2 && Ident.fieldname_equal fn1 fn2 | Field_annotation_inconsistent _, _ @@ -102,21 +103,21 @@ module H = Hashtbl.Make(struct Procname.equal pn1 pn2 | Field_over_annotated (_, _), _ | _, Field_over_annotated (_, _) -> false - | Null_field_access (so1, fn1, od1, ii1), Null_field_access (so2, fn2, od2, ii2) -> + | Null_field_access (so1, fn1, _, ii1), Null_field_access (so2, fn2, _, ii2) -> (opt_equal string_equal) so1 so2 && Ident.fieldname_equal fn1 fn2 && bool_equal ii1 ii2 | Null_field_access _, _ | _, Null_field_access _ -> false - | Call_receiver_annotation_inconsistent (ann1, so1, pn1, od1), - Call_receiver_annotation_inconsistent (ann2, so2, pn2, od2) -> + | Call_receiver_annotation_inconsistent (ann1, so1, pn1, _), + Call_receiver_annotation_inconsistent (ann2, so2, pn2, _) -> ann1 = ann2 && (opt_equal string_equal) so1 so2 && Procname.equal pn1 pn2 | Call_receiver_annotation_inconsistent _, _ | _, Call_receiver_annotation_inconsistent _ -> false - | Parameter_annotation_inconsistent (ann1, s1, n1, pn1, cl1, od1), - Parameter_annotation_inconsistent (ann2, s2, n2, pn2, cl2, od2) -> + | Parameter_annotation_inconsistent (ann1, s1, n1, pn1, cl1, _), + Parameter_annotation_inconsistent (ann2, s2, n2, pn2, cl2, _) -> ann1 = ann2 && string_equal s1 s2 && int_equal n1 n2 && @@ -124,8 +125,8 @@ module H = Hashtbl.Make(struct Location.equal cl1 cl2 | Parameter_annotation_inconsistent _, _ | _, Parameter_annotation_inconsistent _ -> false - | Return_annotation_inconsistent (ann1, pn1, od1), - Return_annotation_inconsistent (ann2, pn2, od2) -> + | Return_annotation_inconsistent (ann1, pn1, _), + Return_annotation_inconsistent (ann2, pn2, _) -> ann1 = ann2 && Procname.equal pn1 pn2 | Return_annotation_inconsistent _, _ | _, Return_annotation_inconsistent _ -> false @@ -158,19 +159,19 @@ module H = Hashtbl.Make(struct Hashtbl.hash (1, b, string_opt_hash so, nn) | Field_not_initialized (fn, pn) -> Hashtbl.hash (2, string_hash ((Ident.fieldname_to_string fn) ^ (Procname.to_string pn))) - | Field_not_mutable (fn, od) -> + | Field_not_mutable (fn, _) -> Hashtbl.hash (3, string_hash (Ident.fieldname_to_string fn)) - | Field_annotation_inconsistent (ann, fn, od) -> + | Field_annotation_inconsistent (ann, fn, _) -> Hashtbl.hash (4, ann, string_hash (Ident.fieldname_to_string fn)) | Field_over_annotated (fn, pn) -> Hashtbl.hash (5, string_hash ((Ident.fieldname_to_string fn) ^ (Procname.to_string pn))) - | Null_field_access (so, fn, od, ii) -> + | Null_field_access (so, fn, _, _) -> Hashtbl.hash (6, string_opt_hash so, string_hash (Ident.fieldname_to_string fn)) - | Call_receiver_annotation_inconsistent (ann, so, pn, od) -> + | Call_receiver_annotation_inconsistent (ann, so, pn, _) -> Hashtbl.hash (7, ann, string_opt_hash so, Procname.hash_pname pn) - | Parameter_annotation_inconsistent (ann, s, n, pn, cl, od) -> + | Parameter_annotation_inconsistent (ann, s, n, pn, _, _) -> Hashtbl.hash (8, ann, string_hash s, n, Procname.hash_pname pn) - | Return_annotation_inconsistent (ann, pn, od) -> + | Return_annotation_inconsistent (ann, pn, _) -> Hashtbl.hash (9, ann, Procname.hash_pname pn) | Return_over_annotated pn -> Hashtbl.hash (10, Procname.hash_pname pn) @@ -302,9 +303,7 @@ type st_report_error = unit (** Report an error right now. *) -let report_error_now - (st_report_error : st_report_error) - node err_instance instr_ref_opt loc proc_name : unit = +let report_error_now (st_report_error : st_report_error) node err_instance loc proc_name : unit = let demo_mode = true in let do_print_base ew_string kind_s s = L.stdout "%s %s in %s %s@." ew_string kind_s (Procname.java_get_method proc_name) s in @@ -423,7 +422,7 @@ let report_error_now None, None, origin_loc - | Parameter_annotation_inconsistent (ann, s, n, pn, callee_loc, (origin_desc, origin_loc, _)) -> + | Parameter_annotation_inconsistent (ann, s, n, pn, _, (origin_desc, origin_loc, _)) -> let kind_s, description = match ann with | Annotations.Nullable -> "ERADICATE_PARAMETER_NOT_NULLABLE", @@ -524,8 +523,7 @@ let report_error st_report_error find_canonical_duplicate node let should_report_now = add_err find_canonical_duplicate err_instance instr_ref_opt loc in if should_report_now then - report_error_now - st_report_error node err_instance instr_ref_opt loc proc_name + report_error_now st_report_error node err_instance loc proc_name (** Report the forall checks at the end of the analysis and reset the error table *) let report_forall_checks_and_reset st_report_error proc_name = @@ -535,8 +533,7 @@ let report_forall_checks_and_reset st_report_error proc_name = let node = InstrRef.get_node instr_ref in State.set_node node; if is_forall && err_state.always - then report_error_now - st_report_error node err_instance instr_ref_opt err_state.loc proc_name + then report_error_now st_report_error node err_instance err_state.loc proc_name | None, _ -> () in H.iter iter err_tbl; reset () diff --git a/infer/src/eradicate/typeOrigin.ml b/infer/src/eradicate/typeOrigin.ml index 4832f7cc0..846604fa5 100644 --- a/infer/src/eradicate/typeOrigin.ml +++ b/infer/src/eradicate/typeOrigin.ml @@ -64,8 +64,8 @@ let equal o1 o2 = match o1, o2 with | Undef, Undef -> true let to_string = function - | Const loc -> "Const" - | Field (fn, loc) -> "Field " ^ Ident.fieldname_to_simplified_string fn + | Const _ -> "Const" + | Field (fn, _) -> "Field " ^ Ident.fieldname_to_simplified_string fn | Formal s -> "Formal " ^ Mangled.to_string s | Proc po -> Printf.sprintf diff --git a/infer/src/eradicate/typeState.ml b/infer/src/eradicate/typeState.ml index da22e58c3..2af09efbe 100644 --- a/infer/src/eradicate/typeState.ml +++ b/infer/src/eradicate/typeState.ml @@ -23,8 +23,7 @@ type 'a ext = { empty : 'a; (** empty extension *) check_instr : (** check the extension for an instruction *) - get_proc_desc -> Procname.t -> Cfg.Procdesc.t -> Cfg.Node.t - -> 'a -> Sil.instr -> parameters -> 'a; + get_proc_desc -> Procname.t -> Cfg.Procdesc.t -> 'a -> Sil.instr -> parameters -> 'a; join : 'a -> 'a -> 'a; (** join two extensions *) pp : Format.formatter -> 'a -> unit (** pretty print an extension *) } diff --git a/infer/src/eradicate/typeState.mli b/infer/src/eradicate/typeState.mli index e7ca81bb3..1073c9c08 100644 --- a/infer/src/eradicate/typeState.mli +++ b/infer/src/eradicate/typeState.mli @@ -19,8 +19,7 @@ type 'a ext = { empty : 'a; (** empty extension *) check_instr : (** check the extension for an instruction *) - get_proc_desc -> Procname.t -> Cfg.Procdesc.t -> Cfg.Node.t - ->'a -> Sil.instr -> parameters -> 'a; + get_proc_desc -> Procname.t -> Cfg.Procdesc.t ->'a -> Sil.instr -> parameters -> 'a; join : 'a -> 'a -> 'a; (** join two extensions *) pp : Format.formatter -> 'a -> unit (** pretty print an extension *) } diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index ae19146ea..813638bd8 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -256,14 +256,14 @@ let get_all_supertypes typ tenv = | _ -> [] in let rec add_typ class_name typs = match Sil.tenv_lookup tenv class_name with - | Some typ -> get_supers_rec typ tenv (TypSet.add typ typs) + | Some typ -> get_supers_rec typ (TypSet.add typ typs) | None -> typs - and get_supers_rec typ tenv all_supers = + and get_supers_rec typ all_supers = let direct_supers = get_direct_supers typ in IList.fold_left (fun typs class_name -> add_typ class_name typs) all_supers direct_supers in - get_supers_rec typ tenv (TypSet.add typ TypSet.empty) + get_supers_rec typ (TypSet.add typ TypSet.empty) (** return true if [typ0] <: [typ1] *) let is_subtype (typ0 : Sil.typ) (typ1 : Sil.typ) tenv = @@ -339,8 +339,8 @@ let get_callback_registered_by procname args tenv = (** return a list of typ's corresponding to callback classes registered by [procdesc] *) let get_callbacks_registered_by_proc procdesc tenv = - let collect_callback_typs callback_typs node instr = match instr with - | Sil.Call([], Sil.Const (Sil.Cfun callee), args, loc, _) -> + let collect_callback_typs callback_typs _ instr = match instr with + | Sil.Call([], Sil.Const (Sil.Cfun callee), args, _, _) -> begin match get_callback_registered_by callee args tenv with | Some (_, callback_typ) -> callback_typ :: callback_typs diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index 7535efe8e..b135644e7 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -35,7 +35,7 @@ let is_generated_field fieldname = (** find callees that register callbacks and add instrumentation to extract the callback. return the set of new global static fields created to extract callbacks and their types *) -let extract_callbacks procdesc cfg_file cfg tenv harness_name harness_lvar callback_fields = +let extract_callbacks procdesc cfg_file cfg tenv harness_lvar callback_fields = (* try to turn a nasty callback name like MyActivity$1 into a nice callback name like * Button.OnClickListener[line 7]*) let create_descriptive_callback_name callback_typ loc = @@ -108,14 +108,14 @@ let find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv = match Cfg.load_cfg_from_file cfg_file with | Some cfg -> IList.fold_left (fun registered_callbacks procdesc -> - extract_callbacks procdesc cfg_file cfg tenv harness_name harness_lvar registered_callbacks + extract_callbacks procdesc cfg_file cfg tenv harness_lvar registered_callbacks ) registered_callbacks (Cfg.get_all_procs cfg) | None -> registered_callbacks ) lifecycle_cfg_files [] (** if [typ] is a lifecycle type, generate a list of (method call, receiver) pairs constituting a lifecycle trace *) -let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs proc_file_map tenv = match typ with +let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs tenv = match typ with | Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some name } -> let class_name = Typename.TN_csu (Csu.Class Csu.Java, name) in if AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv && @@ -176,7 +176,7 @@ let create_android_harness proc_file_map tenv = (* iterate through the type environment and generate a lifecycle harness for each subclass of * [lifecycle_typ] *) Sil.tenv_iter (fun _ typ -> - match try_create_lifecycle_trace typ framework_typ framework_procs proc_file_map tenv with + match try_create_lifecycle_trace typ framework_typ framework_procs tenv with | [] -> () | lifecycle_trace -> (* we have identified an application lifecycle type and created a trace for it. now, @@ -187,7 +187,8 @@ let create_android_harness proc_file_map tenv = Procname.mangled_java (None, harness_cls_name) None "InferGeneratedHarness" [] Procname.Static in let callback_fields = extract_callbacks lifecycle_trace harness_procname proc_file_map tenv in - Inhabit.inhabit_trace lifecycle_trace callback_fields harness_procname proc_file_map tenv + Inhabit.inhabit_trace + lifecycle_trace callback_fields harness_procname proc_file_map ) tenv | None -> () ) AndroidFramework.get_lifecycles diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index caa6f93ba..f5d7fca77 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -96,7 +96,7 @@ let rec inhabit_typ typ proc_file_map env = try (TypMap.find typ env.cache, env) with Not_found -> let inhabit_internal typ env = match typ with - | Sil.Tptr (Sil.Tarray (inner_typ, Sil.Const (Sil.Cint size)), Sil.Pk_pointer) -> + | Sil.Tptr (Sil.Tarray (inner_typ, Sil.Const (Sil.Cint _)), Sil.Pk_pointer) -> let arr_size = Sil.Const (Sil.Cint (Sil.Int.one)) in let arr_typ = Sil.Tarray (inner_typ, arr_size) in inhabit_alloc arr_typ typ SymExec.ModelBuiltins.__new_array env @@ -151,7 +151,7 @@ let rec inhabit_typ typ proc_file_map env = (** inhabit each of the types in the formals list *) and inhabit_args formals proc_file_map env = - let inhabit_arg (formal_name, formal_typ) (args, env) = + let inhabit_arg (_, formal_typ) (args, env) = let (exp, env) = inhabit_typ formal_typ proc_file_map env in ((exp, formal_typ) :: args, env) in IList.fold_right inhabit_arg formals ([], env) @@ -187,9 +187,9 @@ let inhabit_call (procname, receiver) proc_file_map env = let procdesc = procdesc_from_name procname proc_file_map in (* swap the type of the 'this' formal with the receiver type, if there is one *) let formals = match (Cfg.Procdesc.get_formals procdesc, receiver) with - | ((name, typ) :: formals, Some receiver) -> (name, receiver) :: formals + | ((name, _) :: formals, Some receiver) -> (name, receiver) :: formals | (formals, None) -> formals - | ([], Some receiver) -> + | ([], Some _) -> L.err "Expected at least one formal to bind receiver to in method %a@." Procname.pp procname; assert false in @@ -224,7 +224,7 @@ let inhabit_fld_trace flds proc_file_map env = IList.fold_left (fun env fld -> invoke_cb fld env) env flds (** create a dummy file for the harness and associate them in the exe_env *) -let create_dummy_harness_file harness_name harness_cfg tenv = +let create_dummy_harness_file harness_name = let dummy_file_name = let dummy_file_dir = let sources_dir = DB.sources_dir () in @@ -248,13 +248,13 @@ let write_harness_to_file harness_instrs harness_file = close_outf outf) (** add the harness proc to the cg and make sure its callees can be looked up by sym execution *) -let add_harness_to_cg harness_name harness_cfg harness_node loc cg tenv = +let add_harness_to_cg harness_name harness_node cg = Cg.add_defined_node cg harness_name; IList.iter (fun p -> Cg.add_edge cg harness_name p) (Cfg.Node.get_callees harness_node) (** create and fill the appropriate nodes and add them to the harness cfg. also add the harness * proc to the cg *) -let setup_harness_cfg harness_name harness_cfg env source_dir cg tenv = +let setup_harness_cfg harness_name env source_dir cg = (* each procedure has different scope: start names from id 0 *) Ident.NameGenerator.reset (); @@ -287,14 +287,14 @@ let setup_harness_cfg harness_name harness_cfg env source_dir cg tenv = Cfg.Node.set_succs_exn harness_node [exit_node] [exit_node]; Cfg.add_removetemps_instructions harness_cfg; Cfg.add_abstraction_instructions harness_cfg; - add_harness_to_cg harness_name harness_cfg harness_node env.pc cg tenv; + add_harness_to_cg harness_name harness_node cg; (* save out the cg and cfg so that they will be accessible in the next phase of the analysis *) Cg.store_to_file cg_file cg; Cfg.store_cfg_to_file cfg_file false harness_cfg (** create a procedure named harness_name that calls each of the methods in trace in the specified * order with the specified receiver and add it to the execution environment *) -let inhabit_trace trace cb_flds harness_name proc_file_map tenv = +let inhabit_trace trace cb_flds harness_name proc_file_map = if IList.length trace > 0 then (* pick an arbitrary cg and cfg to piggyback the harness code onto *) let (source_dir, source_file, cg) = @@ -302,8 +302,7 @@ let inhabit_trace trace cb_flds harness_name proc_file_map tenv = let cg = cg_from_name proc_name proc_file_map in (source_dir_from_name proc_name proc_file_map, source_file, cg) in - let harness_cfg = Cfg.Node.create_cfg () in - let harness_file = create_dummy_harness_file harness_name harness_cfg tenv in + let harness_file = create_dummy_harness_file harness_name in let start_line = (Cg.get_nLOC cg) + 1 in let empty_env = let pc = { Location.line = start_line; col = 1; file = source_file; nLOC = 0; } in @@ -321,6 +320,6 @@ let inhabit_trace trace cb_flds harness_name proc_file_map tenv = (* invoke callbacks *) inhabit_fld_trace cb_flds proc_file_map env' in try - setup_harness_cfg harness_name harness_cfg env'' source_dir cg tenv; + setup_harness_cfg harness_name env'' source_dir cg; write_harness_to_file (IList.rev env''.instrs) harness_file with Not_found -> () diff --git a/infer/src/harness/inhabit.mli b/infer/src/harness/inhabit.mli index cc002b8fb..ecf505e70 100644 --- a/infer/src/harness/inhabit.mli +++ b/infer/src/harness/inhabit.mli @@ -16,8 +16,7 @@ type callback_trace = (Sil.exp * Sil.typ) list (** create a procedure named harness_name that calls each of the methods in trace in the specified order with the specified receiver and add it to the execution environment *) val inhabit_trace : lifecycle_trace -> callback_trace -> Procname.t -> - - DB.source_file Procname.Map.t -> Sil.tenv -> unit + DB.source_file Procname.Map.t -> unit val source_dir_from_name : Procname.t -> DB.source_file Procname.Map.t -> DB.source_dir diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index d7e0f0fa0..6cad80135 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -13,7 +13,7 @@ open Javalib_pack (** Translate an annotation. *) let translate a : Sil.annotation = let class_name = JBasics.cn_name a.JBasics.kind in - let translate_value_pair (name, value) = + let translate_value_pair (_, value) = match value with | JBasics.EVArray [JBasics.EVCstString s] -> s diff --git a/infer/src/java/jContext.ml b/infer/src/java/jContext.ml index b1c047afc..09084ddfd 100644 --- a/infer/src/java/jContext.ml +++ b/infer/src/java/jContext.ml @@ -93,13 +93,13 @@ let set_pvar context var typ = fst (get_or_set_pvar_type context var typ) let reset_pvar_type context = let var_map = get_var_map context in let aux var item = - match item with (pvar, otyp, typ) -> + 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 let get_var_type context var = try - let (_, otyp', otyp) = JBir.VarMap.find var (get_var_map context) in + let (_, _, otyp) = JBir.VarMap.find var (get_var_map context) in Some otyp with Not_found -> None diff --git a/infer/src/java/jFrontend.ml b/infer/src/java/jFrontend.ml index ce26d2cd3..33d120a2d 100644 --- a/infer/src/java/jFrontend.ml +++ b/infer/src/java/jFrontend.ml @@ -42,7 +42,7 @@ let add_edges context start_node exn_node exit_nodes method_body_nodes impl supe | None -> direct_successors pc | Some jump_pc -> get_body_nodes jump_pc in let get_exn_nodes = - if super_call then (fun x -> exit_nodes) + if super_call then (fun _ -> exit_nodes) else JTransExn.create_exception_handlers context [exn_node] get_body_nodes impl in let connect node pc = Cfg.Node.set_succs_exn node (get_succ_nodes node pc) (get_exn_nodes pc) in @@ -103,7 +103,7 @@ let add_cmethod never_null_matcher program icfg node cm is_static = (** Add an abstract method. *) -let add_amethod program icfg node am is_static = +let add_amethod program icfg am is_static = let cfg = icfg.JContext.cfg in let tenv = icfg.JContext.tenv in let cn, ms = JBasics.cms_split am.Javalib.am_class_method_signature in @@ -164,7 +164,7 @@ let create_icfg never_null_matcher linereader program icfg cn node = | Javalib.ConcreteMethod cm -> add_cmethod never_null_matcher program icfg node cm method_kind | Javalib.AbstractMethod am -> - add_amethod program icfg node am method_kind + add_amethod program icfg am method_kind ) node end @@ -225,7 +225,7 @@ let compute_source_icfg (JClasspath.get_classmap program) in (icfg.JContext.cg, icfg.JContext.cfg) -let compute_class_icfg never_null_matcher linereader program tenv node fake_source_file = +let compute_class_icfg never_null_matcher linereader program tenv node = let icfg = { JContext.cg = Cg.create (); JContext.cfg = Cfg.Node.create_cfg (); diff --git a/infer/src/java/jFrontend.mli b/infer/src/java/jFrontend.mli index 6896c43e8..853d66540 100644 --- a/infer/src/java/jFrontend.mli +++ b/infer/src/java/jFrontend.mli @@ -37,5 +37,4 @@ val compute_class_icfg : JClasspath.program -> Sil.tenv -> JCode.jcode Javalib.interface_or_class -> - DB.source_file -> Cg.t * Cfg.cfg diff --git a/infer/src/java/jMain.ml b/infer/src/java/jMain.ml index 19b42195e..30d0f4c48 100644 --- a/infer/src/java/jMain.ml +++ b/infer/src/java/jMain.ml @@ -73,7 +73,7 @@ let print_usage_exit () = exit(1) let () = - Arg.parse arg_desc (fun arg -> ()) usage; + Arg.parse arg_desc (fun _ -> ()) usage; if Config.analyze_models && !JClasspath.models_jar <> "" then failwith "Not expecting model file when analyzing the models"; if not Config.analyze_models && !JClasspath.models_jar = "" then @@ -91,7 +91,7 @@ let init_global_state source_file = Config.nLOC := nLOC -let store_icfg tenv cg cfg source_file program = +let store_icfg tenv cg cfg program = let f_translate_typ tenv typ_str = let cn = JBasics.make_cn typ_str in ignore (JTransType.get_class_type program tenv cn) in @@ -125,7 +125,7 @@ let do_source_file JFrontend.compute_source_icfg never_null_matcher linereader classes program tenv source_basename package_opt in - store_icfg tenv call_graph cfg source_file program; + store_icfg tenv call_graph cfg program; if !JConfig.create_harness then IList.fold_left (fun proc_file_map pdesc -> @@ -144,16 +144,15 @@ let capture_libs never_null_matcher linereader program tenv = let fake_source_file = JClasspath.java_source_file_from_path (JFrontend.path_of_cached_classname cn) in init_global_state fake_source_file; let call_graph, cfg = - JFrontend.compute_class_icfg - never_null_matcher linereader program tenv node fake_source_file in - store_icfg tenv call_graph cfg fake_source_file program; + JFrontend.compute_class_icfg never_null_matcher linereader program tenv node in + store_icfg tenv call_graph cfg program; JFrontend.cache_classname cn; end in JBasics.ClassMap.iter (capture_class tenv) (JClasspath.get_classmap program) (* load a stored global tenv if the file is found, and create a new one otherwise *) -let load_tenv program = +let load_tenv () = let tenv_filename = DB.global_tenv_fname () in let tenv = if DB.file_exists tenv_filename then @@ -174,7 +173,7 @@ let load_tenv program = (* Store to a file the type environment containing all the types required to perform the analysis *) -let save_tenv classpath tenv = +let save_tenv tenv = if not Config.analyze_models then JTransType.add_models_types tenv; let tenv_filename = DB.global_tenv_fname () in (* TODO: this prevents per compilation step incremental analysis at this stage *) @@ -189,7 +188,7 @@ let do_all_files classpath sources classes = (StringMap.cardinal sources) (JBasics.ClassSet.cardinal classes); let program = JClasspath.load_program classpath classes in - let tenv = load_tenv program in + let tenv = load_tenv () in let linereader = Printer.LineReader.create () in let skip_translation_matcher = Inferconfig.SkipTranslationMatcher.load_matcher (Inferconfig.inferconfig ()) in @@ -198,7 +197,7 @@ let do_all_files classpath sources classes = let proc_file_map = let skip source_file = skip_translation_matcher source_file Procname.empty in - let translate_source_file basename (package_opt, source_file) source_file map = + let translate_source_file basename (package_opt, _) source_file map = init_global_state source_file; if skip source_file then map else do_source_file @@ -219,7 +218,7 @@ let do_all_files classpath sources classes = if !JConfig.dependency_mode then capture_libs never_null_matcher linereader program tenv; if !JConfig.create_harness then Harness.create_harness proc_file_map tenv; - save_tenv classpath tenv; + save_tenv tenv; JClasspath.cleanup program; JUtils.log "done @." diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 1833f48e0..31f926fde 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -59,7 +59,7 @@ let get_location impl pc meth_kind cn = let line_number = let ln = try JBir.get_source_line_number pc impl - with Invalid_argument e -> None in + with Invalid_argument _ -> None in match ln with | None -> 0 | Some n -> n in @@ -78,7 +78,7 @@ let get_undefined_method_call ovt = | JBasics.TObject ot -> begin match ot with - | JBasics.TArray vt -> assert false + | JBasics.TArray _ -> assert false | JBasics.TClass cn -> if JBasics.cn_name cn = JConfig.string_cl then "string_undefined" @@ -100,10 +100,10 @@ let retrieve_fieldname fieldname = assert false else IList.hd (IList.rev subs) - with hd -> assert false + with _ -> assert false -let get_field_name program static tenv cn fs context = +let get_field_name program static tenv cn fs = match JTransType.get_class_type_no_pointer program tenv cn with | Sil.Tstruct { Sil.instance_fields; static_fields; csu = Csu.Class _ } -> let fieldname, _, _ = @@ -195,9 +195,9 @@ let get_binop binop = | JBir.LXor -> Sil.BXor | JBir.LUshr -> raise (Frontend_error "Unsigned right shift operator") - | JBir.CMP comp -> + | JBir.CMP _ -> raise (Frontend_error "Unsigned right shift operator") - | JBir.ArrayLoad vt -> + | JBir.ArrayLoad _ -> raise (Frontend_error "Array load operator") let get_test_operator op = @@ -354,7 +354,7 @@ let create_local_procdesc program linereader cfg tenv node m = | Created defined_status -> begin match defined_status with - | Defined procdesc -> assert false + | Defined _ -> assert false | Called procdesc -> Cfg.Procdesc.remove cfg (Cfg.Procdesc.get_proc_name procdesc) false; create_new_procdesc () @@ -406,23 +406,22 @@ let rec expression context pc expr = let loc = get_location (JContext.get_impl context) pc (JContext.get_meth_kind context) cn in let tenv = JContext.get_tenv context in let type_of_expr = JTransType.expr_type context expr in - let trans_var pvar var_type = + let trans_var pvar = let id = Ident.create_fresh Ident.knormal in let sil_instr = Sil.Letderef (id, Sil.Lvar pvar, type_of_expr, loc) in ([id], [sil_instr], Sil.Var id) in match expr with - | JBir.Var (vt, var) -> + | JBir.Var (_, var) -> let pvar = (JContext.set_pvar context var type_of_expr) in - trans_var pvar type_of_expr + trans_var pvar | JBir.Const c -> begin match c with (* We use the constant internally to mean a variable. *) | `String s when (JBasics.jstr_pp s) = JConfig.field_cst -> let varname = JConfig.field_st in - let string_type = (JTransType.get_class_type program tenv (JBasics.make_cn JConfig.string_cl)) in let procname = (Cfg.Procdesc.get_proc_name (JContext.get_procdesc context)) in let pvar = Sil.mk_pvar varname procname in - trans_var pvar string_type + trans_var pvar | _ -> ([], [], Sil.Const (get_constant c)) end | JBir.Unop (unop, ex) -> @@ -454,8 +453,8 @@ let rec expression context pc expr = JTransType.sizeof_of_object_type program tenv ot subtypes in let builtin = (match unop with - | JBir.InstanceOf ot -> Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__instanceof) - | JBir.Cast ot -> Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__cast) + | JBir.InstanceOf _ -> Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__instanceof) + | JBir.Cast _ -> Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__cast) | _ -> assert false) in let args = [(sil_ex, type_of_ex); (sizeof_expr, Sil.Tvoid)] in let ret_id = Ident.create_fresh Ident.knormal in @@ -468,7 +467,7 @@ let rec expression context pc expr = and (idl2, instrs2, sil_ex2) = expression context pc ex2 in begin match binop with - | JBir.ArrayLoad vt -> + | JBir.ArrayLoad _ -> (* add an instruction that dereferences the array *) let array_typ = Sil.Tarray(type_of_expr, Sil.Var (Ident.create_fresh Ident.kprimed)) in let fresh_id, deref_array_instr = create_sil_deref sil_ex1 array_typ loc in @@ -485,7 +484,7 @@ let rec expression context pc expr = end | JBir.Field (ex, cn, fs) -> let (idl, instrs, sil_expr) = expression context pc ex in - let field_name = get_field_name program false tenv cn fs context in + let field_name = get_field_name program false tenv cn fs in let sil_type = JTransType.get_class_type_no_pointer program tenv cn in let sil_expr = Sil.Lfield (sil_expr, field_name, sil_type) in let tmp_id = Ident.create_fresh Ident.knormal in @@ -497,7 +496,7 @@ let rec expression context pc expr = let var_name = Sil.mk_pvar_global classname in Sil.Lvar var_name in let (idl, instrs, sil_expr) = [], [], class_exp in - let field_name = get_field_name program true tenv cn fs context in + let field_name = get_field_name program true tenv cn fs in let sil_type = JTransType.get_class_type_no_pointer program tenv cn in if JTransStaticField.is_static_final_field context cn fs && use_static_final_fields context then @@ -533,7 +532,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ if Javalib.defines_method node ms then cn else match node with - | Javalib.JInterface jinterface -> fallback_cn + | Javalib.JInterface _ -> fallback_cn | Javalib.JClass jclass -> begin match jclass.Javalib.c_super_class with @@ -564,7 +563,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | I_Special -> false | _ -> true in match sil_obj_expr with - | Sil.Var id when is_non_constructor_call && not !JConfig.translate_checks -> + | Sil.Var _ when is_non_constructor_call && not !JConfig.translate_checks -> let obj_typ_no_ptr = match sil_obj_type with | Sil.Tptr (typ, _) -> typ @@ -609,7 +608,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ | _ when Config.analyze_models || JClasspath.is_model callee_procname -> call_instrs (* add a file attribute when calling the constructor of a subtype of Closeable *) - | (var, typ) as exp :: _ + | (_, typ) as exp :: _ when Procname.is_constructor callee_procname && JTransType.is_closeable program tenv typ -> let set_file_attr = let set_builtin = Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__set_file_attribute) in @@ -618,7 +617,7 @@ let method_invocation context loc pc var_opt cn ms sil_obj_opt expr_list invoke_ call_instrs @ [set_file_attr] (* remove file attribute when calling the close method of a subtype of Closeable *) - | (var, typ) as exp :: [] + | (_, typ) as exp :: [] when Procname.java_is_close callee_procname && JTransType.is_closeable program tenv typ -> let set_mem_attr = let set_builtin = Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__set_mem_attribute) in @@ -718,7 +717,7 @@ let extends context node1 node2 = IList.exists per_classname cn_list in check [Javalib.get_name node1] -let instruction_array_call ms obj_type obj args var_opt vt = +let instruction_array_call ms obj_type obj args var_opt = if is_clone ms then (let cn = JBasics.make_cn JConfig.infer_array_cl in let vt = (JBasics.TObject obj_type) in @@ -833,7 +832,7 @@ let rec instruction context pc instr : translation = | JBir.AffectField (e_lhs, cn, fs, e_rhs) -> let (idl1, stml1, sil_expr_lhs) = expression context pc e_lhs in let (idl2, stml2, sil_expr_rhs) = expression context pc e_rhs in - let field_name = get_field_name program false tenv cn fs context in + let field_name = get_field_name program false tenv cn fs in let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in let expr_off = Sil.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in @@ -848,7 +847,7 @@ let rec instruction context pc instr : translation = Sil.Lvar var_name in let (idl1, stml1, sil_expr_lhs) = [], [], class_exp in let (idl2, stml2, sil_expr_rhs) = expression context pc e_rhs in - let field_name = get_field_name program true tenv cn fs context in + let field_name = get_field_name program true tenv cn fs in let type_of_the_surrounding_class = JTransType.get_class_type_no_pointer program tenv cn in let type_of_the_root_of_e_lhs = type_of_the_surrounding_class in let expr_off = Sil.Lfield(sil_expr_lhs, field_name, type_of_the_surrounding_class) in @@ -967,8 +966,8 @@ let rec instruction context pc instr : translation = begin match obj_type with | JBasics.TClass cn -> trans_virtual_call cn I_Virtual - | JBasics.TArray vt -> - let instr = instruction_array_call ms obj_type obj args var_opt vt in + | JBasics.TArray _ -> + let instr = instruction_array_call ms obj_type obj args var_opt in instruction context pc instr end | JBir.InterfaceCall cn -> @@ -1013,7 +1012,7 @@ let rec instruction context pc instr : translation = let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in - let constr_procname, call_ids, call_instrs = + let _, call_ids, call_instrs = let ret_opt = Some (Sil.Var ret_id, class_type) in method_invocation context loc pc None npe_cn constr_ms ret_opt [] I_Special Procname.Static in let sil_exn = Sil.Const (Sil.Cexn (Sil.Var ret_id)) in @@ -1024,7 +1023,7 @@ let rec instruction context pc instr : translation = | JBir.Check (JBir.CheckArrayBound (array_expr, index_expr)) when !JConfig.translate_checks -> - let ids, instrs, sil_array_expr, sil_length_expr, sil_index_expr = + let ids, instrs, _, sil_length_expr, sil_index_expr = let array_ids, array_instrs, sil_array_expr = expression context pc array_expr and length_ids, length_instrs, sil_length_expr = @@ -1067,7 +1066,7 @@ let rec instruction context pc instr : translation = let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in - let constr_procname, call_ids, call_instrs = + let _, call_ids, call_instrs = method_invocation context loc pc None out_of_bound_cn constr_ms (Some (Sil.Var ret_id, class_type)) [] I_Special Procname.Static in @@ -1106,7 +1105,7 @@ let rec instruction context pc instr : translation = let ret_id = Ident.create_fresh Ident.knormal in let new_instr = Sil.Call([ret_id], builtin_new, args, loc, Sil.cf_default) in let constr_ms = JBasics.make_ms JConfig.constructor_name [] None in - let constr_procname, call_ids, call_instrs = + let _, call_ids, call_instrs = method_invocation context loc pc None cce_cn constr_ms (Some (Sil.Var ret_id, class_type)) [] I_Special Procname.Static in let sil_exn = Sil.Const (Sil.Cexn (Sil.Var ret_id)) in diff --git a/infer/src/java/jTransExn.ml b/infer/src/java/jTransExn.ml index 39e271433..241b87470 100644 --- a/infer/src/java/jTransExn.ml +++ b/infer/src/java/jTransExn.ml @@ -42,7 +42,7 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table = let unwrap_builtin = Sil.Const (Sil.Cfun SymExec.ModelBuiltins.__unwrap_exception) in Sil.Call([id_exn_val], unwrap_builtin, [(Sil.Var id_ret_val, ret_type)], loc, Sil.cf_default) in create_node loc Cfg.Node.exn_handler_kind [instr_get_ret_val; instr_deactivate_exn; instr_unwrap_ret_val] [id_ret_val; id_deactivate] in - let create_entry_block pc handler_list = + let create_entry_block handler_list = try ignore (Hashtbl.find catch_block_table handler_list) with Not_found -> @@ -103,12 +103,12 @@ let translate_exceptions context exit_nodes get_body_nodes handler_table = let entry_node = create_entry_node loc in Cfg.Node.set_succs_exn entry_node nodes_first_handler exit_nodes; Hashtbl.add catch_block_table handler_list [entry_node] in - Hashtbl.iter (fun pc handler_list -> create_entry_block pc handler_list) handler_table; + Hashtbl.iter (fun _ handler_list -> create_entry_block handler_list) handler_table; catch_block_table let create_exception_handlers context exit_nodes get_body_nodes impl = match JBir.exc_tbl impl with - | [] -> fun pc -> exit_nodes + | [] -> fun _ -> exit_nodes | _ -> let handler_table = create_handler_table impl in let catch_block_table = translate_exceptions context exit_nodes get_body_nodes handler_table in diff --git a/infer/src/java/jTransStaticField.ml b/infer/src/java/jTransStaticField.ml index 1b500bfdc..6a5de59dd 100644 --- a/infer/src/java/jTransStaticField.ml +++ b/infer/src/java/jTransStaticField.ml @@ -29,7 +29,7 @@ let sort_pcs () = (** Returns whether the node contains static final fields that are not of a primitive type or String. *) let has_static_final_fields node = - let detect fs f test = + let detect _ f test = test || (Javalib.is_static_field f && Javalib.is_final_field f) in JBasics.FieldMap.fold detect (Javalib.get_fields node) false (* Seems that there is no function "exists" on this implementation of *) @@ -40,7 +40,7 @@ let has_static_final_fields node = let collect_field_pc instrs field_pc_list = let aux pc instr = match instr with - | JBir.AffectStaticField (cn, fs, e) -> + | JBir.AffectStaticField (_, fs, _) -> field_pc_list := (fs, pc)::!field_pc_list | _ -> () in (Array.iteri aux instrs); @@ -51,7 +51,7 @@ let collect_field_pc instrs field_pc_list = let add_return_field instrs = let aux instr = match instr with - | JBir.AffectStaticField (cn, fs, e) -> + | JBir.AffectStaticField (_, _, e) -> JBir.Return (Some e) | _ -> instr in (Array.map aux instrs) @@ -61,12 +61,12 @@ let add_return_field instrs = which is the line after the previous field has been initialised. *) let rec find_pc field list = match list with - | (fs, pc):: rest -> + | (fs, _):: rest -> if JBasics.fs_equal field fs then try - let (nfs, npc) = IList.hd rest in + let (_, npc) = IList.hd rest in npc + 1 - with hd -> 1 + with _ -> 1 else (find_pc field rest) | [] -> -1 @@ -82,7 +82,7 @@ let remove_nonfinal_instrs code end_pc = if next_pc < end_pc then aux2 next_pc end else () in - let aux pc instr = + let aux pc _ = if IList.mem (=) pc !field_nonfinal_pcs then begin Array.set code pc JBir.Nop; @@ -90,12 +90,12 @@ let remove_nonfinal_instrs code end_pc = end else () in Array.iteri aux code - with Invalid_argument s -> assert false + with Invalid_argument _ -> assert false let has_unclear_control_flow code = let aux instr nok = match instr with - | JBir.Goto n -> true + | JBir.Goto _ -> true | _ -> nok in Array.fold_right aux code false @@ -104,7 +104,7 @@ let has_unclear_control_flow code = for returning the field selected by the parameter. *) (* The constant s means the parameter field of the function. Note that we remove the initialisation of non - final static fields. *) -let static_field_init_complex cn code fields length = +let static_field_init_complex code fields length = let code = Array.append [| (JBir.Goto length ) |] code in let s = JConfig.field_cst in let field_pc_list = ref [] in @@ -172,7 +172,7 @@ let static_field_init node cn code = let code = if has_unclear_control_flow code then static_field_init_simple cn code field_list length - else static_field_init_complex cn code field_list length in + else static_field_init_complex code field_list length in code with Not_found -> code diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 9a0231ddf..3ab1c339e 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -46,8 +46,8 @@ let cast_type = function let const_type const = match const with - | `String str -> (JBasics.TObject (JBasics.TClass (JBasics.make_cn JConfig.string_cl))) - | `Class cl -> (JBasics.TObject (JBasics.TClass (JBasics.make_cn JConfig.class_cl))) + | `String _ -> (JBasics.TObject (JBasics.TClass (JBasics.make_cn JConfig.string_cl))) + | `Class _ -> (JBasics.TObject (JBasics.TClass (JBasics.make_cn JConfig.class_cl))) | `Double _ -> (JBasics.TBasic `Double) | `Int _ -> (JBasics.TBasic`Int) | `Float _ -> (JBasics.TBasic`Float) @@ -416,7 +416,7 @@ let get_var_type_from_sig context var = let tenv = JContext.get_tenv context in let vt', var' = IList.find - (fun (vt', var') -> JBir.var_equal var var') + (fun (_, var') -> JBir.var_equal var var') (JBir.params (JContext.get_impl context)) in Some (param_type program tenv (JContext.get_cn context) var' vt') with Not_found -> None @@ -425,7 +425,7 @@ let get_var_type_from_sig context var = let get_var_type context var = let typ_opt = JContext.get_var_type context var in match typ_opt with - | Some atype -> typ_opt + | Some _ -> typ_opt | None -> get_var_type_from_sig context var @@ -446,7 +446,7 @@ let rec expr_type context expr = (match get_var_type context var with | Some typ -> typ | None -> (value_type program tenv vt)) - | JBir.Binop ((JBir.ArrayLoad typ), e1, e2) -> + | JBir.Binop ((JBir.ArrayLoad _), e1, _) -> let typ = expr_type context e1 in (extract_array_type typ) | _ -> value_type program tenv (JBir.type_of_expr expr) diff --git a/infer/src/llvm/lMain.ml b/infer/src/llvm/lMain.ml index 8af646bf8..6706503cf 100644 --- a/infer/src/llvm/lMain.ml +++ b/infer/src/llvm/lMain.ml @@ -68,7 +68,7 @@ let store_tenv tenv = Sil.store_tenv_to_file tenv_filename tenv let () = - Arg.parse arg_desc (fun arg -> ()) usage; + Arg.parse arg_desc (fun _ -> ()) usage; begin match !LConfig.source_filename with | None -> print_usage_exit () | Some source_filename -> init_global_state source_filename diff --git a/infer/src/llvm/lParser.mly b/infer/src/llvm/lParser.mly index 5c9bee1d4..8e0448c20 100644 --- a/infer/src/llvm/lParser.mly +++ b/infer/src/llvm/lParser.mly @@ -268,12 +268,14 @@ real_instruction: | RET tp = typ op = operand { Ret (Some (tp, op)) } | RET VOID { Ret None } | BR LABEL lbl = variable { UncondBranch lbl } - | BR i = INT op = operand COMMA LABEL lbl1 = variable COMMA LABEL lbl2 = variable { CondBranch (op, lbl1, lbl2) } + | BR _ = INT op = operand COMMA LABEL lbl1 = variable COMMA LABEL lbl2 = variable + { CondBranch (op, lbl1, lbl2) } (* Memory access operations *) | var = variable EQUALS ALLOCA tp = typ align? { Alloc (var, tp, 1) } | var = variable EQUALS LOAD tp = ptr_typ ptr = variable align? { Load (var, tp, ptr) } - | STORE val_tp = typ value = operand COMMA ptr_tp = ptr_typ var = variable align? { Store (value, val_tp, var) } - (* don't yet know why val_tp and ptr_tp would be different *) + | STORE val_tp = typ value = operand COMMA _ptr_tp = ptr_typ var = variable align? + { Store (value, val_tp, var) } + (* don't yet know why val_tp and _ptr_tp would be different *) (* Function call *) | ret_var = variable EQUALS CALL ret_typ func_var = variable LPAREN args = separated_list(COMMA, pair(typ, operand)) RPAREN { Call (ret_var, func_var, args) } diff --git a/infer/src/llvm/lTrans.ml b/infer/src/llvm/lTrans.ml index 9c929bd93..15f67952c 100644 --- a/infer/src/llvm/lTrans.ml +++ b/infer/src/llvm/lTrans.ml @@ -30,7 +30,7 @@ let trans_operand : LAst.operand -> Sil.exp = function | Const const -> trans_constant const let rec trans_typ : LAst.typ -> Sil.typ = function - | Tint i -> Sil.Tint Sil.IInt (* TODO: check what size int is needed here *) + | Tint _i -> Sil.Tint Sil.IInt (* TODO: check what size int is needed here *) | Tfloat -> Sil.Tfloat Sil.FFloat | Tptr tp -> Sil.Tptr (trans_typ tp, Sil.Pk_pointer) | Tvector (i, tp) @@ -81,7 +81,7 @@ let rec trans_annotated_instructions let new_sil_instr = Sil.Set (trans_variable var, trans_typ tp, trans_operand op, location) in (new_sil_instr :: sil_instrs, locals) - | Alloc (var, tp, num_elems) -> + | Alloc (var, tp, _num_elems) -> (* num_elems currently ignored *) begin match var with | Global (Name var_name) | Local (Name var_name) -> diff --git a/infer/src/scripts/checkCopyright.ml b/infer/src/scripts/checkCopyright.ml index d3b22cb84..4e1839112 100644 --- a/infer/src/scripts/checkCopyright.ml +++ b/infer/src/scripts/checkCopyright.ml @@ -196,7 +196,7 @@ let com_style_of_lang = [ (".py", comment_style_shell); ] -let file_should_have_copyright fname lines = +let file_should_have_copyright fname = IList.mem_assoc Filename.check_suffix fname com_style_of_lang let get_filename_extension fname = @@ -224,7 +224,7 @@ let check_copyright fname = match read_file fname with | Some lines -> match find_copyright_line lines 0 with | None -> - if file_should_have_copyright fname lines then + if file_should_have_copyright fname then begin let year = 1900 + (Unix.localtime (Unix.time ())).Unix.tm_year in let ext = get_filename_extension fname in