Translate classes on demand

Summary: public Translate classes and protocols on demand only.
This saves space in the tenv and time. The categories still cannot be translated on demand
because there is no pointer to them from the classes. Andrzej is fixing that.
We had to make cTypes_Decl and the modules for translating classes, protocols and categories mutually
recursive. Moreover, we had to reorder the method for adding classes to the tenv to receive a decl and
return a type.

Reviewed By: ddino

Differential Revision: D2595610

fb-gh-sync-id: ca76068

infer/src/clang/cField_decl.ml

@@ -34,27 +34,14 @@ let fields_superclass tenv interface_decl_info =
        | _ -> [])
   | _ -> []
 
-let get_field_www name_field fl =
-  let rec scan_fields nn ll =
-    match ll with
-    | [] -> []
-    | (n, t, _):: ll' -> Printing.log_out ">>>>>Searching for field '%s'." (Ident.fieldname_to_string n);
-        Printing.log_out " Seen '%s'.\n" nn;
-        if (Ident.fieldname_to_string n) = nn then
-          [(n, t)]
-        else scan_fields nn ll' in
-  CTrans_utils.extract_item_from_singleton (scan_fields name_field fl)
-    "WARNING: In MemberExpr there must be only one type defininf for the struct. Returning (NO_FIELD_NAME, Tvoid)\n"
-    (Ident.create_fieldname (Mangled.from_string "NO_FIELD_NAME") 0, Sil.Tvoid)
-
-let build_sil_field tenv field_name type_ptr prop_atts =
+let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_atts =
   let annotation_from_type t =
     match t with
     | Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak]
     | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
     | _ -> [] in
   let fname = General_utils.mk_class_field_name field_name in
-  let typ = CTypes_decl.type_ptr_to_sil_type tenv type_ptr in
+  let typ = type_ptr_to_sil_type tenv type_ptr in
   let item_annotations = match prop_atts with
     | [] ->
         [({ Sil.class_name = Config.ivar_attributes; Sil.parameters = annotation_from_type typ }, true)]
@@ -78,25 +65,26 @@ let ivar_property curr_class ivar =
   | None -> Printing.log_out "No property found for ivar '%s'@." ivar.Clang_ast_t.ni_name;
       []
 
-let build_sil_field_property curr_class tenv field_name type_ptr prop_attributes_opt =
+let build_sil_field_property type_ptr_to_sil_type curr_class tenv field_name type_ptr att_opt =
   let prop_attributes =
-    match prop_attributes_opt with
+    match att_opt with
     | Some prop_attributes -> prop_attributes
     | None -> ivar_property curr_class field_name in
   let atts_str = IList.map Clang_ast_j.string_of_property_attribute prop_attributes in
-  build_sil_field tenv field_name type_ptr atts_str
+  build_sil_field type_ptr_to_sil_type tenv field_name type_ptr atts_str
 
 (* Given a list of declarations in an interface returns a list of fields  *)
-let rec get_fields tenv curr_class decl_list =
+let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list =
   let open Clang_ast_t in
   match decl_list with
   | [] -> []
   | ObjCIvarDecl (decl_info, name_info, type_ptr, field_decl_info, obj_c_ivar_decl_info) :: decl_list' ->
-      let fields = get_fields tenv curr_class decl_list' in
+      let fields = get_fields type_ptr_to_sil_type tenv curr_class decl_list' in
       (* Doing a post visit here. Adding Ivar after all the declaration have been visited so that *)
       (* ivar names will be added in the property list. *)
       Printing.log_out "  ...Adding Instance Variable '%s' @." name_info.Clang_ast_t.ni_name;
