From 30b3881e52083bf1ba804f9c9eff8347cb87073a Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Thu, 8 Sep 2016 05:59:43 -0700 Subject: [PATCH] Make Typ.struct_typ private and add Typ.mk_struct Reviewed By: cristianoc Differential Revision: D3791863 fbshipit-source-id: d792aea --- infer/src/IR/Sil.re | 2 +- infer/src/IR/Tenv.re | 23 +++--- infer/src/IR/Typ.re | 70 +++++++++++++++---- infer/src/IR/Typ.rei | 24 +++++-- infer/src/backend/abs.ml | 8 +-- infer/src/backend/absarray.ml | 12 ++-- infer/src/backend/errdesc.ml | 4 +- infer/src/backend/prop.ml | 4 +- infer/src/backend/prover.ml | 27 ++++--- infer/src/backend/rearrange.ml | 36 +++++----- infer/src/backend/symExec.ml | 15 ++-- infer/src/backend/tabulation.ml | 6 +- infer/src/backend/taint.ml | 4 +- infer/src/checkers/annotationReachability.ml | 4 +- infer/src/checkers/annotations.ml | 2 +- infer/src/checkers/checkers.ml | 4 +- .../checkers/fragmentRetainsViewChecker.ml | 4 +- infer/src/checkers/patternMatch.ml | 39 +++++------ infer/src/clang/cContext.ml | 6 +- infer/src/clang/cField_decl.ml | 20 +++--- infer/src/clang/cFrontend_utils.ml | 6 +- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/clang/cTrans.ml | 10 +-- infer/src/clang/cTrans_utils.ml | 6 +- infer/src/clang/cTypes_decl.ml | 50 +++---------- infer/src/clang/objcCategory_decl.ml | 20 +++--- infer/src/clang/objcInterface_decl.ml | 43 +++++------- infer/src/clang/objcProtocol_decl.ml | 11 +-- infer/src/clang/printing.ml | 10 +-- infer/src/eradicate/eradicateChecks.ml | 4 +- infer/src/harness/androidFramework.ml | 4 +- infer/src/harness/inhabit.ml | 4 +- infer/src/java/jTrans.ml | 4 +- infer/src/java/jTransType.ml | 51 +++++--------- 34 files changed, 259 insertions(+), 280 deletions(-) diff --git a/infer/src/IR/Sil.re b/infer/src/IR/Sil.re index 0e5c64cc0..86cc24d18 100644 --- a/infer/src/IR/Sil.re +++ b/infer/src/IR/Sil.re @@ -185,7 +185,7 @@ let has_objc_ref_counter tenv hpred => switch hpred { | Hpointsto _ _ (Sizeof typ _ _) => switch (Tenv.expand_type tenv typ) { - | Tstruct {instance_fields} => IList.exists Typ.is_objc_ref_counter_field instance_fields + | Tstruct {fields} => IList.exists Typ.is_objc_ref_counter_field fields | _ => false } | _ => false diff --git a/infer/src/IR/Tenv.re b/infer/src/IR/Tenv.re index bae45213b..e1a648be6 100644 --- a/infer/src/IR/Tenv.re +++ b/infer/src/IR/Tenv.re @@ -93,28 +93,23 @@ let proc_extract_return_typ tenv pname_java => /** Get method that is being overriden by java_pname (if any) **/ let get_overriden_method tenv pname_java => { - let struct_typ_get_def_method_by_name struct_typ method_name => - IList.find - (fun def_method => method_name == Procname.get_method def_method) struct_typ.Typ.def_methods; - let rec get_overriden_method_in_superclasses pname_java superclasses => - switch superclasses { - | [superclass, ...superclasses_tail] => + let struct_typ_get_method_by_name struct_typ method_name => + IList.find (fun meth => method_name == Procname.get_method meth) struct_typ.Typ.methods; + let rec get_overriden_method_in_supers pname_java supers => + switch supers { + | [superclass, ...supers_tail] => switch (lookup tenv superclass) { | Some struct_typ => - try ( - Some (struct_typ_get_def_method_by_name struct_typ (Procname.java_get_method pname_java)) - ) { + try (Some (struct_typ_get_method_by_name struct_typ (Procname.java_get_method pname_java))) { | Not_found => - get_overriden_method_in_superclasses - pname_java (superclasses_tail @ struct_typ.Typ.superclasses) + get_overriden_method_in_supers pname_java (supers_tail @ struct_typ.Typ.supers) } - | None => get_overriden_method_in_superclasses pname_java superclasses_tail + | None => get_overriden_method_in_supers pname_java supers_tail } | [] => None }; switch (proc_extract_declaring_class_typ tenv pname_java) { - | Some {Typ.superclasses: superclasses} => - get_overriden_method_in_superclasses pname_java superclasses + | Some {Typ.supers: supers} => get_overriden_method_in_supers pname_java supers | _ => None } }; diff --git a/infer/src/IR/Typ.re b/infer/src/IR/Typ.re index 2b3667e9d..2d081e919 100644 --- a/infer/src/IR/Typ.re +++ b/infer/src/IR/Typ.re @@ -284,11 +284,11 @@ type struct_fields = list (Ident.fieldname, t, item_annotation) /** Type for a structured value. */ and struct_typ = { name: Typename.t, /** name */ - instance_fields: struct_fields, /** non-static fields */ - static_fields: struct_fields, /** static fields */ - superclasses: list Typename.t, /** list of superclasses */ - def_methods: list Procname.t, /** methods defined */ - struct_annotations: item_annotation /** annotations */ + fields: struct_fields, /** non-static fields */ + statics: struct_fields, /** static fields */ + supers: list Typename.t, /** list of superclasses */ + methods: list Procname.t, /** methods defined */ + annots: item_annotation /** annotations */ } /** types for sil (structured) expressions */ and t = @@ -309,11 +309,11 @@ and struct_typ_compare struct_typ1 struct_typ2 => | (TN_csu (Class Java) _, TN_csu (Class Java) _) => Typename.compare struct_typ1.name struct_typ2.name | _ => - let n = fld_typ_ann_list_compare struct_typ1.instance_fields struct_typ2.instance_fields; + let n = fld_typ_ann_list_compare struct_typ1.fields struct_typ2.fields; if (n != 0) { n } else { - let n = fld_typ_ann_list_compare struct_typ1.static_fields struct_typ2.static_fields; + let n = fld_typ_ann_list_compare struct_typ1.statics struct_typ2.statics; if (n != 0) { n } else { @@ -362,7 +362,7 @@ let struct_typ_equal struct_typ1 struct_typ2 => struct_typ_compare struct_typ1 s let equal t1 t2 => compare t1 t2 == 0; -let rec pp_struct_typ pe pp_base f {instance_fields, name} => +let rec pp_struct_typ pe pp_base f {fields, name} => if false { /* change false to true to print the details of struct */ F.fprintf @@ -371,7 +371,7 @@ let rec pp_struct_typ pe pp_base f {instance_fields, name} => Typename.pp name (pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld)) - instance_fields + fields pp_base () } else { @@ -451,6 +451,49 @@ let module Tbl = Hashtbl.Make { let hash = Hashtbl.hash; }; +let mk_struct + default::default=? + fields::fields=? + statics::statics=? + methods::methods=? + supers::supers=? + annots::annots=? + name => { + let mk_struct_ + name::name + default:: + default={ + name, + fields: [], + statics: [], + methods: [], + supers: [], + annots: item_annotation_empty + } + fields::fields=default.fields + statics::statics=default.statics + methods::methods=default.methods + supers::supers=default.supers + annots::annots=default.annots + () => { + name, + fields, + statics, + methods, + supers, + annots + }; + mk_struct_ + name::name + default::?default + fields::?fields + statics::?statics + methods::?methods + supers::?supers + annots::?annots + () +}; + let name t => switch t { | Tvar name @@ -486,11 +529,11 @@ let array_elem default_opt => let rec get_extensible_array_element_typ expand_type::expand_type typ => switch (expand_type typ) { | Tarray typ _ => Some typ - | Tstruct {instance_fields} => + | Tstruct {fields} => Option.map_default (fun (_, fld_typ, _) => get_extensible_array_element_typ expand_type::expand_type fld_typ) None - (IList.last instance_fields) + (IList.last fields) | _ => None }; @@ -503,7 +546,7 @@ let struct_typ_fld expand_type::expand_type default_opt f typ => { | Tstruct struct_typ => try ( (fun (_, y, _) => y) ( - IList.find (fun (_f, _, _) => Ident.fieldname_equal _f f) struct_typ.instance_fields + IList.find (fun (_f, _, _) => Ident.fieldname_equal _f f) struct_typ.fields ) ) { | Not_found => def () @@ -519,8 +562,7 @@ let get_field_type_and_annotation expand_ptr_type::expand_ptr_type fn typ => try { let (_, t, a) = IList.find - (fun (f, _, _) => Ident.fieldname_equal f fn) - (struct_typ.instance_fields @ struct_typ.static_fields); + (fun (f, _, _) => Ident.fieldname_equal f fn) (struct_typ.fields @ struct_typ.statics); Some (t, a) } { | Not_found => None diff --git a/infer/src/IR/Typ.rei b/infer/src/IR/Typ.rei index 6a5f37877..9a99a2f70 100644 --- a/infer/src/IR/Typ.rei +++ b/infer/src/IR/Typ.rei @@ -137,13 +137,13 @@ type static_length = option IntLit.t; type struct_fields = list (Ident.fieldname, t, item_annotation) /** Type for a structured value. */ -and struct_typ = { +and struct_typ = private { name: Typename.t, /** name */ - instance_fields: struct_fields, /** non-static fields */ - static_fields: struct_fields, /** static fields */ - superclasses: list Typename.t, /** list of superclasses */ - def_methods: list Procname.t, /** methods defined */ - struct_annotations: item_annotation /** annotations */ + fields: struct_fields, /** non-static fields */ + statics: struct_fields, /** static fields */ + supers: list Typename.t, /** list of supers */ + methods: list Procname.t, /** methods defined */ + annots: item_annotation /** annotations */ } /** types for sil (structured) expressions */ and t = @@ -209,6 +209,18 @@ let module Map: Map.S with type key = t; let module Tbl: Hashtbl.S with type key = t; +/** Construct a struct_typ, normalizing field types */ +let mk_struct: + default::struct_typ? => + fields::struct_fields? => + statics::struct_fields? => + methods::list Procname.t? => + supers::list Typename.t? => + annots::item_annotation? => + Typename.t => + struct_typ; + + /** The name of a type */ let name: t => option Typename.t; diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 050324d79..1d123f91c 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -423,8 +423,8 @@ let typ_get_recursive_flds tenv typ_exp = | Exp.Sizeof (typ, _, _) -> (match Tenv.expand_type tenv typ with | Typ.Tint _ | Typ.Tvoid | Typ.Tfun _ | Typ.Tptr _ | Typ.Tfloat _ -> [] - | Typ.Tstruct { Typ.instance_fields } -> - IList.map (fun (x, _, _) -> x) (IList.filter (filter typ) instance_fields) + | Typ.Tstruct { fields } -> + IList.map (fun (x, _, _) -> x) (IList.filter (filter typ) fields) | Typ.Tarray _ -> [] | Typ.Tvar _ -> assert false) | Exp.Var _ -> [] (* type of |-> not known yet *) @@ -1003,11 +1003,11 @@ let cycle_has_weak_or_unretained_or_assign_field tenv cycle = (* returns items annotation for field fn in struct t *) let get_item_annotation t fn = match Tenv.expand_type tenv t with - | Typ.Tstruct { Typ.instance_fields; static_fields } -> + | Tstruct { fields; statics } -> let ia = ref [] in IList.iter (fun (fn', _, ia') -> if Ident.fieldname_equal fn fn' then ia := ia') - (instance_fields @ static_fields); + (fields @ statics); !ia | _ -> [] in let rec has_weak_or_unretained_or_assign params = diff --git a/infer/src/backend/absarray.ml b/infer/src/backend/absarray.ml index 5b707982f..cccafb790 100644 --- a/infer/src/backend/absarray.ml +++ b/infer/src/backend/absarray.ml @@ -67,11 +67,11 @@ end = struct let rec get_strexp_at_syn_offsets tenv se t syn_offs = match se, Tenv.expand_type tenv t, syn_offs with | _, _, [] -> (se, t) - | Sil.Estruct (fsel, _), Typ.Tstruct { Typ.instance_fields }, Field (fld, _) :: syn_offs' -> + | Sil.Estruct (fsel, _), Tstruct { fields }, Field (fld, _) :: syn_offs' -> let se' = snd (IList.find (fun (f', _) -> Ident.fieldname_equal f' fld) fsel) in let t' = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> - Ident.fieldname_equal f' fld) instance_fields) in + Ident.fieldname_equal f' fld) fields) in get_strexp_at_syn_offsets tenv se' t' syn_offs' | Sil.Earray (_, esel, _), Typ.Tarray (t', _), Index ind :: syn_offs' -> let se' = snd (IList.find (fun (i', _) -> Exp.equal i' ind) esel) in @@ -87,11 +87,11 @@ end = struct match se, Tenv.expand_type tenv t, syn_offs with | _, _, [] -> update se - | Sil.Estruct (fsel, inst), Typ.Tstruct { Typ.instance_fields }, Field (fld, _) :: syn_offs' -> + | Sil.Estruct (fsel, inst), Tstruct { fields }, Field (fld, _) :: syn_offs' -> let se' = snd (IList.find (fun (f', _) -> Ident.fieldname_equal f' fld) fsel) in let t' = (fun (_,y,_) -> y) (IList.find (fun (f', _, _) -> - Ident.fieldname_equal f' fld) instance_fields) in + Ident.fieldname_equal f' fld) fields) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let fsel' = IList.map (fun (f'', se'') -> @@ -151,8 +151,8 @@ end = struct if pred (path, se, typ) then found := (sigma, hpred, offs') :: !found else begin match se, Tenv.expand_type tenv typ with - | Sil.Estruct (fsel, _), Typ.Tstruct { Typ.instance_fields } -> - find_offset_fsel sigma_other hpred root offs fsel instance_fields typ + | Sil.Estruct (fsel, _), Tstruct { fields } -> + find_offset_fsel sigma_other hpred root offs fsel fields typ | Sil.Earray (_, esel, _), Typ.Tarray (t, _) -> find_offset_esel sigma_other hpred root offs esel t | _ -> () diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 1b65fc01c..97a5d3156 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -584,11 +584,11 @@ let vpath_find tenv prop _exp : DExp.t option * Typ.t option = let typo = match texp with | Exp.Sizeof (typ, _, _) -> ( match Tenv.expand_type tenv typ with - | Tstruct {instance_fields} -> ( + | Tstruct {fields} -> ( try let _, t, _ = IList.find (fun (f', _, _) -> Ident.fieldname_equal f' f) - instance_fields in + fields in Some t with Not_found -> None ) diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 542688c3e..50d582903 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -504,7 +504,7 @@ let rec create_strexp_of_type tenv struct_init_mode (typ : Typ.t) len inst : Sil match Tenv.expand_type tenv typ, len with | (Tint _ | Tfloat _ | Tvoid | Tfun _ | Tptr _), None -> Eexp (init_value (), inst) - | Tstruct { Typ.instance_fields }, _ -> ( + | Tstruct { fields }, _ -> ( match struct_init_mode with | No_init -> Estruct ([], inst) @@ -516,7 +516,7 @@ let rec create_strexp_of_type tenv struct_init_mode (typ : Typ.t) len inst : Sil ((fld, Sil.Eexp (Exp.one, inst)) :: flds, None) else ((fld, create_strexp_of_type tenv struct_init_mode t len inst) :: flds, None) in - let flds, _ = IList.fold_right f instance_fields ([], len) in + let flds, _ = IList.fold_right f fields ([], len) in Estruct (flds, inst) ) | Tarray (_, len_opt), None -> diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index e511bef27..5a3413e46 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -1477,15 +1477,12 @@ let expand_hpred_pointer tenv calc_index_frame hpred : bool * bool * Sil.hpred = | _, Sizeof (cnt_typ, len, st) -> (* type of struct at adr_base is unknown (typically Tvoid), but type of contents is known, so construct struct type for single fld:cnt_typ *) - Exp.Sizeof - (Tstruct - { instance_fields = [(fld, cnt_typ, Typ.item_annotation_empty)]; - static_fields = []; - name = TN_csu (Struct, Mangled.from_string "counterfeit"); - superclasses = []; - def_methods = []; - struct_annotations = Typ.item_annotation_empty; - }, len, st) + let struct_typ = + Typ.Tstruct + (Typ.mk_struct + ~fields: [(fld, cnt_typ, Typ.item_annotation_empty)] + (TN_csu (Struct, Mangled.from_string "counterfeit"))) in + Exp.Sizeof (struct_typ, len, st) | _ -> (* type of struct at adr_base and of contents are both unknown: give up *) raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in @@ -1521,8 +1518,8 @@ struct let is_interface tenv class_name = match Tenv.lookup tenv class_name with | Some ({ name = TN_csu (Class Java, _) } as struct_typ) -> - (IList.length struct_typ.Typ.instance_fields = 0) && - (IList.length struct_typ.Typ.def_methods = 0) + (IList.length struct_typ.fields = 0) && + (IList.length struct_typ.methods = 0) | _ -> false let is_root_class class_name = @@ -1538,8 +1535,8 @@ struct let rec check cn = Typename.equal cn c2 || is_root_class c2 || match Tenv.lookup tenv cn with - | Some ({ name = TN_csu (Class _, _); superclasses }) -> - IList.exists check superclasses + | Some ({ name = TN_csu (Class _, _); supers }) -> + IList.exists check supers | _ -> false in check c1 @@ -1665,8 +1662,8 @@ let cast_exception tenv texp1 texp2 e1 subs = let get_overrides_of tenv supertype pname = let typ_has_method pname typ = match Tenv.expand_type tenv typ with - | Typ.Tstruct { Typ.def_methods } -> - IList.exists (fun m -> Procname.equal pname m) def_methods + | Tstruct { methods } -> + IList.exists (fun m -> Procname.equal pname m) methods | _ -> false in let gather_overrides tname struct_typ overrides_acc = let typ = Typ.Tstruct struct_typ in diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 0c045955c..c4d1e4922 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -98,14 +98,14 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp Ident.create kind !max_stamp in let res = match Tenv.expand_type tenv t, off with - | Typ.Tstruct _, [] -> + | Tstruct _, [] -> ([], Sil.Estruct ([], inst), t) - | Typ.Tstruct ({ Typ.instance_fields; static_fields } as struct_typ ), + | Tstruct ({ fields; statics } as struct_typ ), (Sil.Off_fld (f, _)):: off' -> let _, t', _ = try IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') - (instance_fields @ static_fields) + (fields @ statics) with Not_found -> raise (Exceptions.Bad_footprint __POS__) in let atoms', se', res_t' = @@ -114,9 +114,10 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp let se = Sil.Estruct ([(f, se')], inst) in let replace_typ_of_f (f', t', a') = if Ident.fieldname_equal f f' then (f, res_t', a') else (f', t', a') in - let instance_fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_typ_of_f instance_fields) in - (atoms', se, Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields'}) + let fields' = + IList.sort Typ.fld_typ_ann_compare (IList.map replace_typ_of_f fields) in + (atoms', se, + Typ.Tstruct (Typ.mk_struct ~default:struct_typ ~fields:fields' struct_typ.name)) | Typ.Tstruct _, (Sil.Off_index e):: off' -> let atoms', se', res_t' = create_struct_values @@ -205,12 +206,12 @@ let rec _strexp_extend_values _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst | (Sil.Off_fld (f, _)):: off', Sil.Estruct (fsel, inst'), - Typ.Tstruct ({ Typ.instance_fields; static_fields } as struct_typ) -> + Tstruct ({ fields; statics } as struct_typ) -> 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', _, _) -> Ident.fieldname_equal f f') - (instance_fields @ static_fields) + (fields @ statics) with Not_found -> raise (Exceptions.Missing_fld (f, __POS__)) in begin @@ -223,10 +224,11 @@ let rec _strexp_extend_values let replace_fse = replace_fv res_se' in let res_fsel' = IList.sort Sil.fld_strexp_compare (IList.map replace_fse fsel) in let replace_fta (f, t, a) = let f', t' = replace_fv res_typ' (f, t) in (f', t', a) in - let instance_fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta instance_fields) in + let fields' = + IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta fields) in let struct_typ = - Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in + Typ.Tstruct + (Typ.mk_struct ~default:struct_typ ~fields:fields' struct_typ.name) in (res_atoms', Sil.Estruct (res_fsel', inst'), struct_typ) :: acc in IList.fold_left replace [] atoms_se_typ_list' with Not_found -> @@ -235,9 +237,11 @@ let rec _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in let res_fsel' = IList.sort Sil.fld_strexp_compare ((f, se'):: fsel) in let replace_fta (f', t', a') = if Ident.fieldname_equal f' f then (f, res_typ', a') else (f', t', a') in - let instance_fields' = - IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta instance_fields) in - let struct_typ = Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in + let fields' = + IList.sort Typ.fld_typ_ann_compare (IList.map replace_fta fields) in + let struct_typ = + Typ.Tstruct + (Typ.mk_struct ~default:struct_typ ~fields:fields' struct_typ.name) in [(atoms', Sil.Estruct (res_fsel', inst'), struct_typ)] end | (Sil.Off_fld (_, _)):: _, _, _ -> @@ -1031,11 +1035,11 @@ let type_at_offset tenv texp off = let rec strip_offset off typ = match off, Tenv.expand_type tenv typ with | [], _ -> Some typ - | (Sil.Off_fld (f, _)):: off', Typ.Tstruct { Typ.instance_fields } -> + | (Sil.Off_fld (f, _)):: off', Tstruct { fields } -> (try let typ' = (fun (_, y, _) -> y) - (IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') instance_fields) in + (IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') fields) in strip_offset off' typ' with Not_found -> None) | (Sil.Off_index _) :: off', Typ.Tarray (typ', _) -> diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index 1d20aae8e..94cc9dfa6 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -24,9 +24,9 @@ let rec unroll_type tenv typ off = | Typ.Tvar _, _ -> let typ' = Tenv.expand_type tenv typ in unroll_type tenv typ' off - | Typ.Tstruct { Typ.instance_fields; static_fields }, Sil.Off_fld (fld, _) -> + | Typ.Tstruct { fields; statics }, Sil.Off_fld (fld, _) -> begin - try fldlist_assoc fld (instance_fields @ static_fields) + try fldlist_assoc fld (fields @ statics) with Not_found -> L.d_strln ".... Invalid Field Access ...."; L.d_strln ("Fld : " ^ Ident.fieldname_to_string fld); @@ -158,9 +158,10 @@ let rec apply_offlist let res_se = Sil.Estruct (IList.map replace_fse fsel, inst') in let replace_fta (f, t, a) = if Ident.fieldname_equal fld f then (fld, res_t', a) else (f, t, a) in - let instance_fields' = IList.map replace_fta struct_typ.Typ.instance_fields in + let fields' = IList.map replace_fta struct_typ.fields in let res_t = - Typ.Tstruct { struct_typ with Typ.instance_fields = instance_fields' } in + Typ.Tstruct + (Typ.mk_struct ~default:struct_typ ~fields:fields' struct_typ.name) in (res_e', res_se, res_t, res_pred_insts_op') with Not_found -> pp_error(); @@ -506,11 +507,11 @@ let resolve_method tenv class_name proc_name = let right_proc_name = Procname.replace_class proc_name (Typename.name class_name) in match Tenv.lookup tenv class_name with - | Some { name = TN_csu (Class _, _); def_methods; superclasses } -> - if method_exists right_proc_name def_methods then + | Some { name = TN_csu (Class _, _); methods; supers } -> + if method_exists right_proc_name methods then Some right_proc_name else - (match superclasses with + (match supers with | super_classname:: _ -> if not (Typename.Set.mem super_classname !visited) then resolve super_classname diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index 3cb6d3632..b4ef76db8 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -468,10 +468,10 @@ let texp_star tenv texp1 texp2 = | _ -> ftal_sub ftal1 ftal2' end in let typ_star t1 t2 = match Tenv.expand_type tenv t1, Tenv.expand_type tenv t2 with - | Typ.Tstruct { instance_fields = instance_fields1; name = TN_csu (csu1, _) }, - Typ.Tstruct { instance_fields = instance_fields2; name = TN_csu (csu2, _) } + | Tstruct { fields = fields1; name = TN_csu (csu1, _) }, + Tstruct { fields = fields2; name = TN_csu (csu2, _) } when csu1 = csu2 -> - if ftal_sub instance_fields1 instance_fields2 then t2 else t1 + if ftal_sub fields1 fields2 then t2 else t1 | _ -> t1 in match texp1, texp2 with | Exp.Sizeof (t1, len1, st1), Exp.Sizeof (t2, _, st2) -> diff --git a/infer/src/backend/taint.ml b/infer/src/backend/taint.ml index 1bfaa06e2..611cd1424 100644 --- a/infer/src/backend/taint.ml +++ b/infer/src/backend/taint.ml @@ -355,8 +355,8 @@ let has_taint_annotation fieldname struct_typ = let fld_has_taint_annot (fname, _, annot) = Ident.fieldname_equal fieldname fname && (Annotations.ia_is_privacy_source annot || Annotations.ia_is_integrity_source annot) in - IList.exists fld_has_taint_annot struct_typ.Typ.instance_fields || - IList.exists fld_has_taint_annot struct_typ.Typ.static_fields + IList.exists fld_has_taint_annot struct_typ.Typ.fields || + IList.exists fld_has_taint_annot struct_typ.Typ.statics (* add tainting attributes to a list of paramenters *) let get_params_to_taint tainted_param_nums formal_params = diff --git a/infer/src/checkers/annotationReachability.ml b/infer/src/checkers/annotationReachability.ml index a22542a7e..7d3d6ba91 100644 --- a/infer/src/checkers/annotationReachability.ml +++ b/infer/src/checkers/annotationReachability.ml @@ -136,8 +136,8 @@ let is_allocator tenv pname = let check_attributes check tenv pname = let check_class_attributes check tenv = function | Procname.Java java_pname -> - let check_class_annots { Typ.struct_annotations; } = - check struct_annotations in + let check_class_annots { Typ.annots; } = + check annots in begin match Tenv.proc_extract_declaring_class_typ tenv java_pname with | Some current_class -> diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 3a10a5773..f5d95b3b0 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -39,7 +39,7 @@ let suppressLint = "android.annotation.SuppressLint" (** Return the annotations on the declaring class of [pname]. Only works for Java *) let get_declaring_class_annotations pname tenv = match Tenv.proc_extract_declaring_class_typ tenv pname with - | Some { Typ.struct_annotations } -> Some struct_annotations + | Some { annots } -> Some annots | None -> None let ia_iter f = diff --git a/infer/src/checkers/checkers.ml b/infer/src/checkers/checkers.ml index 1db65026f..bc035bfcf 100644 --- a/infer/src/checkers/checkers.ml +++ b/infer/src/checkers/checkers.ml @@ -222,8 +222,8 @@ let callback_check_write_to_parcel_java let parcel_constructors tenv typ = match Tenv.expand_ptr_type tenv typ with - | Typ.Tptr (Typ.Tstruct { Typ.def_methods }, _) -> - IList.filter is_parcel_constructor def_methods + | Tptr (Tstruct { methods }, _) -> + IList.filter is_parcel_constructor methods | _ -> [] in let check r_desc w_desc = diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 924b54db3..366239264 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -45,10 +45,10 @@ let callback_fragment_retains_view_java let class_typename = Typename.Java.from_string (Procname.java_get_class_name pname_java) in match Tenv.lookup tenv class_typename with - | Some ({ instance_fields } as struct_typ) + | Some ({ fields } as struct_typ) when AndroidFramework.is_fragment tenv struct_typ -> let declared_view_fields = - IList.filter (is_declared_view_typ class_typename) instance_fields in + IList.filter (is_declared_view_typ class_typename) fields in let fields_nullified = PatternMatch.get_fields_nullified proc_desc in (* report if a field is declared by C, but not nulled out in C.onDestroyView *) IList.iter diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index c857487f8..b8e85572d 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -36,13 +36,13 @@ let java_proc_name_with_class_method pn_java class_with_path method_name = with _ -> false) let get_direct_supers tenv = function - | { Typ.name = TN_csu (Class _, _); superclasses } -> - IList.map (Tenv.lookup tenv) superclasses + | { Typ.name = TN_csu (Class _, _); supers } -> + IList.map (Tenv.lookup tenv) supers |> IList.flatten_options | _ -> [] -(** get the superclasses of [typ]. does not include [typ] itself *) +(** get the supers of [typ]. does not include [typ] itself *) let strict_supertype_iter tenv f_typ orig_struct_typ = let rec get_supers_rec struct_typ = let direct_supers = get_direct_supers tenv struct_typ in @@ -59,7 +59,7 @@ let strict_supertype_exists tenv f_typ orig_struct_typ = get_supers_rec orig_struct_typ let is_immediate_subtype this_type super_type_name = - IList.exists (Typename.equal super_type_name) this_type.Typ.superclasses + IList.exists (Typename.equal super_type_name) this_type.Typ.supers (** return true if [typ0] <: [typ1] *) let is_subtype tenv struct_typ0 struct_typ1 = @@ -80,9 +80,9 @@ let get_this_type proc_attributes = match proc_attributes.ProcAttributes.formals let type_get_direct_supertypes tenv typ = match Tenv.expand_ptr_type tenv typ with - | Typ.Tptr (Tstruct { superclasses }, _) - | Typ.Tstruct { superclasses } -> - superclasses + | Tptr (Tstruct { supers }, _) + | Tstruct { supers } -> + supers | _ -> [] @@ -90,12 +90,11 @@ let type_get_class_name = function | Typ.Tptr (typ, _) -> Typ.name typ | _ -> None -let type_get_annotation tenv - (t: Typ.t): Typ.item_annotation option = +let type_get_annotation tenv (t: Typ.t): Typ.item_annotation option = match Tenv.expand_ptr_type tenv t with - | Typ.Tptr (Typ.Tstruct { Typ.struct_annotations }, _) - | Typ.Tstruct { Typ.struct_annotations } -> - Some struct_annotations + | Tptr (Tstruct { annots }, _) + | Tstruct { annots } -> + Some annots | _ -> None let type_has_direct_supertype tenv (typ : Typ.t) (class_name : Typename.t) = @@ -111,8 +110,8 @@ let type_has_supertype else begin match Tenv.expand_ptr_type tenv typ with - | Typ.Tptr (Typ.Tstruct { Typ.superclasses }, _) - | Typ.Tstruct { Typ.superclasses } -> + | Tptr (Tstruct { supers }, _) + | Tstruct { supers } -> let match_supertype cn = let match_name () = Typename.equal cn class_name in let has_indirect_supertype () = @@ -121,7 +120,7 @@ let type_has_supertype has_supertype (Typ.Tstruct supertype) (Typ.Set.add typ visited) | None -> false in (match_name () || has_indirect_supertype ()) in - IList.exists match_supertype superclasses + IList.exists match_supertype supers | _ -> false end in has_supertype typ Typ.Set.empty @@ -141,12 +140,12 @@ let get_field_type_name tenv (typ: Typ.t) (fieldname: Ident.fieldname): string option = match Tenv.expand_ptr_type tenv typ with - | Typ.Tstruct { Typ.instance_fields } - | Typ.Tptr (Typ.Tstruct { Typ.instance_fields }, _) -> ( + | Tstruct { fields } + | Tptr (Tstruct { fields }, _) -> ( try let _, ft, _ = IList.find (function | (fn, _, _) -> Ident.fieldname_equal fn fieldname) - instance_fields in + fields in Some (get_type_name ft) with Not_found -> None) | _ -> None @@ -345,7 +344,7 @@ let proc_iter_overridden_methods f tenv proc_name = let super_proc_name = Procname.replace_class proc_name (Typename.name super_class_name) in match Tenv.lookup tenv super_class_name with - | Some ({ Typ.def_methods }) -> + | Some ({ methods }) -> let is_override pname = Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in @@ -353,7 +352,7 @@ let proc_iter_overridden_methods f tenv proc_name = (fun pname -> if is_override pname then f pname) - def_methods + methods | _ -> () in match proc_name with diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 6fef8499f..13f7757b1 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -128,9 +128,9 @@ let curr_class_equal curr_class1 curr_class2 = let create_curr_class tenv class_name ck = let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in match Tenv.lookup tenv class_tn_name with - | Some { Typ.superclasses } -> - (let superclasses_names = IList.map Typename.name superclasses in - match superclasses_names with + | Some { supers } -> + (let supers_names = IList.map Typename.name supers in + match supers_names with | superclass:: protocols -> ContextCls (class_name, Some superclass, protocols) | [] -> ContextCls (class_name, None, [])) diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index a0686b115..d5cce054b 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -21,10 +21,10 @@ let rec get_fields_super_classes tenv super_class = Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class); match Tenv.lookup tenv super_class with | None -> [] - | Some { Typ.instance_fields; superclasses = super_class :: _ } -> + | Some { fields; supers = super_class :: _ } -> let sc_fields = get_fields_super_classes tenv super_class in - General_utils.append_no_duplicates_fields instance_fields sc_fields - | Some { Typ.instance_fields } -> instance_fields + General_utils.append_no_duplicates_fields fields sc_fields + | Some { fields } -> fields let fields_superclass tenv interface_decl_info ck = match interface_decl_info.Clang_ast_t.otdi_super with @@ -76,18 +76,14 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = (* Add potential extra fields defined only in the implementation of the class *) (* to the info given in the interface. Update the tenv accordingly. *) -let add_missing_fields tenv class_name ck fields = +let add_missing_fields tenv class_name ck missing_fields = let mang_name = Mangled.from_string class_name in let class_tn_name = Typename.TN_csu (Csu.Class ck, mang_name) in match Tenv.lookup tenv class_tn_name with - | Some ({ Typ.instance_fields } as struct_typ) -> - let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in - let class_type_info = { - struct_typ with - instance_fields = new_fields; - static_fields = []; - name = class_tn_name; - } in + | Some ({ fields } as struct_typ) -> + let new_fields = General_utils.append_no_duplicates_fields fields missing_fields in + let class_type_info = + Typ.mk_struct ~default:struct_typ ~fields:new_fields ~statics:[] class_tn_name in Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Tenv.add tenv class_tn_name class_type_info | _ -> () diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 75f24aa02..0bfad0a75 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -525,9 +525,9 @@ struct let sort_fields_tenv tenv = - let sort_fields_struct typname st = - let st' = { st with Typ.instance_fields = (sort_fields st.Typ.instance_fields) } in - Tenv.add tenv typname st' in + let sort_fields_struct typname ({Typ.name; fields} as st) = + Tenv.add tenv typname + (Typ.mk_struct ~default:st ~fields:(sort_fields fields) name) in Tenv.iter sort_fields_struct tenv let rec collect_list_tuples l (a, a1, b, c, d) = diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index dea69f64f..3448a685c 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -230,7 +230,7 @@ let get_superclass_curr_class_objc context = let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in Printing.log_out "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname); match Tenv.lookup (CContext.get_tenv context) iname with - | Some { Typ.superclasses = super_name :: _ } -> + | Some { supers = super_name :: _ } -> Typename.name super_name | _ -> Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index b201e1d07..6dfd3ffd5 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -126,15 +126,7 @@ struct Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let mblock = Mangled.from_string block_name in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in - let block_struct_typ = - { - Typ.instance_fields = fields; - static_fields = []; - name = block_name; - superclasses = []; - def_methods = []; - struct_annotations = []; - } in + let block_struct_typ = Typ.mk_struct ~fields block_name in let block_type = Typ.Tstruct block_struct_typ in Tenv.add tenv block_name block_struct_typ; let trans_res = diff --git a/infer/src/clang/cTrans_utils.ml b/infer/src/clang/cTrans_utils.ml index e74e2b203..10b05abad 100644 --- a/infer/src/clang/cTrans_utils.ml +++ b/infer/src/clang/cTrans_utils.ml @@ -717,10 +717,10 @@ let var_or_zero_in_init_list tenv e typ ~return_zero:return_zero = (match Tenv.lookup tenv tn with | Some struct_typ -> var_or_zero_in_init_list' e (Typ.Tstruct struct_typ) tns | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) - | Typ.Tstruct { Typ.instance_fields } as type_struct -> + | Typ.Tstruct { fields } as type_struct -> let lh_exprs = IList.map ( fun (fieldname, _, _) -> - Exp.Lfield (e, fieldname, type_struct) ) instance_fields in - let lh_types = IList.map ( fun (_, fieldtype, _) -> fieldtype) instance_fields in + Exp.Lfield (e, fieldname, type_struct) ) fields in + let lh_types = IList.map ( fun (_, fieldtype, _) -> fieldtype) fields in let exp_types = zip lh_exprs lh_types in IList.map (fun (e, t) -> IList.flatten (var_or_zero_in_init_list' e t tns)) exp_types diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 6eae48977..b48a8d778 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -18,25 +18,11 @@ module L = Logging let add_predefined_objc_types tenv = let class_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCClass in let objc_class_type_info = - { - Typ.instance_fields = []; - static_fields = []; - name = TN_csu (Struct, Mangled.from_string CFrontend_config.objc_class); - superclasses = []; - def_methods = []; - struct_annotations = []; - } in + Typ.mk_struct (TN_csu (Struct, Mangled.from_string CFrontend_config.objc_class)) in Tenv.add tenv class_typename objc_class_type_info; let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in let objc_object_type_info = - { - Typ.instance_fields = []; - static_fields = []; - name = TN_csu (Struct, Mangled.from_string CFrontend_config.objc_object); - superclasses = []; - def_methods = []; - struct_annotations = []; - } in + Typ.mk_struct (TN_csu (Struct, Mangled.from_string CFrontend_config.objc_object)) in Tenv.add tenv id_typename objc_object_type_info (* Whenever new type are added manually to the translation in ast_expressions, *) @@ -207,25 +193,18 @@ and get_record_declaration_struct_type tenv decl = let extra_fields = if CTrans_models.is_objc_memory_model_controlled name then [Typ.objc_ref_counter_field] else [] in - let struct_annotations = + let annots = if csu = Csu.Class Csu.CPP then Typ.cpp_class_annotation else Typ.item_annotation_empty (* No annotations for structs *) in if is_complete_definition then ( Ast_utils.update_sil_types_map type_ptr (Typ.Tvar sil_typename); - let non_static_fields = get_struct_fields tenv decl in - let non_static_fields = - General_utils.append_no_duplicates_fields non_static_fields extra_fields in - let static_fields = [] in (* Note: We treat static field same as global variables *) - let def_methods = get_class_methods name decl_list in (* C++ methods only *) - let superclasses = get_superclass_list_cpp decl in - let sil_type = Typ.Tstruct { - Typ.instance_fields = non_static_fields; - static_fields; - name = sil_typename; - superclasses; - def_methods; - struct_annotations; - } in + let non_statics = get_struct_fields tenv decl in + let fields = General_utils.append_no_duplicates_fields non_statics extra_fields in + let statics = [] in (* Note: We treat static field same as global variables *) + let methods = get_class_methods name decl_list in (* C++ methods only *) + let supers = get_superclass_list_cpp decl in + let sil_type = + Typ.Tstruct (Typ.mk_struct ~fields ~statics ~methods ~supers ~annots sil_typename) in Ast_utils.update_sil_types_map type_ptr sil_type; add_struct_to_tenv tenv sil_type; sil_type @@ -240,14 +219,7 @@ and get_record_declaration_struct_type tenv decl = (* Note: we know that this type will be wrapped with pointer type because *) (* there was no full definition of that type yet. *) let tvar_type = Typ.Tvar sil_typename in - let empty_struct_type = Typ.Tstruct { - Typ.instance_fields = extra_fields; - static_fields = []; - name = sil_typename; - superclasses = []; - def_methods = []; - struct_annotations; - } in + let empty_struct_type = Typ.Tstruct (Typ.mk_struct ~fields:extra_fields sil_typename) in Ast_utils.update_sil_types_map type_ptr tvar_type; add_struct_to_tenv tenv empty_struct_type; tvar_type) diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index cfbddbc2b..5c3e9faf9 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -70,24 +70,20 @@ let get_base_class_name_from_category decl = (* Add potential extra fields defined only in the category *) (* to the corresponding class. Update the tenv accordingly.*) let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = - let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in - let methods = ObjcProperty_decl.get_methods curr_class decl_list in + let decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in + let decl_methods = ObjcProperty_decl.get_methods curr_class decl_list in let class_name = CContext.get_curr_class_name curr_class in let mang_name = Mangled.from_string class_name in let class_tn_name = Typename.TN_csu (Csu.Class Csu.Objc, mang_name) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Typ.Tvar class_tn_name); (match Tenv.lookup tenv class_tn_name with - | Some ({ Typ.instance_fields; def_methods } as struct_typ) -> - let new_fields = General_utils.append_no_duplicates_fields fields instance_fields in - let new_methods = General_utils.append_no_duplicates_methods methods def_methods in - let class_type_info = { - struct_typ with - instance_fields = new_fields; - static_fields = []; - name = class_tn_name; - def_methods = new_methods; - } in + | Some ({ fields; methods } as struct_typ) -> + let new_fields = General_utils.append_no_duplicates_fields decl_fields fields in + let new_methods = General_utils.append_no_duplicates_methods decl_methods methods in + let class_type_info = + Typ.mk_struct + ~default:struct_typ ~fields:new_fields ~statics:[] ~methods:new_methods class_tn_name in Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Tenv.add tenv class_tn_name class_type_info | _ -> ()); diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index c02894b3e..f696020cc 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -79,7 +79,7 @@ let add_class_implementation type_ptr_to_sil_type tenv idi = (*The superclass is the first element in the list of super classes of structs in the tenv, *) (* then come the protocols and categories. *) -let get_interface_superclasses super_opt protocols = +let get_interface_supers super_opt protocols = let super_class = match super_opt with | None -> [] @@ -90,13 +90,13 @@ 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 +let create_supers_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 - let superclasses = get_interface_superclasses super protocols in + let supers = get_interface_supers super protocols in let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in - superclasses, fields + supers, fields (* Adds pairs (interface name, interface_type_info) to the global environment. *) let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info decl_list ocidi = @@ -105,8 +105,8 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d let interface_name = CTypes.mk_classname class_name Csu.Objc in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Typ.Tvar interface_name); - let superclasses, fields = - create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list + let supers, fields = + create_supers_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 @@ -115,13 +115,13 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Printing.log_out "type: '%s'\n" (Typ.to_string ft)) fields_sc; (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) - let fields, (superclasses : Typename.t list), methods = + let fields, (supers : Typename.t list), methods = match Tenv.lookup tenv interface_name with - | Some ({ Typ.instance_fields; superclasses; def_methods }) -> - General_utils.append_no_duplicates_fields fields instance_fields, - General_utils.append_no_duplicates_csu superclasses superclasses, - General_utils.append_no_duplicates_methods methods def_methods - | _ -> fields, superclasses, methods in + | Some ({ fields; supers; methods }) -> + General_utils.append_no_duplicates_fields fields fields, + General_utils.append_no_duplicates_csu supers supers, + General_utils.append_no_duplicates_methods methods methods + | _ -> fields, supers, methods in let fields = General_utils.append_no_duplicates_fields fields fields_sc in (* We add the special hidden counter_field for implementing reference counting *) let modelled_fields = Typ.objc_ref_counter_field :: CField_decl.modelled_field name_info in @@ -129,14 +129,9 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d Printing.log_out "Class %s field:\n" class_name; IList.iter (fun (fn, _, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) all_fields; - let interface_type_info = Typ.{ - instance_fields = all_fields; - static_fields = []; - name = interface_name; - superclasses; - def_methods = methods; - struct_annotations = objc_class_annotation; - } in + let interface_type_info = + Typ.mk_struct ~fields: all_fields ~supers ~methods ~annots:Typ.objc_class_annotation + interface_name in Tenv.add tenv interface_name interface_type_info; Printing.log_out " >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name); @@ -146,15 +141,15 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d Typ.Tvar interface_name let add_missing_methods tenv class_name ck decl_info decl_list curr_class = - let methods = ObjcProperty_decl.get_methods curr_class decl_list in + let decl_methods = ObjcProperty_decl.get_methods curr_class decl_list in let class_tn_name = Typename.TN_csu (Csu.Class ck, (Mangled.from_string class_name)) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Typ.Tvar class_tn_name); begin match Tenv.lookup tenv class_tn_name with - | Some ({ static_fields = []; name = TN_csu (Class _, _); def_methods; } as struct_typ) -> - let methods = General_utils.append_no_duplicates_methods def_methods methods in - let struct_typ' = { struct_typ with Typ.def_methods = methods; } in + | Some ({ statics = []; name = TN_csu (Class _, _); methods; } as struct_typ) -> + let methods = General_utils.append_no_duplicates_methods methods decl_methods in + let struct_typ' = Typ.mk_struct ~default:struct_typ ~methods struct_typ.name in Tenv.add tenv class_tn_name struct_typ' | _ -> () end; diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index 8cfa8dbf3..467ebcdd0 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -32,15 +32,8 @@ let protocol_decl type_ptr_to_sil_type tenv decl = let protocol_name = Typename.TN_csu (Csu.Protocol, mang_name) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Typ.Tvar protocol_name); - let def_methods = ObjcProperty_decl.get_methods curr_class decl_list in - let protocol_type_info = Typ.{ - instance_fields = []; - static_fields = []; - name = protocol_name; - superclasses = []; - def_methods; - struct_annotations = []; - } in + let methods = ObjcProperty_decl.get_methods curr_class decl_list in + let protocol_type_info = Typ.mk_struct ~methods protocol_name in Tenv.add tenv protocol_name protocol_type_info; add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info; Typ.Tvar protocol_name diff --git a/infer/src/clang/printing.ml b/infer/src/clang/printing.ml index e509ce06e..2a94fe92c 100644 --- a/infer/src/clang/printing.ml +++ b/infer/src/clang/printing.ml @@ -41,13 +41,13 @@ let print_tenv tenv = | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) -> print_endline ( (Typename.to_string typname) ^ " " ^ - (Typ.item_annotation_to_string struct_t.struct_annotations) ^ "\n" ^ + (Typ.item_annotation_to_string struct_t.annots) ^ "\n" ^ "---> superclass and protocols " ^ (IList.to_string (fun tn -> - "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.superclasses) ^ + "\t" ^ (Typename.to_string tn) ^ "\n") struct_t.supers) ^ "---> methods " ^ - (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.def_methods) + (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") struct_t.methods) ^ " " ^ - "\t---> fields " ^ (IList.to_string field_to_string struct_t.instance_fields) ^ "\n") + "\t---> fields " ^ (IList.to_string field_to_string struct_t.fields) ^ "\n") | _ -> () ) tenv @@ -62,7 +62,7 @@ let print_tenv_struct_unions tenv = | Typ.Tvar tname -> "tvar"^(Typename.to_string tname) | Typ.Tstruct _ | _ -> "\t struct "^(Ident.fieldname_to_string fieldname)^" "^ - (Typ.to_string typ)^"\n") struct_t.instance_fields + (Typ.to_string typ)^"\n") struct_t.fields ) ) | _ -> () diff --git a/infer/src/eradicate/eradicateChecks.ml b/infer/src/eradicate/eradicateChecks.ml index 149fa963e..a4cb92f50 100644 --- a/infer/src/eradicate/eradicateChecks.ml +++ b/infer/src/eradicate/eradicateChecks.ml @@ -260,7 +260,7 @@ let check_constructor_initialization tenv Option.map (Tenv.expand_ptr_type tenv) (PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc)) with - | Some (Tptr (Tstruct { instance_fields; name } as ts, _)) -> + | Some (Tptr (Tstruct { fields; name } as ts, _)) -> let do_field (fn, ft, _) = let annotated_with f = match get_field_annotation tenv fn ts with | None -> false @@ -331,7 +331,7 @@ let check_constructor_initialization tenv curr_pname; end in - IList.iter do_field instance_fields + IList.iter do_field fields | _ -> () end diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index 88b61ed8a..207b82775 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -87,7 +87,7 @@ let is_android_lib_class class_name = a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs = match Tenv.lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with - | Some ({ name = TN_csu (Class _, _); def_methods } as lifecycle_typ) -> + | Some ({ name = TN_csu (Class _, _); methods } as lifecycle_typ) -> (* TODO (t4645631): collect the procedures for which is_java is returning false *) let lookup_proc lifecycle_proc = IList.find (fun decl_proc -> @@ -96,7 +96,7 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs = lifecycle_proc = Procname.java_get_method decl_proc_java | _ -> false - ) def_methods in + ) methods in (* convert each of the framework lifecycle proc strings to a lifecycle method procname *) let lifecycle_procs = IList.fold_left (fun lifecycle_procs lifecycle_proc_str -> diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index 772a84c77..599d55a8a 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -96,13 +96,13 @@ let rec inhabit_typ tenv typ cfg env = * we are already inhabiting one of their argument types *) let get_all_suitable_constructors typ = match Tenv.expand_type tenv typ with - | Typ.Tstruct { name = TN_csu (Class _, _); def_methods } -> + | Typ.Tstruct { name = TN_csu (Class _, _); methods } -> let is_suitable_constructor p = let try_get_non_receiver_formals p = get_non_receiver_formals (formals_from_name cfg p) in Procname.is_constructor p && IList.for_all (fun (_, typ) -> not (TypSet.mem typ env.cur_inhabiting)) (try_get_non_receiver_formals p) in - IList.filter (fun p -> is_suitable_constructor p) def_methods + IList.filter (fun p -> is_suitable_constructor p) methods | _ -> [] in let (env, typ_class_name) = match get_all_suitable_constructors typ with | constructor :: _ -> diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index b545b6e4e..61d9d1848 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -108,12 +108,12 @@ let retrieve_fieldname fieldname = let get_field_name program static tenv cn fs = match Tenv.expand_type tenv (JTransType.get_class_type_no_pointer program tenv cn) with - | Typ.Tstruct { Typ.instance_fields; static_fields; name = TN_csu (Class _, _) } -> + | Tstruct { fields; statics; name = TN_csu (Class _, _) } -> let fieldname, _, _ = try IList.find (fun (fieldname, _, _) -> retrieve_fieldname fieldname = JBasics.fs_name fs) - (if static then static_fields else instance_fields) + (if static then statics else fields) with Not_found -> (* TODO: understand why fields cannot be found here *) JUtils.log "cannot find %s.%s@." (JBasics.cn_name cn) (JBasics.fs_name fs); diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 1abb12743..f87d9ce18 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -217,12 +217,12 @@ let create_sil_class_field cn cf = (** Collect static field if static is true, otherwise non-static ones. *) -let collect_class_field cn cf (static_fields, nonstatic_fields) = +let collect_class_field cn cf (statics, nonstatics) = let field = create_sil_class_field cn cf in if Javalib.is_static_field (Javalib.ClassField cf) then - (field :: static_fields, nonstatic_fields) + (field :: statics, nonstatics) else - (static_fields, field :: nonstatic_fields) + (statics, field :: nonstatics) (** Collect an interface field. *) @@ -234,17 +234,6 @@ let collect_interface_field cn inf l = (field_name, field_type, annotation) :: l -let dummy_type cn = - Typ.Tstruct { - Typ.instance_fields = []; - static_fields = []; - name = Typename.Java.from_string (JBasics.cn_name cn); - superclasses = []; - def_methods = []; - struct_annotations = Typ.item_annotation_empty; - } - - let collect_models_class_fields classpath_field_map cn cf fields = let static, nonstatic = fields in let field_name, field_type, annotation = create_sil_class_field cn cf in @@ -265,12 +254,12 @@ let collect_models_class_fields classpath_field_map cn cf fields = let add_model_fields program classpath_fields cn = - let static_fields, nonstatic_fields = classpath_fields in + let statics, nonstatics = classpath_fields in let classpath_field_map = let collect_fields map = IList.fold_left (fun map (fn, ft, _) -> Ident.FieldMap.add fn ft map) map in - collect_fields (collect_fields Ident.FieldMap.empty static_fields) nonstatic_fields in + collect_fields (collect_fields Ident.FieldMap.empty statics) nonstatics in try match JBasics.ClassMap.find cn (JClasspath.get_models program) with | Javalib.JClass _ as jclass -> @@ -286,10 +275,10 @@ let add_model_fields program classpath_fields cn = let rec get_all_fields program tenv cn = let extract_class_fields classname = match get_class_type_no_pointer program tenv classname with - | Typ.Tstruct { Typ.instance_fields; static_fields } -> (static_fields, instance_fields) + | Typ.Tstruct { fields; statics } -> (statics, fields) | Typ.Tvar name -> ( match Tenv.lookup tenv name with - | Some { instance_fields; static_fields } -> (static_fields, instance_fields) + | Some { fields; statics } -> (statics, fields) | None -> assert false ) | _ -> assert false in @@ -311,20 +300,21 @@ let rec get_all_fields program tenv cn = and create_sil_type program tenv cn = match JClasspath.lookup_node cn program with - | None -> dummy_type cn + | None -> + Typ.Tstruct (Typ.mk_struct (Typename.Java.from_string (JBasics.cn_name cn))) | Some node -> let create_super_list interface_names = IList.iter (fun cn -> ignore (get_class_type_no_pointer program tenv cn)) interface_names; IList.map typename_of_classname interface_names in - let superclasses, instance_fields, static_fields, struct_annotations = + let supers, fields, statics, annots = match node with | Javalib.JInterface jinterface -> - let static_fields, _ = get_all_fields program tenv cn in + let statics, _ = get_all_fields program tenv cn in let sil_interface_list = create_super_list jinterface.Javalib.i_interfaces in let item_annotation = JAnnotation.translate_item jinterface.Javalib.i_annotations in - (sil_interface_list, [], static_fields, item_annotation) + (sil_interface_list, [], statics, item_annotation) | Javalib.JClass jclass -> - let static_fields, nonstatic_fields = + let statics, nonstatics = let classpath_static, classpath_nonstatic = get_all_fields program tenv cn in add_model_fields program (classpath_static, classpath_nonstatic) cn in let item_annotation = JAnnotation.translate_item jclass.Javalib.c_annotations in @@ -339,16 +329,11 @@ and create_sil_type program tenv cn = | Typ.Tstruct { name } -> name | _ -> assert false in super_classname :: interface_list in - (super_classname_list, nonstatic_fields, static_fields, item_annotation) in - let def_methods = IList.map (fun j -> Procname.Java j) (get_class_procnames cn node) in - Typ.Tstruct { - Typ.instance_fields; - static_fields; - name = Typename.Java.from_string (JBasics.cn_name cn); - superclasses; - def_methods; - struct_annotations; - } + (super_classname_list, nonstatics, statics, item_annotation) in + let methods = IList.map (fun j -> Procname.Java j) (get_class_procnames cn node) in + Typ.Tstruct + (Typ.mk_struct ~fields ~statics ~methods ~supers ~annots + (Typename.Java.from_string (JBasics.cn_name cn))) and get_class_type_no_pointer program tenv cn = let named_type = typename_of_classname cn in