(* * Copyright (c) 2013 - Facebook. * All rights reserved. *) (** Utility module to retrieve fields of structs of classes *) open Utils open CFrontend_utils open CFrontend_utils.General_utils open Clang_ast_t module L = Logging let mk_class_field_name class_name field_name = Ident.create_fieldname (Mangled.mangled field_name (class_name^"_"^field_name)) 0 let rec get_fields_super_classes tenv super_class = Printing.log_out ~fmt:" ... Getting fields of superclass '%s'\n" (Sil.typename_to_string super_class); match Sil.tenv_lookup tenv super_class with | None -> [] | Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) -> let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Sil.Class, sc)) in append_no_duplicates_fields fields sc_fields | Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields | Some _ -> [] let fields_superclass tenv interface_decl_info = match interface_decl_info.Clang_ast_t.otdi_super with | Some dr -> (match dr.Clang_ast_t.dr_name with | Some sc -> get_fields_super_classes tenv (CTypes.mk_classname sc) | _ -> []) | _ -> [] let get_field_www name_field fl = let rec scan_fields nn ll = match ll with | [] -> [] | (n, t, _):: ll' -> Printing.log_out ~fmt:">>>>>Searching for field '%s'." (Ident.fieldname_to_string n); Printing.log_out ~fmt:" 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 rec build_sil_field tenv class_name field_name qual_type prop_atts = let fname = mk_class_field_name class_name field_name in let typ = CTypes_decl.qual_type_to_sil_type tenv qual_type in let item_annotations = match prop_atts with | None -> Sil.item_annotation_empty | Some atts -> [({ Sil.class_name = Config.property_attributes; Sil.parameters = atts }, true)] in fname, typ, item_annotations (* From an ivar look for its property and if it finds it returns its attributes *) let ivar_property curr_class ivar = match ObjcProperty_decl.Property.find_property_name_from_ivar curr_class ivar with | Some pname' -> (Printing.log_out ~fmt: "Found property name from ivar: '%s'" pname'; try let _, atts, _, _, _, _ = ObjcProperty_decl.Property.find_property curr_class pname' in let atts_str = list_map Clang_ast_j.string_of_property_attribute atts in Some atts_str with Not_found -> Printing.log_out ~fmt: "Didn't find property for pname '%s'" pname'; None) | None -> Printing.log_out ~fmt: "Didn't find property for ivar '%s'" ivar; None (* Given a list of declarations in an interface returns a list of fields *) let rec get_fields tenv curr_class decl_list = let class_name = CContext.get_curr_class_name curr_class in match decl_list with | [] -> [] | ObjCIvarDecl(decl_info, field_name, qual_type, field_decl_info, obj_c_ivar_decl_info) :: decl_list' -> let fields = get_fields 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 ~fmt:" ...Adding Instance Variable '%s' \n" field_name; let prop_attributes = ivar_property curr_class field_name in let (fname, typ, ia) = build_sil_field tenv class_name field_name qual_type prop_attributes in Printing.log_out ~fmt:" ...Resulting sil field: (%s) with attributes:\n" ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ)); list_iter (fun (ia', _) -> list_iter (fun a -> Printing.log_out ~fmt: " '%s' \n" a) ia'.Sil.parameters) ia; (fname, typ, ia):: fields | 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') | (d : Clang_ast_t.decl):: decl_list' -> get_fields tenv curr_class decl_list'