-      let (fname, typ, ia) = build_sil_field_property curr_class tenv name_info type_ptr None in
+      let (fname, typ, ia) =
+        build_sil_field_property type_ptr_to_sil_type curr_class tenv name_info type_ptr None in
       Printing.log_out "  ...Resulting sil field: (%s) with attributes:@." ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ));
       IList.iter (fun (ia', _) ->
           IList.iter (fun a -> Printing.log_out "         '%s'@." a) ia'.Sil.parameters) ia;
@@ -104,8 +92,8 @@ let rec get_fields tenv curr_class decl_list =
   | ObjCPropertyImplDecl (decl_info, property_impl_decl_info):: decl_list' ->
       let property_fields_decl =
         ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in
-      get_fields tenv curr_class (property_fields_decl @ decl_list')
-  | _ :: decl_list' -> get_fields tenv curr_class decl_list'
+      get_fields type_ptr_to_sil_type tenv curr_class (property_fields_decl @ decl_list')
+  | _ :: decl_list' -> get_fields type_ptr_to_sil_type tenv curr_class decl_list'
 
 (* Add potential extra fields defined only in the implementation of the class *)
 (* to the info given in the interface. Update the tenv accordingly. *)

infer/src/clang/cField_decl.mli

@@ -8,18 +8,20 @@
  *)
 
 (** Utility module to retrieve fields of structs of classes *)
-
+open CFrontend_utils
 
 val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info ->
   (Ident.fieldname * Sil.typ * Sil.item_annotation) list
 
 type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list
 
-val get_fields : Sil.tenv -> CContext.curr_class -> Clang_ast_t.decl list -> field_type list
+val get_fields : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> CContext.curr_class ->
+  Clang_ast_t.decl list -> field_type list
 
 val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info -> field_type list
 
-val build_sil_field_property : CContext.curr_class -> Sil.tenv -> Clang_ast_t.named_decl_info ->
-  Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list option -> field_type
+val build_sil_field_property : Ast_utils.type_ptr_to_sil_type -> CContext.curr_class -> Sil.tenv ->
+  Clang_ast_t.named_decl_info -> Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list option
+  -> field_type
 
 val add_missing_fields : Sil.tenv -> string -> field_type list -> unit

infer/src/clang/cFrontend.ml

@@ -28,16 +28,18 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
   let info = Clang_ast_proj.get_decl_tuple dec in
   CLocation.update_curr_file info;
   let source_range = info.Clang_ast_t.di_source_range in
+  let should_translate_decl = CLocation.should_translate_lib source_range in
   let should_translate_enum = CLocation.should_translate_enum source_range in
   let open Clang_ast_t in
   match dec with
-  | FunctionDecl(di, name_info, tp, fdecl_info) ->
+  | FunctionDecl(di, name_info, tp, fdecl_info) when should_translate_decl ->
       CMethod_declImpl.function_decl tenv cfg cg namespace dec None
   | TypedefDecl (decl_info, name_info, opt_type, _, typedef_decl_info) ->
       Printing.log_out "%s" "Skipping typedef declaration. Will expand the type in its occurrences."
   (* Currently C/C++ record decl treated in the same way *)
   | CXXRecordDecl (_, _, _, _, decl_list, _, _, _)
-  | RecordDecl (_, _, _, _, decl_list, _, _) ->
+  | RecordDecl (_, _, _, _, decl_list, _, _) when should_translate_decl ->
+      ignore (CTypes_decl.add_types_from_decl_to_tenv tenv namespace dec);
       let method_decls = CTypes_decl.get_method_decls dec decl_list in
       let tranlate_method (parent, decl) =
         translate_one_declaration tenv cg cfg namespace parent decl in
@@ -46,36 +48,42 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
   | VarDecl(decl_info, name_info, t, _) ->
       Printing.log_out "Nothing to do for global variable %s " name_info.Clang_ast_t.ni_name
 
-  | ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, oi_decl_info) ->
+  | ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, oi_decl_info)
+    when should_translate_decl ->
       let name = name_info.Clang_ast_t.ni_name in
-      let curr_class =
-        ObjcInterface_decl.interface_declaration tenv decl_info name decl_list oi_decl_info in
+      let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in
+      ignore (ObjcInterface_decl.interface_declaration CTypes_decl.type_ptr_to_sil_type tenv dec);
       CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
 
-  | ObjCProtocolDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_protocol_decl_info) ->
+  | ObjCProtocolDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_protocol_decl_info)
+    when should_translate_decl ->
       let name = name_info.Clang_ast_t.ni_name in
