From 2d894261708ae31dab08582caadfac0224b0326b Mon Sep 17 00:00:00 2001 From: Sam Blackshear Date: Tue, 1 Mar 2016 12:07:25 -0800 Subject: [PATCH] fixing tenv_lookup Reviewed By: cristianoc Differential Revision: D2991693 fb-gh-sync-id: 3139630 shipit-source-id: 3139630 --- infer/src/backend/abs.ml | 2 +- infer/src/backend/prop.ml | 14 +-------- infer/src/backend/prover.ml | 8 ++--- infer/src/backend/sil.ml | 4 +-- infer/src/backend/sil.mli | 2 +- infer/src/backend/symExec.ml | 28 ++---------------- infer/src/checkers/callbackChecker.ml | 3 +- .../checkers/fragmentRetainsViewChecker.ml | 8 ++--- infer/src/checkers/patternMatch.ml | 9 +++--- infer/src/checkers/performanceCritical.ml | 3 +- infer/src/clang/cContext.ml | 2 +- infer/src/clang/cField_decl.ml | 7 ++--- infer/src/clang/cFrontend_checkers.ml | 2 +- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/clang/cTrans.ml | 7 +---- infer/src/clang/cTypes.ml | 3 +- infer/src/clang/cTypes_decl.ml | 2 +- infer/src/clang/objcCategory_decl.ml | 4 +-- infer/src/clang/objcInterface_decl.ml | 29 ++++++++++--------- infer/src/harness/androidFramework.ml | 13 +++++---- infer/src/java/jTransType.ml | 18 +++++------- 21 files changed, 65 insertions(+), 105 deletions(-) diff --git a/infer/src/backend/abs.ml b/infer/src/backend/abs.ml index 68c029b80..54cc649d6 100644 --- a/infer/src/backend/abs.ml +++ b/infer/src/backend/abs.ml @@ -412,7 +412,7 @@ let typ_get_recursive_flds tenv typ_exp = | None -> L.err "@.typ_get_recursive: Undefined type %s@." (Typename.to_string tname'); t - | Some typ' -> typ' in + | Some st -> Sil.Tstruct st in Sil.typ_equal typ' typ | Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ -> false diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index da1fd92ed..f381e9022 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -1106,19 +1106,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ inst = end | Sil.Tarray (_, size) -> Sil.Earray (size, [], inst) - | Sil.Tvar name -> - L.out "@[<2>ANALYSIS BUG@\n"; - L.out "type %a should be expanded to " (Sil.pp_typ_full pe_text) typ; - begin - match tenvo with - | None -> L.out "nothing@\n@." - | Some tenv -> - begin - match Sil.tenv_lookup tenv name with - | None -> L.out "nothing@\n@." - | Some typ' -> L.out "%a@\n@." (Sil.pp_typ_full pe_text) typ' - end; - end; + | Sil.Tvar _ -> assert false (** Sil.Construct a pointsto. *) diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 8b554549a..1f3a72c36 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -1454,7 +1454,7 @@ struct let is_interface tenv class_name = match Sil.tenv_lookup tenv class_name with - | Some (Sil.Tstruct ( { Sil.csu = Csu.Class Csu.Java; struct_name = Some _ } as struct_typ )) -> + | Some ({ Sil.csu = Csu.Class Csu.Java; struct_name = Some _ } as struct_typ) -> (IList.length struct_typ.Sil.instance_fields = 0) && (IList.length struct_typ.Sil.def_methods = 0) | _ -> false @@ -1472,7 +1472,7 @@ struct let rec check cn = Typename.equal cn c2 || is_root_class c2 || match Sil.tenv_lookup tenv cn with - | Some (Sil.Tstruct { Sil.struct_name = Some _; csu = Csu.Class _; superclasses }) -> + | Some ({ Sil.struct_name = Some _; csu = Csu.Class _; superclasses }) -> IList.exists check superclasses | _ -> false in check c1 @@ -1944,7 +1944,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let typ = match Sil.tenv_lookup tenv object_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (typ, Sil.Subtype.exact) in + Sil.Sizeof (Sil.Tstruct typ, Sil.Subtype.exact) in Sil.Hpointsto (root, sexp, const_string_texp) in let mk_constant_class_hpred s = (* creat an hpred from a constant class *) let root = Sil.Const (Sil.Cclass (Ident.string_to_name s)) in @@ -1956,7 +1956,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let typ = match Sil.tenv_lookup tenv class_type with | Some typ -> typ | None -> assert false in - Sil.Sizeof (typ, Sil.Subtype.exact) in + Sil.Sizeof (Sil.Tstruct typ, Sil.Subtype.exact) in Sil.Hpointsto (root, sexp, class_texp) in try (match move_primed_lhs_from_front subs sigma2 with diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index 0f8a6b2e0..ce5bf961f 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -3770,7 +3770,7 @@ let tenv_mem tenv name = (** Look up a name in the global type environment. *) let tenv_lookup tenv name = - try Some (Tstruct (TypenameHash.find tenv name)) + try Some (TypenameHash.find tenv name) with Not_found -> None (** Add a (name,type) pair to the global type environment. *) @@ -3784,7 +3784,7 @@ let expand_type tenv typ = begin match tenv_lookup tenv tname with | None -> assert false - | Some typ' -> typ' + | Some struct_typ -> Tstruct struct_typ end | _ -> typ diff --git a/infer/src/backend/sil.mli b/infer/src/backend/sil.mli index b920e8d3f..2fe11a0ee 100644 --- a/infer/src/backend/sil.mli +++ b/infer/src/backend/sil.mli @@ -522,7 +522,7 @@ val create_tenv : unit -> tenv val tenv_mem : tenv -> Typename.t -> bool (** Look up a name in the global type environment. *) -val tenv_lookup : tenv -> Typename.t -> typ option +val tenv_lookup : tenv -> Typename.t -> struct_typ option (** Add a (name,typ) pair to the global type environment. *) val tenv_add : tenv -> Typename.t -> struct_typ -> unit diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index f2cbfddeb..abec1a31c 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -547,7 +547,7 @@ let resolve_method tenv class_name proc_name = Procname.java_replace_class proc_name (Typename.name class_name) else Procname.c_method_replace_class proc_name (Typename.name class_name) in match Sil.tenv_lookup tenv class_name with - | Some (Sil.Tstruct { Sil.csu = Csu.Class _; def_methods; superclasses }) -> + | Some { Sil.csu = Csu.Class _; def_methods; superclasses } -> if method_exists right_proc_name def_methods then Some right_proc_name else @@ -601,7 +601,7 @@ let lookup_java_typ_from_string tenv typ_str = (* non-primitive/non-array type--resolve it in the tenv *) let typename = Typename.TN_csu (Csu.Class Csu.Java, (Mangled.from_string typ_str)) in match Sil.tenv_lookup tenv typename with - | Some (Sil.Tstruct _ as typ) -> typ + | Some struct_typ -> Sil.Tstruct struct_typ | _ -> raise (Cannot_convert_string_to_typ typ_str) in loop typ_str @@ -772,30 +772,6 @@ let redirect_shared_ptr tenv cfg pname actual_params = pname' else pname -(** Lookup Java types by name *) -let lookup_java_typ_from_string tenv typ_str = - let rec loop = function - | "" | "void" -> Sil.Tvoid - | "int" -> Sil.Tint Sil.IInt - | "byte" -> Sil.Tint Sil.IShort - | "short" -> Sil.Tint Sil.IShort - | "boolean" -> Sil.Tint Sil.IBool - | "char" -> Sil.Tint Sil.IChar - | "long" -> Sil.Tint Sil.ILong - | "float" -> Sil.Tfloat Sil.FFloat - | "double" -> Sil.Tfloat Sil.FDouble - | typ_str when String.contains typ_str '[' -> - let stripped_typ = String.sub typ_str 0 ((String.length typ_str) - 2) in - let array_typ_size = Sil.exp_get_undefined false in - Sil.Tptr (Sil.Tarray (loop stripped_typ, array_typ_size), Sil.Pk_pointer) - | typ_str -> - (* non-primitive/non-array type--resolve it in the tenv *) - let typename = Typename.TN_csu (Csu.Class Csu.Java, (Mangled.from_string typ_str)) in - match Sil.tenv_lookup tenv typename with - | Some (Sil.Tstruct _ as typ) -> typ - | _ -> failwith ("Failed to look up typ " ^ typ_str) in - loop typ_str - (** recognize calls to the constructor java.net.URL and splits the argument string to be only the protocol. *) let call_constructor_url_update_args pname actual_params = diff --git a/infer/src/checkers/callbackChecker.ml b/infer/src/checkers/callbackChecker.ml index 89ff95416..7817603cc 100644 --- a/infer/src/checkers/callbackChecker.ml +++ b/infer/src/checkers/callbackChecker.ml @@ -67,7 +67,8 @@ 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 { struct_name = Some _; def_methods } as typ) -> + | Some ({ struct_name = Some _; def_methods } as struct_typ) -> + let typ = Sil.Tstruct struct_typ in 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) diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index 9e517b319..19cf9327c 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -27,7 +27,7 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } = | Sil.Tptr (Sil.Tvar tname, _) -> begin match Sil.tenv_lookup tenv tname with - | Some typ -> AndroidFramework.is_view typ tenv + | Some struct_typ -> AndroidFramework.is_view (Sil.Tstruct struct_typ) tenv | None -> false end | _ -> false in @@ -39,8 +39,8 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } = begin let class_typename = Typename.Java.from_string (Procname.java_get_class proc_name) in match Sil.tenv_lookup tenv class_typename with - | Some (Sil.Tstruct { Sil.struct_name = Some _; instance_fields } - as typ) when AndroidFramework.is_fragment typ tenv -> + | Some ({ Sil.struct_name = Some _; instance_fields } as struct_typ) + when AndroidFramework.is_fragment (Sil.Tstruct struct_typ) tenv -> let declared_view_fields = IList.filter (is_declared_view_typ class_typename) instance_fields in let fields_nullified = PatternMatch.get_fields_nullified proc_desc in @@ -48,7 +48,7 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } = IList.iter (fun (fname, fld_typ, _) -> if not (Ident.FieldSet.mem fname fields_nullified) then - report_error typ fname fld_typ proc_name proc_desc) + report_error (Sil.Tstruct struct_typ) fname fld_typ proc_name proc_desc) declared_view_fields | _ -> () end diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 16346e4c0..aacfb6090 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -79,7 +79,8 @@ let type_has_supertype let match_name () = Typename.equal cn class_name in let has_indirect_supertype () = match Sil.tenv_lookup tenv cn with - | Some supertype -> has_supertype supertype (Sil.TypSet.add typ visited) + | Some supertype -> + has_supertype (Sil.Tstruct supertype) (Sil.TypSet.add typ visited) | None -> false in (match_name () || has_indirect_supertype ()) in IList.exists match_supertype superclasses @@ -305,7 +306,7 @@ let proc_iter_overridden_methods f tenv proc_name = let super_proc_name = Procname.java_replace_class proc_name (Typename.name super_class_name) in match Sil.tenv_lookup tenv super_class_name with - | Some (Sil.Tstruct { Sil.def_methods }) -> + | Some ({ Sil.def_methods }) -> let is_override pname = Procname.equal pname super_proc_name && not (Procname.is_constructor pname) in @@ -321,8 +322,8 @@ let proc_iter_overridden_methods f tenv proc_name = let class_name = Procname.java_get_class proc_name in Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string class_name) in match Sil.tenv_lookup tenv type_name with - | Some curr_type -> - IList.iter (do_super_type tenv) (type_get_direct_supertypes curr_type) + | Some curr_struct_typ -> + IList.iter (do_super_type tenv) (type_get_direct_supertypes (Sil.Tstruct curr_struct_typ)) | None -> () (** return the set of instance fields that are assigned to a null literal in [procdesc] *) diff --git a/infer/src/checkers/performanceCritical.ml b/infer/src/checkers/performanceCritical.ml index 3224bb7fc..cc8fd46d3 100644 --- a/infer/src/checkers/performanceCritical.ml +++ b/infer/src/checkers/performanceCritical.ml @@ -87,7 +87,8 @@ let is_modeled_expensive tenv pname = Mangled.from_package_class package (Procname.java_get_simple_class pname) in match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, classname)) with | None -> false - | Some typ -> + | Some struct_typ -> + let typ = Sil.Tstruct struct_typ in AndroidFramework.is_view typ tenv || AndroidFramework.is_activity typ tenv diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 73ddbfd20..f3460d6d2 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -117,7 +117,7 @@ let curr_class_hash curr_class = 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 Sil.tenv_lookup tenv class_tn_name with - | Some Sil.Tstruct { Sil.superclasses } -> + | Some { Sil.superclasses } -> (let superclasses_names = IList.map Typename.name superclasses in match superclasses_names with | superclass:: protocols -> diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index ac0754d46..bb4f4eb38 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -19,11 +19,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 Sil.tenv_lookup tenv super_class with | None -> [] - | Some Sil.Tstruct { Sil.instance_fields; superclasses = super_class :: _ } -> + | Some { Sil.instance_fields; superclasses = super_class :: _ } -> let sc_fields = get_fields_super_classes tenv super_class in General_utils.append_no_duplicates_fields instance_fields sc_fields - | Some Sil.Tstruct { Sil.instance_fields } -> instance_fields - | Some _ -> [] + | Some { Sil.instance_fields } -> instance_fields let fields_superclass tenv interface_decl_info ck = match interface_decl_info.Clang_ast_t.otdi_super with @@ -78,7 +77,7 @@ let add_missing_fields tenv class_name ck fields = let mang_name = Mangled.from_string class_name in let class_tn_name = Typename.TN_csu (Csu.Class ck, mang_name) in match Sil.tenv_lookup tenv class_tn_name with - | Some Sil.Tstruct ({ Sil.instance_fields } as struct_typ) -> + | Some ({ Sil.instance_fields } as struct_typ) -> let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in let class_type_info = { diff --git a/infer/src/clang/cFrontend_checkers.ml b/infer/src/clang/cFrontend_checkers.ml index d36607725..e640e7326 100644 --- a/infer/src/clang/cFrontend_checkers.ml +++ b/infer/src/clang/cFrontend_checkers.ml @@ -69,7 +69,7 @@ let direct_atomic_property_access_warning context stmt_info ivar_name = | _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in let tname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in let condition = match Sil.tenv_lookup tenv tname with - | Some Sil.Tstruct { Sil.instance_fields; static_fields } -> + | Some { Sil.instance_fields; static_fields } -> (* We give the warning when: (1) the property has the atomic attribute and (2) the access of the ivar is not in a getter or setter method. diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index ee520562b..9b7829431 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -228,7 +228,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 Sil.tenv_lookup (CContext.get_tenv context) iname with - | Some Sil.Tstruct { Sil.superclasses = super_name :: _ } -> + | Some { Sil.superclasses = 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 9caed8080..930159988 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -1525,12 +1525,7 @@ struct match typ with | Sil.Tvar tn -> (match Sil.tenv_lookup context.CContext.tenv tn with - | Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str tns - | Some ((Sil.Tvar typename) as tvar) -> - if (StringSet.mem (Typename.to_string typename) tns) then - [[(e, typ)]] - else - collect_left_hand_exprs e tvar (StringSet.add (Typename.to_string typename) tns) + | Some struct_typ -> collect_left_hand_exprs e (Sil.Tstruct struct_typ) 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, _, _) -> diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 7278f24bf..855764c1c 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -86,7 +86,8 @@ let rec expand_structured_type tenv typ = match typ with | Sil.Tvar tn -> (match Sil.tenv_lookup tenv tn with - | Some t -> + | Some ts -> + let t = Sil.Tstruct ts in Printing.log_out " Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t); if Sil.typ_equal t typ then typ diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index 60aa1d4b0..fb76fb246 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -201,7 +201,7 @@ and get_struct_cpp_class_declaration_type tenv decl = sil_type ) else ( match Sil.tenv_lookup tenv sil_typename with - | Some sil_type -> sil_type (* just reuse what is already in tenv *) + | Some struct_typ -> Sil.Tstruct struct_typ (* just reuse what is already in tenv *) | None -> (* This is first forward definition seen so far. Instead of adding *) (* empty Tstruct to sil_types_map add Tvar so that frontend doeasn't expand *) diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index 7c646e043..6ed59747e 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -76,9 +76,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name); (match Sil.tenv_lookup tenv class_tn_name with - | Some Sil.Tstruct - ({ Sil.instance_fields; def_methods } - as struct_typ) -> + | Some ({ Sil.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 = diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index 3b49fc72b..bdf5c00b2 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -22,7 +22,7 @@ let is_pointer_to_objc_class tenv typ = match typ with | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) -> (match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Objc, cname)) with - | Some typ when Sil.is_objc_class typ -> true + | Some struct_typ when Sil.is_objc_class (Sil.Tstruct struct_typ) -> true | _ -> false) | Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true | _ -> false @@ -113,7 +113,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name (*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 = match Sil.tenv_lookup tenv interface_name with - | Some (Sil.Tstruct { Sil.instance_fields; superclasses; def_methods }) -> + | Some ({ Sil.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 @@ -138,7 +138,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name Printing.log_out " >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name); (match Sil.tenv_lookup tenv interface_name with - | Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) + | Some st -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string (Sil.Tstruct st)) | None -> Printing.log_out " >>>NOT Found!!\n"); Sil.Tvar interface_name @@ -147,17 +147,18 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class = 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 (Sil.Tvar class_tn_name); - (match Sil.tenv_lookup tenv class_tn_name with - | Some Sil.Tstruct - ({ Sil.static_fields = []; - csu = Csu.Class _; - struct_name = Some _; - def_methods; - } as struct_typ) -> - let methods = General_utils.append_no_duplicates_methods def_methods methods in - let struct_typ' = { struct_typ with Sil.def_methods = methods; } in - Sil.tenv_add tenv class_tn_name struct_typ' - | _ -> ()); + begin + match Sil.tenv_lookup tenv class_tn_name with + | Some ({ Sil.static_fields = []; + csu = Csu.Class _; + struct_name = Some _; + def_methods; + } as struct_typ) -> + let methods = General_utils.append_no_duplicates_methods def_methods methods in + let struct_typ' = { struct_typ with Sil.def_methods = methods; } in + Sil.tenv_add tenv class_tn_name struct_typ' + | _ -> () + end; Sil.Tvar class_tn_name (* Interface_type_info has the name of instance variables and the name of methods. *) diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index a598e1d3f..127bf378d 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -256,7 +256,9 @@ 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 (TypSet.add typ typs) + | Some struct_typ -> + let typ' = Sil.Tstruct struct_typ in + get_supers_rec typ' (TypSet.add typ' typs) | None -> typs and get_supers_rec typ all_supers = let direct_supers = get_direct_supers typ in @@ -272,7 +274,7 @@ let is_subtype (typ0 : Sil.typ) (typ1 : Sil.typ) tenv = let is_subtype_package_class typ package classname tenv = let classname = Mangled.from_package_class package classname in match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, classname)) with - | Some found_typ -> is_subtype typ found_typ tenv + | Some found_struct_typ -> is_subtype typ (Sil.Tstruct found_struct_typ) tenv | _ -> false let is_context typ tenv = @@ -353,8 +355,7 @@ let get_callbacks_registered_by_proc procdesc tenv = a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv = match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with - | Some (Sil.Tstruct - { Sil.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) -> + | Some ({ Sil.csu = Csu.Class _; struct_name = Some _; def_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 -> @@ -366,7 +367,7 @@ let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv = try (lookup_proc lifecycle_proc_str) :: lifecycle_procs with Not_found -> lifecycle_procs) [] lifecycle_proc_strs in - Some (lifecycle_typ, lifecycle_procs) + Some (Sil.Tstruct lifecycle_typ, lifecycle_procs) | _ -> None (** return the complete list of (package, lifecycle_classname, lifecycle_methods) trios *) @@ -379,7 +380,7 @@ let is_subclass tenv cn1 classname_str = let lookup = Sil.tenv_lookup tenv in match lookup cn1, lookup typename with | Some typ1, Some typ2 -> - is_subtype typ1 typ2 tenv + is_subtype (Sil.Tstruct typ1) (Sil.Tstruct typ2) tenv | _ -> false diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 70e3e90ab..5cc115b8a 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -349,18 +349,16 @@ and create_sil_type program tenv cn = struct_annotations; } - and get_class_type_no_pointer program tenv cn = let named_type = typename_of_classname cn in - let class_type_np = - match Sil.tenv_lookup tenv named_type with - | None -> create_sil_type program tenv cn - | Some t -> t in - match class_type_np with - | Sil.Tstruct struct_typ -> - Sil.tenv_add tenv named_type struct_typ; - class_type_np - | _ -> assert false + match Sil.tenv_lookup tenv named_type with + | None -> + (match create_sil_type program tenv cn with + | (Sil.Tstruct struct_typ) as typ-> + Sil.tenv_add tenv named_type struct_typ; + typ + | _ -> assert false) + | Some struct_typ -> Sil.Tstruct struct_typ let get_class_type program tenv cn = let t = get_class_type_no_pointer program tenv cn in