pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Translate classes on demand

Browse Source 
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
master
Dulma Rodriguez 10 years ago committed by facebook-github-bot-7
parent 8c1979410a
commit 80057ea523
16 changed files with 316 additions and 197 deletions
Show Stats Download Patch File Download Diff File

34
infer/src/clang/cField_decl.ml
Unescape View File

@ -34,27 +34,14 @@ let fields_superclass tenv interface_decl_info =
| _ -> []) | _ -> [])
| _ -> [] | _ -> []
let get_field_www name_field fl = let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_atts =
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 annotation_from_type t = let annotation_from_type t =
match t with match t with
| Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak] | Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak]
| Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret] | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
| _ -> [] in | _ -> [] in
let fname = General_utils.mk_class_field_name field_name 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 let item_annotations = match prop_atts with
| [] -> | [] ->
[({ Sil.class_name = Config.ivar_attributes; Sil.parameters = annotation_from_type typ }, true)] [({ 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; | 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 = let prop_attributes =
match prop_attributes_opt with match att_opt with
| Some prop_attributes -> prop_attributes | Some prop_attributes -> prop_attributes
| None -> ivar_property curr_class field_name in | None -> ivar_property curr_class field_name in
let atts_str = IList.map Clang_ast_j.string_of_property_attribute prop_attributes 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 *) (* 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 let open Clang_ast_t in
match decl_list with match decl_list with
| [] -> [] | [] -> []
| ObjCIvarDecl (decl_info, name_info, type_ptr, field_decl_info, obj_c_ivar_decl_info) :: decl_list' -> | 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 *) (* 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. *) (* ivar names will be added in the property list. *)
Printing.log_out " ...Adding Instance Variable '%s' @." name_info.Clang_ast_t.ni_name; 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)); 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 (ia', _) ->
IList.iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) 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' -> | ObjCPropertyImplDecl (decl_info, property_impl_decl_info):: decl_list' ->
let property_fields_decl = let property_fields_decl =
ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in
get_fields tenv curr_class (property_fields_decl @ decl_list') get_fields type_ptr_to_sil_type tenv curr_class (property_fields_decl @ decl_list')
| _ :: decl_list' -> get_fields tenv curr_class 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 *) (* Add potential extra fields defined only in the implementation of the class *)
(* to the info given in the interface. Update the tenv accordingly. *) (* to the info given in the interface. Update the tenv accordingly. *)

10
infer/src/clang/cField_decl.mli
Unescape View File

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

44
infer/src/clang/cFrontend.ml
Unescape View File

@ -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 let info = Clang_ast_proj.get_decl_tuple dec in
CLocation.update_curr_file info; CLocation.update_curr_file info;
let source_range = info.Clang_ast_t.di_source_range in 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 should_translate_enum = CLocation.should_translate_enum source_range in
let open Clang_ast_t in let open Clang_ast_t in
match dec with 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 CMethod_declImpl.function_decl tenv cfg cg namespace dec None
| TypedefDecl (decl_info, name_info, opt_type, _, typedef_decl_info) -> | TypedefDecl (decl_info, name_info, opt_type, _, typedef_decl_info) ->
Printing.log_out "%s" "Skipping typedef declaration. Will expand the type in its occurrences." Printing.log_out "%s" "Skipping typedef declaration. Will expand the type in its occurrences."
(* Currently C/C++ record decl treated in the same way *) (* Currently C/C++ record decl treated in the same way *)
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _) | 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 method_decls = CTypes_decl.get_method_decls dec decl_list in
let tranlate_method (parent, decl) = let tranlate_method (parent, decl) =
translate_one_declaration tenv cg cfg namespace parent decl in 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, _) -> | VarDecl(decl_info, name_info, t, _) ->
Printing.log_out "Nothing to do for global variable %s " name_info.Clang_ast_t.ni_name 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 name = name_info.Clang_ast_t.ni_name in
let curr_class = let curr_class = ObjcInterface_decl.get_curr_class name oi_decl_info in
ObjcInterface_decl.interface_declaration tenv decl_info name decl_list 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 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 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 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 name = name_info.Clang_ast_t.ni_name in
let curr_class = let curr_class = ObjcCategory_decl.get_curr_class_from_category_decl name ocdi in
ObjcCategory_decl.category_decl tenv name category_decl_info decl_list 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 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 name = name_info.Clang_ast_t.ni_name in
let curr_class = let curr_class = ObjcCategory_decl.get_curr_class_from_category_impl name ocidi in
ObjcCategory_decl.category_impl_decl tenv name decl_info category_impl_info decl_list 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 CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
| ObjCImplementationDecl(decl_info, name_info, decl_list, decl_context_info, idi) -> | ObjCImplementationDecl(decl_info, name_info, decl_list, decl_context_info, idi)
let name = name_info.Clang_ast_t.ni_name in when should_translate_decl ->
let curr_class = let curr_class = ObjcInterface_decl.get_curr_class_impl idi in
ObjcInterface_decl.interface_impl_declaration tenv name decl_list 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 CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
| CXXMethodDecl (decl_info, name_info, type_ptr, function_decl_info, _) | 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.*) (* 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 *) (* 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 let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with

12
infer/src/clang/cFrontend_utils.ml
Unescape View File

@ -102,6 +102,7 @@ end
module Ast_utils = module Ast_utils =
struct struct
type type_ptr_to_sil_type = Sil.tenv -> Clang_ast_t.type_ptr -> Sil.typ
let string_of_decl decl = let string_of_decl decl =
let name = Clang_ast_proj.get_decl_kind_string decl in 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 | Some typ -> (Clang_ast_proj.get_type_tuple typ).Clang_ast_t.ti_raw
| None -> "" | 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 end
(* Global counter for anonymous block*) (* Global counter for anonymous block*)

8
infer/src/clang/cFrontend_utils.mli
Unescape View File

@ -101,6 +101,14 @@ sig
val make_qual_name_decl : string -> string -> Clang_ast_t.named_decl_info 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 end
module General_utils : module General_utils :

38
infer/src/clang/cMethod_decl.ml
Unescape View File

@ -27,13 +27,6 @@ end
module CMethod_decl_funct(T: CModule_type.CTranslation) : CMethod_decl = module CMethod_decl_funct(T: CModule_type.CTranslation) : CMethod_decl =
struct 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 = let model_exists procname =
Specs.summary_exists_in_models procname && not !CFrontend_config.models_mode Specs.summary_exists_in_models procname && not !CFrontend_config.models_mode
@ -80,7 +73,7 @@ struct
| None -> [], None in | None -> [], None in
let ms, body_opt, extra_instrs = let ms, body_opt, extra_instrs =
CMethod_trans.method_signature_of_decl None func_decl block_data_opt in 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 *) | 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 let procname = CMethod_signature.ms_get_name ms in
if CMethod_trans.create_local_procdesc cfg tenv ms [body] captured_vars false then 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 class_name = Some (CContext.get_curr_class_name curr_class) in
let ms, body_opt, extra_instrs = let ms, body_opt, extra_instrs =
CMethod_trans.method_signature_of_decl class_name meth_decl None in 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 -> | Some body ->
let is_instance = CMethod_signature.ms_is_instance ms in let is_instance = CMethod_signature.ms_is_instance ms in
let procname = CMethod_signature.ms_get_name ms in let procname = CMethod_signature.ms_get_name ms in
@ -128,22 +121,33 @@ struct
if Specs.summary_exists procname then false if Specs.summary_exists procname then false
else else
let class_name = Procname.c_get_class procname in let class_name = Procname.c_get_class procname in
let open CContext in let tenv = context.CContext.tenv in
let cls = CContext.create_curr_class context.tenv class_name 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 let method_name = Procname.c_get_method procname in
match ObjcProperty_decl.method_is_property_accesor cls method_name with match ObjcProperty_decl.method_is_property_accesor cls method_name with
| Some (property_name, property_type, is_getter) when | 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 -> (match property_type with tp, atts, decl_info, _, _, ivar_opt ->
let ivar_name = ObjcProperty_decl.get_ivar_name property_name ivar_opt in 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 let field =
ignore (CField_decl.add_missing_fields context.tenv class_name [field]); CField_decl.build_sil_field_property CTypes_decl.type_ptr_to_sil_type cls tenv
let accessor = ivar_name tp (Some atts) in
ignore (CField_decl.add_missing_fields tenv class_name [field]);
let accessor_opt =
if is_getter then if is_getter then
ObjcProperty_decl.make_getter cls property_name property_type ObjcProperty_decl.make_getter cls property_name property_type
else ObjcProperty_decl.make_setter cls property_name property_type in 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
true) | [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 | _ -> false
end end

13
infer/src/clang/cType_to_sil_type.ml
Unescape View File

@ -129,11 +129,14 @@ and decl_ptr_to_sil_type translate_decl tenv decl_ptr =
let typ = `DeclPtr decl_ptr in let typ = `DeclPtr decl_ptr in
try Clang_ast_types.TypePointerMap.find typ !CFrontend_config.sil_types_map try Clang_ast_types.TypePointerMap.find typ !CFrontend_config.sil_types_map
with Not_found -> with Not_found ->
match Ast_utils.get_decl decl_ptr with match Ast_utils.get_decl decl_ptr with
| Some (ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, oidi)) -> | Some (CXXRecordDecl _ as d)
Sil.Tvar (CTypes.mk_classname name_info.Clang_ast_t.ni_name) | Some (RecordDecl _ as d)
| Some (CXXRecordDecl _ as d) | Some (ObjCInterfaceDecl _ as d)
| Some (RecordDecl _ as d) -> translate_decl tenv None 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, _, _, _, _, _) ) -> | Some (EnumDecl(_, name_info, _, _, _, _, _) ) ->
Sil.Tvar (CTypes.mk_enumname name_info.Clang_ast_t.ni_name) Sil.Tvar (CTypes.mk_enumname name_info.Clang_ast_t.ni_name)
| Some _ -> | Some _ ->