-      let curr_class = ObjcProtocol_decl.protocol_decl tenv name decl_list in
+      let curr_class = CContext.ContextProtocol name in
+      ignore (ObjcProtocol_decl.protocol_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
       CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
 
-  | ObjCCategoryDecl(decl_info, name_info, decl_list, decl_context_info, category_decl_info) ->
+  | ObjCCategoryDecl(decl_info, name_info, decl_list, decl_context_info, ocdi) ->
       let name = name_info.Clang_ast_t.ni_name in
-      let curr_class =
-        ObjcCategory_decl.category_decl tenv name category_decl_info decl_list in
+      let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in
+      ignore (ObjcCategory_decl.category_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
       CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
 
-  | ObjCCategoryImplDecl(decl_info, name_info, decl_list, decl_context_info, category_impl_info) ->
+  | ObjCCategoryImplDecl(decl_info, name_info, decl_list, decl_context_info, ocidi) ->
       let name = name_info.Clang_ast_t.ni_name in
-      let curr_class =
-        ObjcCategory_decl.category_impl_decl tenv name decl_info category_impl_info decl_list in
+      let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in
+      ignore (ObjcCategory_decl.category_impl_decl CTypes_decl.type_ptr_to_sil_type tenv dec);
       CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
 
-  | ObjCImplementationDecl(decl_info, name_info, decl_list, decl_context_info, idi) ->
-      let name = name_info.Clang_ast_t.ni_name in
-      let curr_class =
-        ObjcInterface_decl.interface_impl_declaration tenv name decl_list idi in
+  | ObjCImplementationDecl(decl_info, name_info, decl_list, decl_context_info, idi)
+    when should_translate_decl ->
+      let curr_class = ObjcInterface_decl.get_curr_class_impl idi in
+      let type_ptr_to_sil_type = CTypes_decl.type_ptr_to_sil_type in
+      ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec);
       CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
+
   | CXXMethodDecl (decl_info, name_info, type_ptr, function_decl_info, _)
-  | CXXConstructorDecl (decl_info, name_info, type_ptr, function_decl_info, _) ->
+  | CXXConstructorDecl (decl_info, name_info, type_ptr, function_decl_info, _)
+    when should_translate_decl ->
       (* di_parent_pointer has pointer to lexical context such as class.*)
       (* If it's not defined, then it's the same as parent in AST *)
       let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with

infer/src/clang/cFrontend_utils.ml

@@ -102,6 +102,7 @@ end
 
 module Ast_utils =
 struct
+  type type_ptr_to_sil_type = Sil.tenv -> Clang_ast_t.type_ptr -> Sil.typ
 
   let string_of_decl decl =
     let name = Clang_ast_proj.get_decl_kind_string decl in
@@ -331,6 +332,17 @@ struct
     | Some typ -> (Clang_ast_proj.get_type_tuple typ).Clang_ast_t.ti_raw
     | None -> ""
 
+  let add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt fail_if_not_found =
+    match decl_ref_opt with (* translate interface first if found *)
+    | Some dr ->
+        ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer));
+    | _ -> if fail_if_not_found then assert false else ()
+
+  let add_type_from_decl_ref_list type_ptr_to_sil_type tenv decl_ref_list =
+    let add_elem dr =
+      ignore (type_ptr_to_sil_type tenv (`DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in
+    IList.iter add_elem decl_ref_list
+
 end 
 
 (* Global counter for anonymous block*)

infer/src/clang/cFrontend_utils.mli

@@ -101,6 +101,14 @@ sig
 
   val make_qual_name_decl : string -> string -> Clang_ast_t.named_decl_info
 
+  type type_ptr_to_sil_type =  Sil.tenv -> Clang_ast_t.type_ptr -> Sil.typ
+
+  val add_type_from_decl_ref : type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl_ref option ->
+    bool -> unit
+
+  val add_type_from_decl_ref_list : type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl_ref list ->
+    unit
+
 end
 
 module General_utils :

infer/src/clang/cMethod_decl.ml

@@ -27,13 +27,6 @@ end
 module CMethod_decl_funct(T: CModule_type.CTranslation) : CMethod_decl =
 struct
 
-  let method_body_to_translate ms body =
-    match body with
-    | Some body ->
-        if not (CLocation.should_translate_lib (CMethod_signature.ms_get_loc ms))
-        then None else Some body
-    | None -> body
-
   let model_exists procname =
     Specs.summary_exists_in_models procname && not !CFrontend_config.models_mode
 
@@ -80,7 +73,7 @@ struct
       | None -> [], None in
     let ms, body_opt, extra_instrs =
       CMethod_trans.method_signature_of_decl None func_decl block_data_opt in
-    match method_body_to_translate ms body_opt with
+    match body_opt with
     | Some body -> (* Only in the case the function declaration has a defined body we create a procdesc *)
         let procname = CMethod_signature.ms_get_name ms in
         if CMethod_trans.create_local_procdesc cfg tenv ms [body] captured_vars false then
@@ -92,7 +85,7 @@ struct
     let class_name = Some (CContext.get_curr_class_name curr_class) in
     let ms, body_opt, extra_instrs =
       CMethod_trans.method_signature_of_decl class_name meth_decl None in
-    match method_body_to_translate ms body_opt with
+    match body_opt with
     | Some body ->
         let is_instance = CMethod_signature.ms_is_instance ms in
         let procname = CMethod_signature.ms_get_name ms in
@@ -128,22 +121,33 @@ struct
     if Specs.summary_exists procname then false
     else
       let class_name = Procname.c_get_class procname in
-      let open CContext in
-      let cls = CContext.create_curr_class context.tenv class_name in
+      let tenv = context.CContext.tenv in
+      let cg = context.CContext.cg in
+      let cfg = context.CContext.cfg in
+      let namespace = context.CContext.namespace in
+      let cls = CContext.create_curr_class tenv class_name in
       let method_name = Procname.c_get_method procname in
       match ObjcProperty_decl.method_is_property_accesor cls method_name with
       | Some (property_name, property_type, is_getter) when
-          CMethod_trans.should_create_procdesc context.cfg procname true true ->
+          CMethod_trans.should_create_procdesc cfg procname true true ->
           (match property_type with tp, atts, decl_info, _, _, ivar_opt ->
             let ivar_name = ObjcProperty_decl.get_ivar_name property_name ivar_opt in
-            let field = CField_decl.build_sil_field_property cls context.tenv ivar_name tp (Some atts) in
-            ignore (CField_decl.add_missing_fields context.tenv class_name [field]);
-            let accessor =
+            let field =
+              CField_decl.build_sil_field_property CTypes_decl.type_ptr_to_sil_type cls tenv
+                ivar_name tp (Some atts) in
+            ignore (CField_decl.add_missing_fields tenv class_name [field]);
+            let accessor_opt =
               if is_getter then
                 ObjcProperty_decl.make_getter cls property_name property_type
               else ObjcProperty_decl.make_setter cls property_name property_type in
-            IList.iter (process_one_method_decl context.tenv context.cg context.cfg cls context.namespace) accessor;
+            match accessor_opt with
+            | [accessor] ->
+                let decl_info = Clang_ast_proj.get_decl_tuple accessor in
+                if CLocation.should_translate_lib decl_info.Clang_ast_t.di_source_range then
+                  (process_one_method_decl tenv cg cfg cls namespace accessor;
                    true)
+                else false
+            | _ -> false)
       | _ -> false
 
 end

infer/src/clang/cType_to_sil_type.ml

@@ -130,10 +130,13 @@ and decl_ptr_to_sil_type translate_decl tenv decl_ptr =
   try Clang_ast_types.TypePointerMap.find typ !CFrontend_config.sil_types_map
   with Not_found ->
   match Ast_utils.get_decl decl_ptr with
-    | Some (ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, oidi)) ->
-        Sil.Tvar (CTypes.mk_classname name_info.Clang_ast_t.ni_name)
   | Some (CXXRecordDecl _ as d)
-    | Some (RecordDecl _ as d) -> translate_decl tenv None d
+  | Some (RecordDecl _ as d)
+  | Some (ObjCInterfaceDecl _ as d)
+  | Some (ObjCImplementationDecl _ as d)
+  | Some (ObjCProtocolDecl _ as d)
+  | Some (ObjCCategoryDecl _ as d)
+  | Some (ObjCCategoryImplDecl _ as d) -> translate_decl tenv None d
     | Some (EnumDecl(_, name_info, _, _, _, _, _) ) ->
         Sil.Tvar (CTypes.mk_enumname name_info.Clang_ast_t.ni_name)
     | Some _ ->

infer/src/clang/cTypes_decl.ml

@@ -161,7 +161,7 @@ let rec get_struct_fields tenv record_name namespace decl_list =
   IList.flatten (IList.map do_one_decl decl_list)
 
 (* For a record declaration it returns/constructs the type *)
-and get_declaration_type tenv namespace decl =
+and get_strct_cpp_class_declaration_type tenv namespace decl =
   let open Clang_ast_t in
   match decl with
   | CXXRecordDecl (decl_info, name_info, opt_type, type_ptr, decl_list, _, record_decl_info, _)
@@ -186,13 +186,23 @@ and get_declaration_type tenv namespace decl =
       let sil_type = Sil.Tstruct (sorted_non_static_fields, static_fields, csu, Some mangled_name,
                                   superclasses, methods, item_annotation) in
       Ast_utils.update_sil_types_map type_ptr sil_type;
+      add_struct_to_tenv tenv sil_type;
       sil_type
   | _ -> assert false
 
 and add_types_from_decl_to_tenv tenv namespace decl =
-  let typ = get_declaration_type tenv namespace decl in
-  add_struct_to_tenv tenv typ;
-  typ
+  let open Clang_ast_t in
+  match decl with
+  | CXXRecordDecl (decl_info, name_info, opt_type, type_ptr, decl_list, _, record_decl_info, _)
+  | RecordDecl (decl_info, name_info, opt_type, type_ptr, decl_list, _, record_decl_info) ->
+      get_strct_cpp_class_declaration_type tenv namespace decl
+  | ObjCInterfaceDecl _ -> ObjcInterface_decl.interface_declaration type_ptr_to_sil_type tenv decl
+  | ObjCImplementationDecl _ ->
+      ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv decl
+  | ObjCProtocolDecl _ -> ObjcProtocol_decl.protocol_decl type_ptr_to_sil_type tenv decl
+  | ObjCCategoryDecl _ -> ObjcCategory_decl.category_decl type_ptr_to_sil_type tenv decl
+  | ObjCCategoryImplDecl _ -> ObjcCategory_decl.category_impl_decl type_ptr_to_sil_type tenv decl
+  | _ -> assert false
 
 and type_ptr_to_sil_type tenv tp =
   CType_to_sil_type.type_ptr_to_sil_type add_types_from_decl_to_tenv tenv tp

infer/src/clang/cTypes_decl.mli

@@ -9,8 +9,6 @@
 
 (** Processes types and record declarations by adding them to the tenv *)
 
-val get_declaration_type : Sil.tenv -> string option -> Clang_ast_t.decl -> Sil.typ
-
 val add_struct_to_tenv : Sil.tenv -> Sil.typ -> unit
 
 val get_record_name : Clang_ast_t.decl -> string

infer/src/clang/objcCategory_decl.ml

@@ -24,32 +24,42 @@ let cat_class_decl dr =
   | Some n -> n.Clang_ast_t.ni_name
   | _ -> assert false
 
-let get_class_from_category_decl category_decl_info =
-  match category_decl_info.Clang_ast_t.odi_class_interface with
-  | Some dr -> cat_class_decl dr
+let get_curr_class_from_category name decl_ref_opt =
+  match decl_ref_opt with
+  | Some dr ->
+      let class_name = cat_class_decl dr in
+      CContext.ContextCategory (name, class_name)
   | _ -> assert false
 
-let get_class_from_category_impl category_impl_info =
-  match category_impl_info.Clang_ast_t.ocidi_class_interface with
-  | 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_category_name_from_category_impl category_impl_info =
-  match category_impl_info.Clang_ast_t.ocidi_category_decl with
-  | Some dr -> cat_class_decl dr
-  | _ -> assert false
+let get_curr_class_from_category_impl name ocidi =
+  get_curr_class_from_category name 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
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
+
+let add_class_decl type_ptr_to_sil_type tenv category_decl_info =
+  let decl_ref_opt = category_decl_info.Clang_ast_t.odi_class_interface in
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
+
+let add_category_implementation type_ptr_to_sil_type tenv category_decl_info =
+  let decl_ref_opt = category_decl_info.Clang_ast_t.odi_implementation in
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
 
 (* Add potential extra fields defined only in the category *)
 (* to the corresponding class. Update the tenv accordingly.*)
-let process_category tenv name class_name decl_list =
-  let name = if name ="" then noname_category class_name else name in
-  Printing.log_out "Now name is '%s'\n" name;
-  let curr_class = CContext.ContextCategory (name, class_name) in
-  let fields = CField_decl.get_fields tenv curr_class decl_list in
+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 class_name = CContext.get_curr_class_name curr_class in
   let mang_name = Mangled.from_string class_name in
   let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in
-  match Sil.tenv_lookup tenv class_tn_name with
+  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 (intf_fields, _, _, _, superclass, intf_methods, annotation) ->
        let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in
        let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in
@@ -59,18 +69,32 @@ let process_category tenv name class_name decl_list =
            new_fields, [], Sil.Class, Some mang_name, superclass, new_methods, annotation
          ) in
        Printing.log_out " Updating info for class '%s' in tenv\n" class_name;
-      Sil.tenv_add tenv class_tn_name class_type_info;
-      curr_class
-  | _ -> assert false
+       Sil.tenv_add tenv class_tn_name class_type_info
+   | _ -> ());
+  Sil.Tvar class_tn_name
 
-let category_decl tenv name category_decl_info decl_list =
+let category_decl type_ptr_to_sil_type tenv decl =
+  let open Clang_ast_t in
+  match decl with
+  | ObjCCategoryDecl (decl_info, name_info, decl_list, decl_context_info, cdi) ->
+      let name = name_info.Clang_ast_t.ni_name in
+      let curr_class = get_curr_class_from_category_decl name cdi in
       Printing.log_out "ADDING: ObjCCategoryDecl for '%s'\n" name;
-  let class_name = get_class_from_category_decl category_decl_info in
-  process_category tenv name class_name decl_list
+      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 _ = add_category_implementation type_ptr_to_sil_type tenv cdi in
+      typ
+  | _ -> assert false
 
-let category_impl_decl tenv name decl_info category_impl_decl_info decl_list =
-  let category_name = get_category_name_from_category_impl category_impl_decl_info in
-  Printing.log_out "ADDING: ObjCCategoryImplDecl for '%s'\n" category_name;
-  let cat_class = get_class_from_category_impl category_impl_decl_info in
-  process_category tenv category_name cat_class decl_list
+let category_impl_decl type_ptr_to_sil_type tenv decl =
+  let open Clang_ast_t in
+  match decl with
+  | ObjCCategoryImplDecl (decl_info, name_info, decl_list, decl_context_info, cii) ->
+      let name = name_info.Clang_ast_t.ni_name in
+      let curr_class = get_curr_class_from_category_impl name cii in
+      Printing.log_out "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
+      typ
+  | _ -> assert false
 

infer/src/clang/objcCategory_decl.mli

@@ -10,8 +10,16 @@
 (** In this module an ObjC category declaration or implementation is processed. The category    *)
 (** is saved in the tenv as a struct with the corresponding fields and methods , and the class it belongs to *)
 
-val category_decl : Sil.tenv -> string -> Clang_ast_t.obj_c_category_decl_info -> Clang_ast_t.decl list
-  -> CContext.curr_class
+open CFrontend_utils
 
-val category_impl_decl : Sil.tenv -> string -> Clang_ast_t.decl_info ->
-  Clang_ast_t.obj_c_category_impl_decl_info -> Clang_ast_t.decl list -> CContext.curr_class
+val category_decl : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl -> Sil.typ
+
+val category_impl_decl : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl -> Sil.typ
+
+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

infer/src/clang/objcInterface_decl.ml

@@ -52,6 +52,37 @@ 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 Ast_utils.get_decl decl_ref.Clang_ast_t.dr_decl_pointer with
+       | Some ObjCInterfaceDecl (_, name_info, _, _, obj_c_interface_decl_info) ->
+           let class_name = name_info.Clang_ast_t.ni_name 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
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true
+
+let add_super_class_decl type_ptr_to_sil_type tenv ocdi =
+  let decl_ref_opt = ocdi.Clang_ast_t.otdi_super in
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
+
+let add_protocols_decl type_ptr_to_sil_type tenv protocols =
+  Ast_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols
+
+let add_class_implementation type_ptr_to_sil_type tenv idi =
+  let decl_ref_opt = idi.Clang_ast_t.otdi_implementation  in
+  Ast_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false
+
 (*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 =
@@ -65,40 +96,26 @@ let get_interface_superclasses super_opt protocols =
   let super_classes = super_class@protocol_names in
   super_classes
 
-let create_curr_class_and_superclasses_fields tenv decl_list class_name otdi_super otdi_protocols =
+let create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list class_name
+    otdi_super otdi_protocols =
   let super = get_super_interface_decl otdi_super in
   let protocols = get_protocols otdi_protocols in
-  let curr_class = CContext.ContextCls (class_name, super, protocols) in
   let superclasses = get_interface_superclasses super protocols in
-  let fields = CField_decl.get_fields tenv curr_class decl_list in
-  curr_class, superclasses, fields
-
-let update_curr_class curr_class superclasses =
-  let get_protocols protocols = IList.fold_right (
-      fun protocol converted_protocols ->
-        match protocol with
-        | (Sil.Protocol, name) -> (Mangled.to_string name):: converted_protocols
-        | _ -> converted_protocols
-    ) protocols [] in
-  match curr_class with
-  | CContext.ContextCls (class_name, _, _) ->
-      let super, protocols =
-        match superclasses with
-        | (Sil.Class, name):: rest -> Some (Mangled.to_string name), get_protocols rest
-        | _ -> None, get_protocols superclasses in
-      CContext.ContextCls (class_name, super, protocols)
-  | _ -> assert false
+  let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in
+  superclasses, fields
 
 (* Adds pairs (interface name, interface_type_info) to the global environment. *)
-let add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_info =
+let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name decl_list ocidi =
   Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name;
   let interface_name = CTypes.mk_classname class_name in
-  let curr_class, superclasses, fields =
-    create_curr_class_and_superclasses_fields tenv decl_list class_name
-      obj_c_interface_decl_info.Clang_ast_t.otdi_super
-      obj_c_interface_decl_info.Clang_ast_t.otdi_protocols in
+  let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
+  Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name);
+  let superclasses, fields =
+    create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list class_name
+      ocidi.Clang_ast_t.otdi_super
+      ocidi.Clang_ast_t.otdi_protocols in
   let methods = ObjcProperty_decl.get_methods curr_class decl_list in
-  let fields_sc = CField_decl.fields_superclass tenv obj_c_interface_decl_info in
+  let fields_sc = CField_decl.fields_superclass tenv ocidi in
   IList.iter (fun (fn, ft, _) ->
       Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
       Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc;
@@ -121,34 +138,52 @@ let add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_i
     Sil.Tstruct(fields, [], Sil.Class, Some (Mangled.from_string class_name),
                 superclasses, methods, objc_class_annotation) in
   Sil.tenv_add tenv interface_name interface_type_info;
-  let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
-  Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name);
   Printing.log_out
     "  >>>Verifying that Typename '%s' is in tenv\n" (Sil.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)
    | None -> Printing.log_out "  >>>NOT Found!!\n");
-  curr_class
+  Sil.Tvar interface_name
 
-let add_missing_methods tenv class_name decl_list curr_class =
+let add_missing_methods tenv class_name decl_info decl_list curr_class =
   let methods = ObjcProperty_decl.get_methods curr_class decl_list in
   let class_tn_name = Sil.TN_csu (Sil.Class, (Mangled.from_string class_name)) in
-  match Sil.tenv_lookup tenv class_tn_name with
+  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(fields, [], Sil.Class, Some name, superclass, existing_methods, annotation) ->
        let methods = General_utils.append_no_duplicates_methods existing_methods methods in
        let typ = Sil.Tstruct(fields, [], Sil.Class, Some name, superclass, methods, annotation) in
        Sil.tenv_add tenv class_tn_name typ
-  | _ -> ()
+   | _ -> ());
+  Sil.Tvar class_tn_name
 
 (* Interface_type_info has the name of instance variables and the name of methods. *)
-let interface_declaration tenv decl_info class_name decl_list obj_c_interface_decl_info =
-  add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_info
+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 = name_info.Clang_ast_t.ni_name 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 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
+      let _ = add_protocols_decl type_ptr_to_sil_type tenv ocidi.Clang_ast_t.otdi_protocols in
+      typ
+  | _ -> assert false
 
 (* Translate the methods defined in the implementation.*)
-let interface_impl_declaration tenv class_name decl_list idi =
+let interface_impl_declaration type_ptr_to_sil_type tenv decl =
+  let open Clang_ast_t in
+  match decl with
+  | ObjCImplementationDecl (decl_info, name_info, decl_list, decl_context_info, idi) ->
+      let class_name = name_info.Clang_ast_t.ni_name in
       Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name;
-  let curr_class = CContext.create_curr_class tenv class_name in
-  let fields = CField_decl.get_fields tenv curr_class decl_list in
+      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
       CField_decl.add_missing_fields tenv class_name fields;
-  add_missing_methods tenv class_name decl_list curr_class;
-  curr_class
+      let typ = add_missing_methods tenv class_name decl_info decl_list curr_class in
+      typ
+  | _ -> assert false

infer/src/clang/objcInterface_decl.mli

@@ -10,11 +10,16 @@
 (** In this module an ObjC interface declaration is processed. The class  *)
 (** is saved in the tenv as a struct with the corresponding fields, potential superclass and *)
 (** list of defined methods *)
+open CFrontend_utils
 
-val interface_declaration : Sil.tenv -> Clang_ast_t.decl_info -> string -> Clang_ast_t.decl list ->
-  Clang_ast_t.obj_c_interface_decl_info -> CContext.curr_class
+val interface_declaration : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl ->
+  Sil.typ
 
-val interface_impl_declaration : Sil.tenv -> string -> Clang_ast_t.decl list ->
-  Clang_ast_t.obj_c_implementation_decl_info -> CContext.curr_class
+val interface_impl_declaration : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl ->
+  Sil.typ
 
 val is_pointer_to_objc_class : Sil.tenv -> Sil.typ -> 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

infer/src/clang/objcProperty_decl.ml

@@ -346,13 +346,12 @@ let make_setter curr_class prop_name prop_type =
 (* [self->_field = [param copy] *)
 let make_getter_setter curr_class decl_info prop_name =
   Printing.log_out "pointer = '%s'\n" decl_info.Clang_ast_t.di_pointer;
-  let prop_type =
   try
-      Property.find_property curr_class prop_name
+    let prop_type = Property.find_property curr_class prop_name in
+    (make_getter curr_class prop_name prop_type)@ (make_setter curr_class prop_name prop_type)
   with _ ->
     Printing.log_out "Property %s not found@." prop_name.Clang_ast_t.ni_name;
-      assert false in
-  (make_getter curr_class prop_name prop_type)@ (make_setter curr_class prop_name prop_type)
+    []
 
 let add_properties_to_table curr_class decl_list =
   let add_property_to_table dec =

infer/src/clang/objcProtocol_decl.ml

@@ -12,16 +12,29 @@ open CFrontend_utils
 
 module L = Logging
 
-let protocol_decl tenv name decl_list =
+let add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info =
+  let protocols = obj_c_protocol_decl_info.Clang_ast_t.opcdi_protocols in
+  Ast_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols
+
+let protocol_decl type_ptr_to_sil_type tenv decl =
+  let open Clang_ast_t in
+  match decl with
+  | ObjCProtocolDecl(decl_info, name_info, decl_list, _, obj_c_protocol_decl_info) ->
+      let name = name_info.Clang_ast_t.ni_name in
+      let curr_class = CContext.ContextProtocol name in
       (* Adds pairs (protocol name, protocol_type_info) to the global environment. *)
       (* Protocol_type_info contains the methods composing the protocol. *)
       (* Here we are giving a similar treatment as interfaces (see above)*)
       (* It may turn out that we need a more specific treatment for protocols*)
       Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name;
       let mang_name = Mangled.from_string name in
-  let curr_class = CContext.ContextProtocol name in
       let protocol_name = Sil.TN_csu (Sil.Protocol, mang_name) in
+      let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
+      Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name);
       let methods = ObjcProperty_decl.get_methods curr_class decl_list in
-  let protocol_type_info = Sil.Tstruct([], [], Sil.Protocol, Some mang_name, [], methods, []) in
+      let protocol_type_info =
+        Sil.Tstruct ([], [], Sil.Protocol, Some mang_name, [], methods, []) in
       Sil.tenv_add tenv protocol_name protocol_type_info;
-  curr_class
+      add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info;
+      Sil.Tvar protocol_name
+  | _ -> assert false

infer/src/clang/objcProtocol_decl.mli

@@ -10,4 +10,6 @@
 (** In this module an ObjC protocol declaration or implementation is processed. The protocol    *)
 (** is saved in the tenv as a struct with the corresponding methods  *)
 
-val protocol_decl : Sil.tenv -> string -> Clang_ast_t.decl list -> CContext.curr_class
+open CFrontend_utils
+
+val protocol_decl : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl -> Sil.typ