diff --git a/infer/src/clang/CType_decl.ml b/infer/src/clang/CType_decl.ml index 05781370e..a305095b8 100644 --- a/infer/src/clang/CType_decl.ml +++ b/infer/src/clang/CType_decl.ml @@ -256,6 +256,6 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info = | _ -> expr_info.Clang_ast_t.ei_type_ptr in type_ptr_to_sil_type tenv tp -let get_type_curr_class_objc curr_class_opt = - let name = CContext.get_curr_class_name curr_class_opt in +let get_type_curr_class_objc curr_class = + let name = CContext.get_curr_class_name curr_class in Typ.Tstruct (TN_csu (Class Objc, (Mangled.from_string name))) diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index 65f22657a..7ab543448 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -17,17 +17,7 @@ module L = Logging type pointer (* = Clang_ast_t.pointer *) = int [@@deriving compare] -type _super = string option -let compare__super _ _ = 0 - -type _protos = string list -let compare__protos _ _ = 0 - type curr_class = - | ContextCls of string * _super * _protos - (*class name and name of (optional) super class , and a list of protocols *) - | ContextCategory of string * string (* category name and corresponding class *) - | ContextProtocol of string (* category name and corresponding class *) | ContextClsDeclPtr of pointer | ContextNoCls [@@deriving compare] @@ -86,40 +76,35 @@ let rec get_curr_class context = get_curr_class outer_context | _ -> context.curr_class -let get_curr_class_name curr_class = - match curr_class with - | ContextCls (name, _, _) -> name - | ContextCategory (_, cls) -> cls - | ContextProtocol name -> name - | ContextClsDeclPtr _ -> assert false - | ContextNoCls -> assert false - let get_curr_class_decl_ptr curr_class = match curr_class with | ContextClsDeclPtr ptr -> ptr | _ -> assert false +let get_curr_class_name curr_class = + let decl_ptr = get_curr_class_decl_ptr curr_class in + let get_ptr_from_decl_ref = function + | Some dr -> dr.Clang_ast_t.dr_decl_pointer + | None -> assert false in + (* Resolve categories to their class names *) + let class_decl_ptr = match CAst_utils.get_decl decl_ptr with + | Some ObjCCategoryDecl (_, _, _, _, ocdi) -> + get_ptr_from_decl_ref ocdi.odi_class_interface + | Some ObjCCategoryImplDecl (_, _, _, _, ocidi) -> + get_ptr_from_decl_ref ocidi.ocidi_class_interface + | _ -> decl_ptr in + let _, name_info = match Option.bind + (CAst_utils.get_decl class_decl_ptr) + Clang_ast_proj.get_named_decl_tuple with + | Some result -> result + | None -> assert false in + CAst_utils.get_qualified_name name_info + let curr_class_to_string curr_class = match curr_class with - | ContextCls (name, superclass, protocols) -> - ("class " ^ name ^ ", superclass: " ^ (Option.value ~default:"" superclass) ^ - ", protocols: " ^ (IList.to_string (fun x -> x) protocols)) - | ContextCategory (name, cls) -> ("category " ^ name ^ " of class " ^ cls) - | ContextProtocol name -> ("protocol " ^ name) | ContextClsDeclPtr ptr -> ("decl_ptr: " ^ string_of_int ptr) | ContextNoCls -> "no 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 Tenv.lookup tenv class_tn_name with - | Some { supers } -> - (let supers_names = List.map ~f:Typename.name supers in - match supers_names with - | superclass:: protocols -> - ContextCls (class_name, Some superclass, protocols) - | [] -> ContextCls (class_name, None, [])) - | _ -> assert false - let add_block_static_var context block_name static_var_typ = match context.outer_context, static_var_typ with | Some outer_context, (static_var, _) when Pvar.is_global static_var -> diff --git a/infer/src/clang/cContext.mli b/infer/src/clang/cContext.mli index 7aaf0b789..4d9ae2d3b 100644 --- a/infer/src/clang/cContext.mli +++ b/infer/src/clang/cContext.mli @@ -13,10 +13,6 @@ open! IStd (** and the cg, cfg, and tenv corresponding to the current file. *) type curr_class = - | ContextCls of string * string option * string list - (*class name and name of (optional) super class , and a list of protocols *) - | ContextCategory of string * string (* category name and corresponding class *) - | ContextProtocol of string (* category name and corresponding class *) | ContextClsDeclPtr of int | ContextNoCls [@@deriving compare] @@ -62,8 +58,6 @@ val get_tenv : t -> Tenv.t val create_context : CFrontend_config.translation_unit_context -> Tenv.t -> Cg.t -> Cfg.cfg -> Procdesc.t -> curr_class -> Typ.t option -> bool -> t option -> t -val create_curr_class : Tenv.t -> string -> Csu.class_kind -> curr_class - val add_block_static_var : t -> Procname.t -> (Pvar.t * Typ.t) -> unit val static_vars_for_block : t -> Procname.t -> (Pvar.t * Typ.t) list diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index d56303c2e..40acf8d29 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -54,10 +54,10 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute fname, typ, item_annotations (* Given a list of declarations in an interface returns a list of fields *) -let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = +let rec get_fields type_ptr_to_sil_type tenv decl_list = let open Clang_ast_t in let add_field name_info qt attributes decl_list' = - let fields = get_fields type_ptr_to_sil_type tenv curr_class decl_list' in + let fields = get_fields type_ptr_to_sil_type tenv decl_list' in let field_tuple = build_sil_field type_ptr_to_sil_type tenv name_info qt.Clang_ast_t.qt_type_ptr attributes in CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in @@ -69,11 +69,11 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = | Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) -> let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in add_field name_info type_ptr attributes decl_list' - | _ -> get_fields type_ptr_to_sil_type tenv curr_class decl_list') + | _ -> get_fields type_ptr_to_sil_type tenv decl_list') | ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' -> add_field name_info type_ptr [] decl_list' | _ :: decl_list' -> - get_fields type_ptr_to_sil_type tenv curr_class decl_list' + get_fields type_ptr_to_sil_type tenv 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. *) diff --git a/infer/src/clang/cField_decl.mli b/infer/src/clang/cField_decl.mli index 366215f15..d16495fac 100644 --- a/infer/src/clang/cField_decl.mli +++ b/infer/src/clang/cField_decl.mli @@ -13,8 +13,8 @@ open! IStd type field_type = Ident.fieldname * Typ.t * (Annot.t * bool) list -val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> CContext.curr_class -> - Clang_ast_t.decl list -> field_type list +val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl list -> + field_type list val fields_superclass : Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> Csu.class_kind -> field_type list diff --git a/infer/src/clang/cFrontend_decl.ml b/infer/src/clang/cFrontend_decl.ml index ad19871b9..f7795d8b5 100644 --- a/infer/src/clang/cFrontend_decl.ml +++ b/infer/src/clang/cFrontend_decl.ml @@ -171,38 +171,35 @@ struct Ident.NameGenerator.reset (); let translate = translate_one_declaration trans_unit_ctx tenv cg cfg decl_trans_context in (if should_translate_decl trans_unit_ctx dec decl_trans_context then + let dec_ptr = (Clang_ast_proj.get_decl_tuple dec).di_pointer in match dec with | FunctionDecl(_, _, _, _) -> function_decl trans_unit_ctx tenv cfg cg dec None - | ObjCInterfaceDecl(_, name_info, decl_list, _, oi_decl_info) -> - let name = CAst_utils.get_qualified_name name_info in - let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in + | ObjCInterfaceDecl(_, _, decl_list, _, _) -> + let curr_class = CContext.ContextClsDeclPtr dec_ptr in ignore (ObjcInterface_decl.interface_declaration CType_decl.type_ptr_to_sil_type tenv dec); process_methods trans_unit_ctx tenv cg cfg curr_class decl_list - | ObjCProtocolDecl(_, name_info, decl_list, _, _) -> - let name = CAst_utils.get_qualified_name name_info in - let curr_class = CContext.ContextProtocol name in + | ObjCProtocolDecl(_, _, decl_list, _, _) -> + let curr_class = CContext.ContextClsDeclPtr dec_ptr in ignore (ObjcProtocol_decl.protocol_decl CType_decl.type_ptr_to_sil_type tenv dec); process_methods trans_unit_ctx tenv cg cfg curr_class decl_list - | ObjCCategoryDecl(_, name_info, decl_list, _, ocdi) -> - let name = CAst_utils.get_qualified_name name_info in - let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in + | ObjCCategoryDecl(_, _, decl_list, _, _) -> + let curr_class = CContext.ContextClsDeclPtr dec_ptr in ignore (ObjcCategory_decl.category_decl CType_decl.type_ptr_to_sil_type tenv dec); process_methods trans_unit_ctx tenv cg cfg curr_class decl_list - | ObjCCategoryImplDecl(_, name_info, decl_list, _, ocidi) -> - let name = CAst_utils.get_qualified_name name_info in - let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in + | ObjCCategoryImplDecl(_, _, decl_list, _, _) -> + let curr_class = CContext.ContextClsDeclPtr dec_ptr in ignore (ObjcCategory_decl.category_impl_decl CType_decl.type_ptr_to_sil_type tenv dec); process_methods trans_unit_ctx tenv cg cfg curr_class decl_list; - | ObjCImplementationDecl(decl_info, _, decl_list, _, idi) -> - let curr_class = ObjcInterface_decl.get_curr_class_impl idi in - let class_name = CContext.get_curr_class_name curr_class in + | ObjCImplementationDecl(decl_info, name_info, decl_list, _, _) -> + let curr_class = CContext.ContextClsDeclPtr dec_ptr in + let class_name = CAst_utils.get_qualified_name name_info in let type_ptr_to_sil_type = CType_decl.type_ptr_to_sil_type in ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec); CMethod_trans.add_default_method_for_class trans_unit_ctx class_name decl_info; diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index e636961d2..48a592a05 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -227,25 +227,31 @@ let get_method_name_from_clang tenv ms_opt = | None -> None let get_superclass_curr_class_objc context = - let retrive_super cname super_opt = - let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in - Logging.out_debug "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname); - match Tenv.lookup (CContext.get_tenv context) iname with - | Some { supers = super_name :: _ } -> - Typename.name super_name - | _ -> - Logging.err_debug "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); - (match super_opt with - | Some super -> super - | _ -> assert false) in + let open Clang_ast_t in + let super_of_decl_ref_opt decl_ref = + match decl_ref + |> Option.value_map ~f:(fun dr -> dr.dr_name) ~default:None + |> Option.map ~f:CAst_utils.get_qualified_name with + | Some name -> name + | None -> assert false + in + let retreive_super_name ptr = match CAst_utils.get_decl ptr with + | Some ObjCInterfaceDecl (_, _, _, _, otdi) -> super_of_decl_ref_opt otdi.otdi_super + | Some ObjCImplementationDecl (_, _, _, _, oi) -> ( + match oi.Clang_ast_t.oidi_class_interface + |> Option.map ~f:(fun dr -> dr.dr_decl_pointer) + |> Option.value_map ~f:CAst_utils.get_decl ~default:None with + | Some ObjCInterfaceDecl (_, _, _, _, otdi) -> super_of_decl_ref_opt otdi.otdi_super + | _ -> assert false + ) + | Some ObjCCategoryDecl (_, _, _, _, ocdi) -> + super_of_decl_ref_opt ocdi.odi_class_interface + | Some ObjCCategoryImplDecl (_, _, _, _, ocidi) -> + super_of_decl_ref_opt ocidi.ocidi_class_interface + | _ -> assert false in match CContext.get_curr_class context with - | CContext.ContextCls (cname, super_opt, _) -> - retrive_super cname super_opt - | CContext.ContextCategory (_, cls) -> - retrive_super cls None - | CContext.ContextNoCls - | CContext.ContextClsDeclPtr _ - | CContext.ContextProtocol _ -> assert false + | CContext.ContextClsDeclPtr ptr -> retreive_super_name ptr + | CContext.ContextNoCls -> assert false (* Gets the class name from a method signature found by clang, if search is successful *) let get_class_name_method_call_from_clang trans_unit_ctx tenv obj_c_message_expr_info = diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index cf66493e2..9b4b74257 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -23,18 +23,16 @@ let cat_class_decl dr = | Some n -> CAst_utils.get_qualified_name n | _ -> assert false -let get_curr_class_from_category name decl_ref_opt = +let get_classname decl_ref_opt = match decl_ref_opt with - | Some dr -> - let class_name = cat_class_decl dr in - CContext.ContextCategory (name, class_name) + | Some dr -> cat_class_decl dr | _ -> assert false -let get_curr_class_from_category_decl name ocdi = - get_curr_class_from_category name ocdi.Clang_ast_t.odi_class_interface +let get_classname_from_category_decl ocdi = + get_classname ocdi.Clang_ast_t.odi_class_interface -let get_curr_class_from_category_impl name ocidi = - get_curr_class_from_category name ocidi.Clang_ast_t.ocidi_class_interface +let get_classname_from_category_impl ocidi = + get_classname ocidi.Clang_ast_t.ocidi_class_interface let add_category_decl type_ptr_to_sil_type tenv category_impl_info = let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in @@ -67,9 +65,8 @@ 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 decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in - let class_name = CContext.get_curr_class_name curr_class in +let process_category type_ptr_to_sil_type tenv class_name decl_info decl_list = + let decl_fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list 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 @@ -89,10 +86,10 @@ let category_decl type_ptr_to_sil_type tenv decl = match decl with | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) -> let name = CAst_utils.get_qualified_name name_info in - let curr_class = get_curr_class_from_category_decl name cdi in + let class_name = get_classname_from_category_decl cdi in Logging.out_debug "ADDING: ObjCCategoryDecl for '%s'\n" name; let _ = add_class_decl type_ptr_to_sil_type tenv cdi in - let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in + let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in let _ = add_category_implementation type_ptr_to_sil_type tenv cdi in typ | _ -> assert false @@ -102,9 +99,9 @@ let category_impl_decl type_ptr_to_sil_type tenv decl = match decl with | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) -> let name = CAst_utils.get_qualified_name name_info in - let curr_class = get_curr_class_from_category_impl name cii in + let class_name = get_classname_from_category_impl cii in Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%s'\n" name; let _ = add_category_decl type_ptr_to_sil_type tenv cii in - let typ = process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list in + let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in typ | _ -> assert false diff --git a/infer/src/clang/objcCategory_decl.mli b/infer/src/clang/objcCategory_decl.mli index 6b5b74ee4..05d2ef4fe 100644 --- a/infer/src/clang/objcCategory_decl.mli +++ b/infer/src/clang/objcCategory_decl.mli @@ -18,10 +18,4 @@ val category_impl_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_ val noname_category : string -> string -val get_curr_class_from_category_decl : string -> Clang_ast_t.obj_c_category_decl_info -> - CContext.curr_class - -val get_curr_class_from_category_impl : string -> Clang_ast_t.obj_c_category_impl_decl_info -> - CContext.curr_class - val get_base_class_name_from_category : Clang_ast_t.decl -> string option diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index daa540e76..1257d9206 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -36,22 +36,6 @@ let get_protocols protocols = ) protocols in protocol_names -let get_curr_class class_name ocdi = - let super = get_super_interface_decl ocdi.Clang_ast_t.otdi_super in - let protocols = get_protocols ocdi.Clang_ast_t.otdi_protocols in - CContext.ContextCls (class_name, super, protocols) - -let get_curr_class_impl oi = - let open Clang_ast_t in - match oi.Clang_ast_t.oidi_class_interface with - | Some decl_ref -> - (match CAst_utils.get_decl decl_ref.Clang_ast_t.dr_decl_pointer with - | Some ObjCInterfaceDecl (_, name_info, _, _, obj_c_interface_decl_info) -> - let class_name = CAst_utils.get_qualified_name name_info in - get_curr_class class_name obj_c_interface_decl_info - | _ -> assert false) - | _ -> assert false - let add_class_decl type_ptr_to_sil_type tenv idi = let decl_ref_opt = idi.Clang_ast_t.oidi_class_interface in CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true @@ -83,23 +67,23 @@ let get_interface_supers super_opt protocols = let super_classes = super_class@protocol_names in super_classes -let create_supers_fields type_ptr_to_sil_type tenv curr_class decl_list +let create_supers_fields type_ptr_to_sil_type tenv decl_list otdi_super otdi_protocols = let super = get_super_interface_decl otdi_super in let protocols = get_protocols otdi_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 + let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in 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 = +let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list ocidi = let class_name = CAst_utils.get_qualified_name name_info in Logging.out_debug "ADDING: ObjCInterfaceDecl for '%s'\n" class_name; let interface_name = CType.mk_classname class_name Csu.Objc in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in CAst_utils.update_sil_types_map decl_key (Typ.Tstruct interface_name); let decl_supers, decl_fields = - create_supers_fields type_ptr_to_sil_type tenv curr_class decl_list + create_supers_fields type_ptr_to_sil_type tenv decl_list ocidi.Clang_ast_t.otdi_super ocidi.Clang_ast_t.otdi_protocols in let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in @@ -138,9 +122,7 @@ let interface_declaration type_ptr_to_sil_type tenv decl = let open Clang_ast_t in match decl with | ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) -> - let name = CAst_utils.get_qualified_name name_info in - let curr_class = get_curr_class name ocidi in - let typ = add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info + let typ = add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list ocidi in let _ = add_class_implementation type_ptr_to_sil_type tenv ocidi in let _ = add_super_class_decl type_ptr_to_sil_type tenv ocidi in @@ -158,8 +140,7 @@ let interface_impl_declaration type_ptr_to_sil_type tenv decl = let class_name = CAst_utils.get_qualified_name name_info in Logging.out_debug "ADDING: ObjCImplementationDecl for class '%s'\n" class_name; let _ = add_class_decl type_ptr_to_sil_type tenv idi in - let curr_class = get_curr_class_impl idi in - let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in + let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in CField_decl.add_missing_fields tenv class_name Csu.Objc fields; let class_tn_name = Typename.TN_csu (Csu.Class Csu.Objc, (Mangled.from_string class_name)) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in diff --git a/infer/src/clang/objcInterface_decl.mli b/infer/src/clang/objcInterface_decl.mli index afb9c6c7d..fb23441d8 100644 --- a/infer/src/clang/objcInterface_decl.mli +++ b/infer/src/clang/objcInterface_decl.mli @@ -19,7 +19,3 @@ val interface_impl_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Cl Typ.t val is_pointer_to_objc_class : Typ.t -> bool - -val get_curr_class : string -> Clang_ast_t.obj_c_interface_decl_info -> CContext.curr_class - -val get_curr_class_impl : Clang_ast_t.obj_c_implementation_decl_info -> CContext.curr_class