18
infer/src/clang/cTypes_decl.ml
Unescape View File

@ -161,7 +161,7 @@ let rec get_struct_fields tenv record_name namespace decl_list =
IList.flatten (IList.map do_one_decl decl_list) IList.flatten (IList.map do_one_decl decl_list)
(* For a record declaration it returns/constructs the type *) (* 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 let open Clang_ast_t in
match decl with match decl with
| CXXRecordDecl (decl_info, name_info, opt_type, type_ptr, decl_list, _, record_decl_info, _) | 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, let sil_type = Sil.Tstruct (sorted_non_static_fields, static_fields, csu, Some mangled_name,
superclasses, methods, item_annotation) in superclasses, methods, item_annotation) in
Ast_utils.update_sil_types_map type_ptr sil_type; Ast_utils.update_sil_types_map type_ptr sil_type;
add_struct_to_tenv tenv sil_type;
sil_type sil_type
| _ -> assert false | _ -> assert false
and add_types_from_decl_to_tenv tenv namespace decl = and add_types_from_decl_to_tenv tenv namespace decl =
let typ = get_declaration_type tenv namespace decl in let open Clang_ast_t in
add_struct_to_tenv tenv typ; match decl with
typ | 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 = 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 CType_to_sil_type.type_ptr_to_sil_type add_types_from_decl_to_tenv tenv tp

