From 77b22ded0341551011928cc4e5fc2e41923ae8df Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Thu, 18 Feb 2016 08:04:15 -0800 Subject: [PATCH] Warn on unused identifiers Summary:public I have seen enough comments in this space by people during code review to switch on the analyses the compiler can already do. This diff is an automated renaming of unused identifiers to _, with a few additional changes made when reading the diff of the results for things that stood out as particularly strange. This base-lines all of the existing warnings. I'm not sure this is a good idea, since it might be better for those familiar with each part of the code to look at these warnings and use them as pointers to suspicious code. Reviewed By: jeremydubreil Differential Revision: D2938376 fb-gh-sync-id: 6e67817 shipit-source-id: 6e67817 --- infer/src/Makefile.in | 6 +- infer/src/backend/abs.ml | 53 ++-- infer/src/backend/absarray.ml | 62 ++--- infer/src/backend/autounit.ml | 65 ++--- infer/src/backend/buckets.ml | 14 +- infer/src/backend/callbacks.ml | 2 +- infer/src/backend/cfg.ml | 47 ++-- infer/src/backend/cfg.mli | 2 +- infer/src/backend/cg.ml | 14 +- infer/src/backend/dom.ml | 58 ++-- infer/src/backend/dotty.ml | 116 ++++---- infer/src/backend/errdesc.ml | 53 ++-- infer/src/backend/errlog.ml | 26 +- infer/src/backend/exceptions.ml | 8 +- infer/src/backend/exe_env.ml | 6 +- infer/src/backend/exe_env.mli | 2 +- infer/src/backend/fork.ml | 14 +- infer/src/backend/iList.ml | 2 +- infer/src/backend/ident.ml | 4 +- infer/src/backend/inferanalyze.ml | 22 +- infer/src/backend/inferconfig.ml | 30 +- infer/src/backend/inferprint.ml | 47 ++-- infer/src/backend/interproc.ml | 54 ++-- infer/src/backend/localise.ml | 14 +- infer/src/backend/logging.ml | 2 +- infer/src/backend/match.ml | 12 +- infer/src/backend/ondemand.ml | 5 +- infer/src/backend/paths.ml | 38 +-- infer/src/backend/preanal.ml | 28 +- infer/src/backend/printer.ml | 4 +- infer/src/backend/procname.ml | 10 +- infer/src/backend/prop.ml | 89 +++--- infer/src/backend/prop.mli | 2 +- infer/src/backend/propgraph.ml | 10 +- infer/src/backend/propgraph.mli | 2 +- infer/src/backend/prover.ml | 84 +++--- infer/src/backend/rearrange.ml | 31 ++- infer/src/backend/serialization.ml | 4 +- infer/src/backend/sil.ml | 222 ++++++++------- infer/src/backend/sil.mli | 6 +- infer/src/backend/specs.ml | 24 +- infer/src/backend/state.ml | 12 +- infer/src/backend/symExec.ml | 230 ++++++++-------- infer/src/backend/tabulation.ml | 65 ++--- infer/src/backend/tabulation.mli | 2 +- infer/src/backend/utils.ml | 10 +- infer/src/checkers/annotations.ml | 4 +- infer/src/checkers/callbackChecker.ml | 4 +- infer/src/checkers/checkDeadCode.ml | 6 +- infer/src/checkers/checkers.ml | 41 ++- infer/src/checkers/codeQuery.ml | 19 +- infer/src/checkers/constantPropagation.ml | 4 +- infer/src/checkers/dataflow.ml | 10 +- infer/src/checkers/idenv.ml | 10 +- infer/src/checkers/patternMatch.ml | 32 +-- infer/src/checkers/patternMatch.mli | 4 +- infer/src/checkers/printfArgs.ml | 6 +- infer/src/checkers/repeatedCallsChecker.ml | 12 +- infer/src/clang/ast_expressions.ml | 28 +- infer/src/clang/ast_expressions.mli | 5 +- infer/src/clang/cArithmetic_trans.ml | 16 +- infer/src/clang/cArithmetic_trans.mli | 2 +- infer/src/clang/cContext.ml | 6 +- infer/src/clang/cEnum_decl.ml | 2 +- infer/src/clang/cField_decl.ml | 8 +- infer/src/clang/cFrontend.ml | 36 +-- infer/src/clang/cFrontend_utils.ml | 10 +- infer/src/clang/cMain.ml | 4 +- infer/src/clang/cMethod_decl.ml | 6 +- infer/src/clang/cMethod_trans.ml | 21 +- infer/src/clang/cTrans.ml | 301 +++++++++++---------- infer/src/clang/cTrans_models.ml | 19 +- infer/src/clang/cTrans_utils.ml | 14 +- infer/src/clang/cTrans_utils.mli | 2 +- infer/src/clang/cType_to_sil_type.ml | 40 +-- infer/src/clang/cTypes.ml | 10 +- infer/src/clang/cTypes_decl.ml | 26 +- infer/src/clang/cVar_decl.ml | 4 +- infer/src/clang/objcCategory_decl.ml | 10 +- infer/src/clang/objcInterface_decl.ml | 12 +- infer/src/clang/objcProperty_decl.ml | 2 +- infer/src/clang/objcProtocol_decl.ml | 2 +- infer/src/eradicate/eradicate.ml | 24 +- infer/src/eradicate/eradicateChecks.ml | 20 +- infer/src/eradicate/modelTables.ml | 2 +- infer/src/eradicate/typeCheck.ml | 93 +++---- infer/src/eradicate/typeErr.ml | 47 ++-- infer/src/eradicate/typeOrigin.ml | 4 +- infer/src/eradicate/typeState.ml | 3 +- infer/src/eradicate/typeState.mli | 3 +- infer/src/harness/androidFramework.ml | 10 +- infer/src/harness/harness.ml | 11 +- infer/src/harness/inhabit.ml | 23 +- infer/src/harness/inhabit.mli | 3 +- infer/src/java/jAnnotation.ml | 2 +- infer/src/java/jContext.ml | 4 +- infer/src/java/jFrontend.ml | 8 +- infer/src/java/jFrontend.mli | 1 - infer/src/java/jMain.ml | 21 +- infer/src/java/jTrans.ml | 59 ++-- infer/src/java/jTransExn.ml | 6 +- infer/src/java/jTransStaticField.ml | 22 +- infer/src/java/jTransType.ml | 10 +- infer/src/llvm/lMain.ml | 2 +- infer/src/llvm/lParser.mly | 8 +- infer/src/llvm/lTrans.ml | 4 +- infer/src/scripts/checkCopyright.ml | 4 +- 107 files changed, 1368 insertions(+), 1377 deletions(-) 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