2
infer/src/clang/cTypes_decl.mli
Unescape View File

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

100
infer/src/clang/objcCategory_decl.ml
Unescape View File

@ -24,53 +24,77 @@ let cat_class_decl dr =
| Some n -> n.Clang_ast_t.ni_name | Some n -> n.Clang_ast_t.ni_name
| _ -> assert false | _ -> assert false
let get_class_from_category_decl category_decl_info = let get_curr_class_from_category name decl_ref_opt =
match category_decl_info.Clang_ast_t.odi_class_interface with match decl_ref_opt with
| Some dr -> cat_class_decl dr | Some dr ->
let class_name = cat_class_decl dr in
CContext.ContextCategory (name, class_name)
| _ -> assert false | _ -> assert false
let get_class_from_category_impl category_impl_info = let get_curr_class_from_category_decl name ocdi =
match category_impl_info.Clang_ast_t.ocidi_class_interface with get_curr_class_from_category name ocdi.Clang_ast_t.odi_class_interface
| Some dr -> cat_class_decl dr
| _ -> assert false
let get_category_name_from_category_impl category_impl_info = let get_curr_class_from_category_impl name ocidi =
match category_impl_info.Clang_ast_t.ocidi_category_decl with get_curr_class_from_category name ocidi.Clang_ast_t.ocidi_class_interface
| Some dr -> cat_class_decl dr
| _ -> assert false 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 *) (* Add potential extra fields defined only in the category *)
(* to the corresponding class. Update the tenv accordingly.*) (* to the corresponding class. Update the tenv accordingly.*)
let process_category tenv name class_name decl_list = let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
let name = if name ="" then noname_category class_name else name in let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list 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 methods = ObjcProperty_decl.get_methods 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 mang_name = Mangled.from_string class_name in
let class_tn_name = Sil.TN_csu (Sil.Class, mang_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
| Some Sil.Tstruct (intf_fields, _, _, _, superclass, intf_methods, annotation) -> Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in (match Sil.tenv_lookup tenv class_tn_name with
let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in | Some Sil.Tstruct (intf_fields, _, _, _, superclass, intf_methods, annotation) ->
let new_methods = General_utils.append_no_duplicates_methods methods intf_methods in let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in
let class_type_info = let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in
Sil.Tstruct ( let new_methods = General_utils.append_no_duplicates_methods methods intf_methods in
new_fields, [], Sil.Class, Some mang_name, superclass, new_methods, annotation let class_type_info =
) in Sil.Tstruct (
Printing.log_out " Updating info for class '%s' in tenv\n" class_name; new_fields, [], Sil.Class, Some mang_name, superclass, new_methods, annotation
Sil.tenv_add tenv class_tn_name class_type_info; ) in
curr_class Printing.log_out " Updating info for class '%s' in tenv\n" class_name;
| _ -> 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 =
Printing.log_out "ADDING: ObjCCategoryDecl for '%s'\n" name; let open Clang_ast_t in
let class_name = get_class_from_category_decl category_decl_info in match decl with
process_category tenv name class_name decl_list | 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 _ = 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_impl_decl type_ptr_to_sil_type tenv decl =
let category_name = get_category_name_from_category_impl category_impl_decl_info in let open Clang_ast_t in
Printing.log_out "ADDING: ObjCCategoryImplDecl for '%s'\n" category_name; match decl with
let cat_class = get_class_from_category_impl category_impl_decl_info in | ObjCCategoryImplDecl (decl_info, name_info, decl_list, decl_context_info, cii) ->
process_category tenv category_name cat_class decl_list 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

16
infer/src/clang/objcCategory_decl.mli
Unescape View File

@ -10,8 +10,16 @@
(** In this module an ObjC category declaration or implementation is processed. The category *) (** 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 *) (** 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 open CFrontend_utils
-> CContext.curr_class
val category_impl_decl : Sil.tenv -> string -> Clang_ast_t.decl_info -> val category_decl : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.decl -> Sil.typ
Clang_ast_t.obj_c_category_impl_decl_info -> Clang_ast_t.decl list -> CContext.curr_class
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

125
infer/src/clang/objcInterface_decl.ml
Unescape View File

@ -52,6 +52,37 @@ let get_protocols protocols =
) protocols in ) protocols in
protocol_names 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, *) (*The superclass is the first element in the list of super classes of structs in the tenv, *)
(* then come the protocols and categories. *) (* then come the protocols and categories. *)
let get_interface_superclasses super_opt protocols = 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 let super_classes = super_class@protocol_names in
super_classes 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 super = get_super_interface_decl otdi_super in
let protocols = get_protocols otdi_protocols 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 superclasses = get_interface_superclasses super protocols in
let fields = CField_decl.get_fields tenv curr_class decl_list in let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in
curr_class, superclasses, fields 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
(* Adds pairs (interface name, interface_type_info) to the global environment. *) (* 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; Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name;
let interface_name = CTypes.mk_classname class_name in let interface_name = CTypes.mk_classname class_name in
let curr_class, superclasses, fields = let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
create_curr_class_and_superclasses_fields tenv decl_list class_name Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name);
obj_c_interface_decl_info.Clang_ast_t.otdi_super let superclasses, fields =
obj_c_interface_decl_info.Clang_ast_t.otdi_protocols in 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 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, _) -> IList.iter (fun (fn, ft, _) ->
Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; 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), Sil.Tstruct(fields, [], Sil.Class, Some (Mangled.from_string class_name),
superclasses, methods, objc_class_annotation) in superclasses, methods, objc_class_annotation) in
Sil.tenv_add tenv interface_name interface_type_info; 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 Printing.log_out
" >>>Verifying that Typename '%s' is in tenv\n" (Sil.typename_to_string interface_name); " >>>Verifying that Typename '%s' is in tenv\n" (Sil.typename_to_string interface_name);
(match Sil.tenv_lookup tenv interface_name with (match Sil.tenv_lookup tenv interface_name with
| Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) | Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t)
| None -> Printing.log_out " >>>NOT Found!!\n"); | 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 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 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
| Some Sil.Tstruct(fields, [], Sil.Class, Some name, superclass, existing_methods, annotation) -> Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
let methods = General_utils.append_no_duplicates_methods existing_methods methods in (match Sil.tenv_lookup tenv class_tn_name with
let typ = Sil.Tstruct(fields, [], Sil.Class, Some name, superclass, methods, annotation) in | Some Sil.Tstruct(fields, [], Sil.Class, Some name, superclass, existing_methods, annotation) ->
Sil.tenv_add tenv class_tn_name typ 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. *) (* 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 = let interface_declaration type_ptr_to_sil_type tenv decl =
add_class_to_tenv tenv decl_info class_name decl_list obj_c_interface_decl_info 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.*) (* 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 =
Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name; let open Clang_ast_t in
let curr_class = CContext.create_curr_class tenv class_name in match decl with
let fields = CField_decl.get_fields tenv curr_class decl_list in | ObjCImplementationDecl (decl_info, name_info, decl_list, decl_context_info, idi) ->
CField_decl.add_missing_fields tenv class_name fields; let class_name = name_info.Clang_ast_t.ni_name in
add_missing_methods tenv class_name decl_list curr_class; Printing.log_out "ADDING: ObjCImplementationDecl for class '%s'\n" class_name;
curr_class 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;
let typ = add_missing_methods tenv class_name decl_info decl_list curr_class in
typ
| _ -> assert false

13
infer/src/clang/objcInterface_decl.mli
Unescape View File

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

37
infer/src/clang/objcProperty_decl.ml
Unescape View File

@ -93,18 +93,18 @@ struct
let rec find_property curr_class property_name = let rec find_property curr_class property_name =
try PropertyTableHash.find property_table (curr_class, property_name) try PropertyTableHash.find property_table (curr_class, property_name)
with Not_found -> with Not_found ->
match curr_class with match curr_class with
| ContextCls (name, _, protocols) -> | ContextCls (name, _, protocols) ->
let res_opt = IList.fold_right let res_opt = IList.fold_right
(fun protocol found_procname_opt -> (fun protocol found_procname_opt ->
match found_procname_opt with match found_procname_opt with
| Some found_procname -> Some found_procname | Some found_procname -> Some found_procname
| None -> | None ->
Some (find_property (ContextProtocol protocol) property_name)) protocols None in Some (find_property (ContextProtocol protocol) property_name)) protocols None in
(match res_opt with (match res_opt with
| Some res -> res | Some res -> res
| None -> raise Not_found) | None -> raise Not_found)
| _ -> raise Not_found | _ -> raise Not_found
let find_property_name_from_ivar curr_class ivar = let find_property_name_from_ivar curr_class ivar =
let res = ref None in let res = ref None in
@ -346,13 +346,12 @@ let make_setter curr_class prop_name prop_type =
(* [self->_field = [param copy] *) (* [self->_field = [param copy] *)
let make_getter_setter curr_class decl_info prop_name = let make_getter_setter curr_class decl_info prop_name =
Printing.log_out "pointer = '%s'\n" decl_info.Clang_ast_t.di_pointer; Printing.log_out "pointer = '%s'\n" decl_info.Clang_ast_t.di_pointer;
let prop_type = try
try let prop_type = Property.find_property curr_class prop_name in
Property.find_property curr_class prop_name (make_getter curr_class prop_name prop_type)@ (make_setter curr_class prop_name prop_type)
with _ -> with _ ->
Printing.log_out "Property %s not found@." prop_name.Clang_ast_t.ni_name; 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_properties_to_table curr_class decl_list =
let add_property_to_table dec = let add_property_to_table dec =

39
infer/src/clang/objcProtocol_decl.ml
Unescape View File

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

4
infer/src/clang/objcProtocol_decl.mli
Unescape View File

@ -10,4 +10,6 @@
(** In this module an ObjC protocol declaration or implementation is processed. The protocol *) (** 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 *) (** 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

Write Preview
Loading…
Cancel
Save