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

[clang frontend] Pass type qualifiers through frontend

Browse Source 
Summary:
Backend needs to know whether type is const or not. In order to achieve it, frontend needs to know it first.
This diff changes bunch of things:
- update clang plugin to have AST exporter actually export that info most of the time
- change types of functions in clang frontend until it compiles
- replace `type_ptr` with `qual_type` and `tp` with `qt` in names where applicable
- cleanup some things in the process
update-submodule: facebook-clang-plugins

Reviewed By: jvillard

Differential Revision: D4938567

fbshipit-source-id: 716b3ef
master
Andrzej Kotulski 8 years ago committed by Facebook Github Bot
parent 233d6a53c0
commit db3c07a631
34 changed files with 440 additions and 498 deletions
Show Stats Download Patch File Download Diff File

2
facebook-clang-plugins

@ -1 +1 @@
Subproject commit ee26293dd046acc5c2dd862d3201aa9f7dace96a Subproject commit 21d4222b325650c67944a4ad9cc2b72c7e37fefd

2
infer/src/clang/CProcname.ml
Unescape View File

@ -34,7 +34,7 @@ let get_template_info tenv (fdi : Clang_ast_t.function_decl_info) : Typ.template
| Some spec_info -> Typ.Template ( | Some spec_info -> Typ.Template (
QualifiedCppName.empty, QualifiedCppName.empty,
List.map spec_info.tsi_specialization_args ~f:(function List.map spec_info.tsi_specialization_args ~f:(function
| `Type type_ptr -> Some (CType_decl.type_ptr_to_sil_type tenv type_ptr) | `Type qual_type -> Some (CType_decl.qual_type_to_sil_type tenv qual_type)
| _ -> None)) | _ -> None))
| None -> Typ.NoTemplate | None -> Typ.NoTemplate

29
infer/src/clang/CType.ml
Unescape View File

@ -36,34 +36,35 @@ let is_class typ =
String.equal (Typ.Name.name name) CFrontend_config.objc_class String.equal (Typ.Name.name name) CFrontend_config.objc_class
| _ -> false | _ -> false
let rec return_type_of_function_type_ptr type_ptr = let rec return_type_of_function_qual_type (qual_type : Clang_ast_t.qual_type) =
let open Clang_ast_t in let open Clang_ast_t in
match CAst_utils.get_type type_ptr with match CAst_utils.get_type qual_type.qt_type_ptr with
| Some FunctionProtoType (_, function_type_info, _) | Some FunctionProtoType (_, function_type_info, _)
| Some FunctionNoProtoType (_, function_type_info) -> | Some FunctionNoProtoType (_, function_type_info) ->
function_type_info.Clang_ast_t.fti_return_type function_type_info.Clang_ast_t.fti_return_type
| Some BlockPointerType (_, in_type_ptr) -> | Some BlockPointerType (_, in_qual) ->
return_type_of_function_type_ptr in_type_ptr return_type_of_function_qual_type in_qual
| Some _ -> | Some _ ->
Logging.err_debug "Warning: Type pointer %s is not a function type." Logging.err_debug "Warning: Type pointer %s is not a function type."
(Clang_ast_extend.type_ptr_to_string type_ptr); (Clang_ast_extend.type_ptr_to_string qual_type.qt_type_ptr);
Clang_ast_extend.ErrorType {qual_type with qt_type_ptr=Clang_ast_extend.ErrorType}
| None -> | None ->
Logging.err_debug "Warning: Type pointer %s not found." Logging.err_debug "Warning: Type pointer %s not found."
(Clang_ast_extend.type_ptr_to_string type_ptr); (Clang_ast_extend.type_ptr_to_string qual_type.qt_type_ptr);
Clang_ast_extend.ErrorType {qual_type with qt_type_ptr=Clang_ast_extend.ErrorType}
let return_type_of_function_type tp = let return_type_of_function_type qual_type =
return_type_of_function_type_ptr tp return_type_of_function_qual_type qual_type
let is_block_type tp =
let is_block_type {Clang_ast_t.qt_type_ptr} =
let open Clang_ast_t in let open Clang_ast_t in
match CAst_utils.get_desugared_type tp with match CAst_utils.get_desugared_type qt_type_ptr with
| Some BlockPointerType _ -> true | Some BlockPointerType _ -> true
| _ -> false | _ -> false
let is_reference_type tp = let is_reference_type {Clang_ast_t.qt_type_ptr} =
match CAst_utils.get_desugared_type tp with match CAst_utils.get_desugared_type qt_type_ptr with
| Some Clang_ast_t.LValueReferenceType _ -> true | Some Clang_ast_t.LValueReferenceType _ -> true
| Some Clang_ast_t.RValueReferenceType _ -> true | Some Clang_ast_t.RValueReferenceType _ -> true
| _ -> false | _ -> false

6
infer/src/clang/CType.mli
Unescape View File

@ -19,10 +19,10 @@ val remove_pointer_to_typ : Typ.t -> Typ.t
val is_class : Typ.t -> bool val is_class : Typ.t -> bool
val return_type_of_function_type : Clang_ast_t.type_ptr -> Clang_ast_t.type_ptr val return_type_of_function_type : Clang_ast_t.qual_type -> Clang_ast_t.qual_type
val is_block_type : Clang_ast_t.type_ptr -> bool val is_block_type : Clang_ast_t.qual_type -> bool
val is_reference_type : Clang_ast_t.type_ptr -> bool val is_reference_type : Clang_ast_t.qual_type -> bool
val get_name_from_type_pointer : string -> string * string val get_name_from_type_pointer : string -> string * string

36
infer/src/clang/CType_decl.ml
Unescape View File

@ -93,7 +93,7 @@ let rec get_struct_fields tenv decl =
let do_one_decl decl = match decl with let do_one_decl decl = match decl with
| FieldDecl (_, name_info, qt, _) -> | FieldDecl (_, name_info, qt, _) ->
let id = CGeneral_utils.mk_class_field_name name_info in let id = CGeneral_utils.mk_class_field_name name_info in
let typ = type_ptr_to_sil_type tenv qt.Clang_ast_t.qt_type_ptr in let typ = qual_type_to_sil_type tenv qt in
let annotation_items = [] in (* For the moment we don't use them*) let annotation_items = [] in (* For the moment we don't use them*)
[(id, typ, annotation_items)] [(id, typ, annotation_items)]
| _ -> [] in | _ -> [] in
@ -113,7 +113,7 @@ and get_record_custom_type tenv definition_decl =
match definition_decl with match definition_decl with
| ClassTemplateSpecializationDecl (_, _, _, _, decl_list, _, _, _, _) | ClassTemplateSpecializationDecl (_, _, _, _, decl_list, _, _, _, _)
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _) -> | CXXRecordDecl (_, _, _, _, decl_list, _, _, _) ->
Option.map ~f:(type_ptr_to_sil_type tenv) (get_translate_as_friend_decl decl_list) Option.map ~f:(qual_type_to_sil_type tenv) (get_translate_as_friend_decl decl_list)
| _ -> None | _ -> None
and get_template_specialization tenv = function and get_template_specialization tenv = function
@ -122,7 +122,7 @@ and get_template_specialization tenv = function
| Some decl -> get_class_template_name decl | Some decl -> get_class_template_name decl
| None -> assert false in | None -> assert false in
let args_in_sil = List.map spec_info.tsi_specialization_args ~f:(function let args_in_sil = List.map spec_info.tsi_specialization_args ~f:(function
| `Type t_ptr -> Some (type_ptr_to_sil_type tenv t_ptr) | `Type qual_type -> Some (qual_type_to_sil_type tenv qual_type)
| _ -> None) in | _ -> None) in
Typ.Template (tname, args_in_sil) Typ.Template (tname, args_in_sil)
| _ -> Typ.NoTemplate | _ -> Typ.NoTemplate
@ -202,30 +202,30 @@ and add_types_from_decl_to_tenv tenv decl =
match decl with match decl with
| ClassTemplateSpecializationDecl _ | CXXRecordDecl _ | RecordDecl _ -> | ClassTemplateSpecializationDecl _ | CXXRecordDecl _ | RecordDecl _ ->
get_record_declaration_type tenv decl get_record_declaration_type tenv decl
| ObjCInterfaceDecl _ -> ObjcInterface_decl.interface_declaration type_ptr_to_sil_type tenv decl | ObjCInterfaceDecl _ -> ObjcInterface_decl.interface_declaration qual_type_to_sil_type tenv decl
| ObjCImplementationDecl _ -> | ObjCImplementationDecl _ ->
ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv decl ObjcInterface_decl.interface_impl_declaration qual_type_to_sil_type tenv decl
| ObjCProtocolDecl _ -> ObjcProtocol_decl.protocol_decl type_ptr_to_sil_type tenv decl | ObjCProtocolDecl _ -> ObjcProtocol_decl.protocol_decl qual_type_to_sil_type tenv decl
| ObjCCategoryDecl _ -> ObjcCategory_decl.category_decl type_ptr_to_sil_type tenv decl | ObjCCategoryDecl _ -> ObjcCategory_decl.category_decl qual_type_to_sil_type tenv decl
| ObjCCategoryImplDecl _ -> ObjcCategory_decl.category_impl_decl type_ptr_to_sil_type tenv decl | ObjCCategoryImplDecl _ -> ObjcCategory_decl.category_impl_decl qual_type_to_sil_type tenv decl
| EnumDecl _ -> CEnum_decl.enum_decl decl | EnumDecl _ -> CEnum_decl.enum_decl decl
| _ -> assert false | _ -> assert false
and type_ptr_to_sil_type tenv tp = and qual_type_to_sil_type tenv qual_type =
CType_to_sil_type.type_ptr_to_sil_type add_types_from_decl_to_tenv tenv tp CType_to_sil_type.qual_type_to_sil_type add_types_from_decl_to_tenv tenv qual_type
let get_type_from_expr_info ei tenv = let get_type_from_expr_info ei tenv =
let tp = ei.Clang_ast_t.ei_type_ptr in let qt = ei.Clang_ast_t.ei_qual_type in
type_ptr_to_sil_type tenv tp qual_type_to_sil_type tenv qt
let class_from_pointer_type tenv type_ptr = let class_from_pointer_type tenv qual_type =
match (type_ptr_to_sil_type tenv type_ptr).Typ.desc with match (qual_type_to_sil_type tenv qual_type).Typ.desc with
| Tptr({desc=Tstruct typename}, _) -> typename | Tptr({desc=Tstruct typename}, _) -> typename
| _ -> assert false | _ -> assert false
let get_class_type_np tenv expr_info obj_c_message_expr_info = let get_class_type_np tenv expr_info obj_c_message_expr_info =
let tp = let qt =
match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with
| `Class tp -> tp | `Class qt -> qt
| _ -> expr_info.Clang_ast_t.ei_type_ptr in | _ -> expr_info.Clang_ast_t.ei_qual_type in
type_ptr_to_sil_type tenv tp qual_type_to_sil_type tenv qt

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

@ -19,9 +19,9 @@ val add_types_from_decl_to_tenv : Tenv.t -> Clang_ast_t.decl -> Typ.t
(* and Class, which is a pointer to objc_class. *) (* and Class, which is a pointer to objc_class. *)
val add_predefined_types : Tenv.t -> unit val add_predefined_types : Tenv.t -> unit
val type_ptr_to_sil_type : Tenv.t -> Clang_ast_t.type_ptr -> Typ.t val qual_type_to_sil_type : Tenv.t -> Clang_ast_t.qual_type -> Typ.t
val class_from_pointer_type : Tenv.t -> Clang_ast_t.type_ptr -> Typ.Name.t val class_from_pointer_type : Tenv.t -> Clang_ast_t.qual_type -> Typ.Name.t
val get_class_type_np : Tenv.t -> Clang_ast_t.expr_info -> val get_class_type_np : Tenv.t -> Clang_ast_t.expr_info ->
Clang_ast_t.obj_c_message_expr_info -> Typ.t Clang_ast_t.obj_c_message_expr_info -> Typ.t

2
infer/src/clang/ComponentKit.ml
Unescape View File

@ -143,7 +143,7 @@ let component_factory_function_advice context an =
match an with match an with
| Ctl_parser_types.Decl (Clang_ast_t.FunctionDecl (decl_info, _, (qual_type: Clang_ast_t.qual_type), _)) -> | Ctl_parser_types.Decl (Clang_ast_t.FunctionDecl (decl_info, _, (qual_type: Clang_ast_t.qual_type), _)) ->
let objc_interface = let objc_interface =
CAst_utils.type_ptr_to_objc_interface qual_type.qt_type_ptr in CAst_utils.qual_type_to_objc_interface qual_type in
let condition = let condition =
is_ck_context context an && is_component_if objc_interface in is_ck_context context an && is_component_if objc_interface in
if condition then if condition then

265
infer/src/clang/ast_expressions.ml
Unescape View File

@ -66,49 +66,47 @@ let stmt_info_with_fresh_pointer stmt_info = {
let create_qual_type ?(is_const=false) qt_type_ptr = let create_qual_type ?(is_const=false) qt_type_ptr =
{ Clang_ast_t.qt_type_ptr; qt_is_const=is_const } { Clang_ast_t.qt_type_ptr; qt_is_const=is_const }
let builtin_to_type_ptr kind = Clang_ast_extend.Builtin kind let builtin_to_qual_type kind = create_qual_type (Clang_ast_extend.Builtin kind)
let pointerof_type_ptr type_ptr = Clang_ast_extend.PointerOf type_ptr
let create_pointer_qual_type ~is_const typ =
create_qual_type ~is_const (Clang_ast_extend.PointerOf typ)
let create_reference_qual_type ~is_const typ =
create_qual_type ~is_const (Clang_ast_extend.ReferenceOf typ)
(* We translate function types as the return type of the function *) (* We translate function types as the return type of the function *)
let function_type_ptr return_type = return_type let function_type_ptr return_type = return_type
let create_int_type = builtin_to_type_ptr `Int let create_int_type = builtin_to_qual_type `Int
let create_void_type = builtin_to_type_ptr `Void let create_void_type = builtin_to_qual_type `Void
let create_void_star_type = pointerof_type_ptr create_void_type let create_void_star_type = create_pointer_qual_type ~is_const:false create_void_type
let create_id_type = pointerof_type_ptr (builtin_to_type_ptr `ObjCId) let create_id_type = create_pointer_qual_type ~is_const:false (builtin_to_qual_type `ObjCId)
let create_char_type = builtin_to_type_ptr `Char_S let create_char_type = builtin_to_qual_type `Char_S
let create_char_star_type = pointerof_type_ptr create_char_type let create_char_star_type ~is_const = create_pointer_qual_type ~is_const create_char_type
let create_char_star_qual_type ~is_const = create_qual_type ~is_const create_char_star_type
let create_BOOL_type = builtin_to_type_ptr `SChar let create_BOOL_type = builtin_to_qual_type `SChar
let create_unsigned_long_type = builtin_to_type_ptr `ULong let create_unsigned_long_type = builtin_to_qual_type `ULong
let create_void_unsigned_long_type = function_type_ptr create_void_type let create_void_unsigned_long_type = function_type_ptr create_void_type
let create_void_void_type = function_type_ptr create_void_type let create_void_void_type = function_type_ptr create_void_type
let create_class_type typename = Clang_ast_extend.ClassType typename
let create_class_qual_type ?(is_const=false) typename = let create_class_qual_type ?(is_const=false) typename =
create_qual_type ~is_const @@ create_class_type typename create_qual_type ~is_const (Clang_ast_extend.ClassType typename)
let make_objc_class_type class_name =
create_class_type (Typ.Name.Objc.from_string class_name)
let create_pointer_type typ = Clang_ast_extend.PointerOf typ
let create_pointer_qual_type ~is_const typ = create_qual_type ~is_const @@ create_pointer_type typ
let create_reference_type typ = Clang_ast_extend.ReferenceOf typ let make_objc_class_qual_type class_name =
create_class_qual_type (Typ.Name.Objc.from_string class_name)
let create_integer_literal n = let create_integer_literal n =
let stmt_info = dummy_stmt_info () in let stmt_info = dummy_stmt_info () in
let expr_info = { let expr_info = {
Clang_ast_t.ei_type_ptr = create_int_type; Clang_ast_t.ei_qual_type = create_int_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -119,9 +117,9 @@ let create_integer_literal n =
} in } in
Clang_ast_t.IntegerLiteral (stmt_info, [], expr_info, integer_literal_info) Clang_ast_t.IntegerLiteral (stmt_info, [], expr_info, integer_literal_info)
let create_cstyle_cast_expr stmt_info stmts tp = let create_cstyle_cast_expr stmt_info stmts qt =
let expr_info = { let expr_info = {
Clang_ast_t.ei_type_ptr = create_void_star_type; Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -129,11 +127,11 @@ let create_cstyle_cast_expr stmt_info stmts tp =
Clang_ast_t.cei_cast_kind = `NullToPointer; Clang_ast_t.cei_cast_kind = `NullToPointer;
cei_base_path = []; cei_base_path = [];
} in } in
Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, tp) Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, qt)
let create_parent_expr stmt_info stmts = let create_parent_expr stmt_info stmts =
let expr_info = { let expr_info = {
Clang_ast_t.ei_type_ptr = create_void_star_type; Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -141,7 +139,7 @@ let create_parent_expr stmt_info stmts =
let create_implicit_cast_expr stmt_info stmts typ cast_kind = let create_implicit_cast_expr stmt_info stmts typ cast_kind =
let expr_info = { let expr_info = {
Clang_ast_t.ei_type_ptr = typ; Clang_ast_t.ei_qual_type = typ;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -167,14 +165,14 @@ let make_stmt_info di = {
si_source_range = di.Clang_ast_t.di_source_range; si_source_range = di.Clang_ast_t.di_source_range;
} }
let make_expr_info tp vk objc_kind = { let make_expr_info qt vk objc_kind = {
Clang_ast_t.ei_type_ptr = tp; Clang_ast_t.ei_qual_type = qt;
ei_value_kind = vk; ei_value_kind = vk;
ei_object_kind = objc_kind; ei_object_kind = objc_kind;
} }
let make_expr_info_with_objc_kind tp objc_kind = let make_expr_info_with_objc_kind qt objc_kind =
make_expr_info tp `LValue objc_kind make_expr_info qt `LValue objc_kind
let make_decl_ref_exp stmt_info expr_info drei = let make_decl_ref_exp stmt_info expr_info drei =
let stmt_info = { let stmt_info = {
@ -190,57 +188,43 @@ let make_obj_c_message_expr_info_instance sel = {
omei_decl_pointer = None; (* TODO look into it *) omei_decl_pointer = None; (* TODO look into it *)
} }
let make_obj_c_message_expr_info_class selector tp pointer = { let make_obj_c_message_expr_info_class selector tname pointer = {
Clang_ast_t.omei_selector = selector; Clang_ast_t.omei_selector = selector;
omei_receiver_kind = `Class (create_class_type tp); omei_receiver_kind = `Class (create_class_qual_type tname);
omei_is_definition_found = false; omei_is_definition_found = false;
omei_decl_pointer = pointer omei_decl_pointer = pointer
} }
let make_decl_ref k decl_ptr name is_hidden tp_opt = { let make_decl_ref k decl_ptr name is_hidden qt_opt = {
Clang_ast_t.dr_kind = k; Clang_ast_t.dr_kind = k;
dr_decl_pointer = decl_ptr; dr_decl_pointer = decl_ptr;
dr_name = Some name; dr_name = Some name;
dr_is_hidden = is_hidden ; dr_is_hidden = is_hidden ;
dr_type_ptr = tp_opt dr_qual_type = qt_opt
} }
let make_decl_ref_tp k decl_ptr name is_hidden tp = let make_decl_ref_qt k decl_ptr name is_hidden qt =
make_decl_ref k decl_ptr name is_hidden (Some tp) make_decl_ref k decl_ptr name is_hidden (Some qt)
let make_decl_ref_no_tp k decl_ptr name is_hidden = let make_decl_ref_no_qt k decl_ptr name is_hidden =
make_decl_ref k decl_ptr name is_hidden None make_decl_ref k decl_ptr name is_hidden None
let make_decl_ref_invalid k name is_hidden tp = let make_decl_ref_invalid k name is_hidden qt =
make_decl_ref k (CAst_utils.get_invalid_pointer ()) name is_hidden (Some tp) make_decl_ref k (CAst_utils.get_invalid_pointer ()) name is_hidden (Some qt)
let make_decl_ref_expr_info decl_ref = { let make_decl_ref_expr_info decl_ref = {
Clang_ast_t.drti_decl_ref = Some decl_ref; Clang_ast_t.drti_decl_ref = Some decl_ref;
drti_found_decl_ref = None; drti_found_decl_ref = None;
} }
let make_objc_ivar_decl decl_info tp ivar_name = let make_expr_info qt = {
let field_decl_info = { Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.fldi_is_mutable = true;
fldi_is_module_private = true;
fldi_init_expr = None;
fldi_bit_width_expr = None;
} in
let obj_c_ivar_decl_info = {
Clang_ast_t.ovdi_is_synthesize = true; (* NOTE: We set true here because we use this definition to synthesize the getter/setter*)
ovdi_access_control = `Private;
} in
let qt = create_qual_type tp in
Clang_ast_t.ObjCIvarDecl (decl_info, ivar_name, qt, field_decl_info, obj_c_ivar_decl_info)
let make_expr_info tp = {
Clang_ast_t.ei_type_ptr = tp;
ei_value_kind = `LValue; ei_value_kind = `LValue;
ei_object_kind = `ObjCProperty ei_object_kind = `ObjCProperty
} }
let make_general_expr_info tp vk ok = { let make_general_expr_info qt vk ok = {
Clang_ast_t.ei_type_ptr = tp; Clang_ast_t.ei_qual_type = qt;
ei_value_kind = vk; ei_value_kind = vk;
ei_object_kind = ok ei_object_kind = ok
} }
@ -249,15 +233,15 @@ let make_ObjCBoolLiteralExpr stmt_info value =
let ei = make_expr_info create_BOOL_type in let ei = make_expr_info create_BOOL_type in
Clang_ast_t.ObjCBoolLiteralExpr((fresh_stmt_info stmt_info),[], ei, value) Clang_ast_t.ObjCBoolLiteralExpr((fresh_stmt_info stmt_info),[], ei, value)
let make_message_expr param_tp selector decl_ref_exp stmt_info add_cast = let make_message_expr param_qt selector decl_ref_exp stmt_info add_cast =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in let stmt_info = stmt_info_with_fresh_pointer stmt_info in
let parameters = let parameters =
if add_cast then if add_cast then
let cast_expr = create_implicit_cast_expr stmt_info [decl_ref_exp] param_tp `LValueToRValue in let cast_expr = create_implicit_cast_expr stmt_info [decl_ref_exp] param_qt `LValueToRValue in
[cast_expr] [cast_expr]
else [decl_ref_exp] in else [decl_ref_exp] in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance selector in let obj_c_message_expr_info = make_obj_c_message_expr_info_instance selector in
let expr_info = make_expr_info_with_objc_kind param_tp `ObjCProperty in let expr_info = make_expr_info_with_objc_kind param_qt `ObjCProperty in
Clang_ast_t.ObjCMessageExpr (stmt_info, parameters, expr_info, obj_c_message_expr_info) Clang_ast_t.ObjCMessageExpr (stmt_info, parameters, expr_info, obj_c_message_expr_info)
let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi = let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi =
@ -268,17 +252,16 @@ let make_next_object_exp stmt_info item items =
let var_decl_ref, var_type = let var_decl_ref, var_type =
match item with match item with
| Clang_ast_t.DeclStmt (_, _, [Clang_ast_t.VarDecl(di, name_info, var_qual_type, _)]) -> | Clang_ast_t.DeclStmt (_, _, [Clang_ast_t.VarDecl(di, name_info, var_qual_type, _)]) ->
let var_type = var_qual_type.Clang_ast_t.qt_type_ptr in
let decl_ptr = di.Clang_ast_t.di_pointer in let decl_ptr = di.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_tp `Var decl_ptr name_info false var_type in let decl_ref = make_decl_ref_qt `Var decl_ptr name_info false var_qual_type in
let stmt_info_var = { let stmt_info_var = {
Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer; Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range si_source_range = di.Clang_ast_t.di_source_range
} in } in
let expr_info = make_expr_info_with_objc_kind var_type `ObjCProperty in let expr_info = make_expr_info_with_objc_kind var_qual_type `ObjCProperty in
let decl_ref_expr_info = make_decl_ref_expr_info decl_ref in let decl_ref_expr_info = make_decl_ref_expr_info decl_ref in
Clang_ast_t.DeclRefExpr (stmt_info_var, [], expr_info, decl_ref_expr_info), Clang_ast_t.DeclRefExpr (stmt_info_var, [], expr_info, decl_ref_expr_info),
var_type var_qual_type
| _ -> assert false in | _ -> assert false in
let message_call = make_message_expr create_id_type let message_call = make_message_expr create_id_type
CFrontend_config.next_object items stmt_info false in CFrontend_config.next_object items stmt_info false in
@ -302,16 +285,15 @@ let translate_dispatch_function stmt_info stmt_list n =
CallExpr (stmt_info, [arg_stmt], expr_info_call) CallExpr (stmt_info, [arg_stmt], expr_info_call)
| _ -> assert false | _ -> assert false
(* Create declaration statement: tp vname = iexp *) (* Create declaration statement: qt vname = iexp *)
let make_DeclStmt stmt_info di tp vname old_vdi iexp = let make_DeclStmt stmt_info di qt vname old_vdi iexp =
let init_expr_opt, init_expr_l = match iexp with let init_expr_opt, init_expr_l = match iexp with
| Some iexp' -> | Some iexp' ->
let ie = create_implicit_cast_expr stmt_info [iexp'] tp `IntegralCast in let ie = create_implicit_cast_expr stmt_info [iexp'] qt `IntegralCast in
Some ie, [ie] Some ie, [ie]
| None -> None, [] in | None -> None, [] in
let var_decl_info = { old_vdi with Clang_ast_t.vdi_init_expr = init_expr_opt } in let var_decl_info = { old_vdi with Clang_ast_t.vdi_init_expr = init_expr_opt } in
let di = fresh_decl_info di in let di = fresh_decl_info di in
let qt = create_qual_type tp in
let var_decl = Clang_ast_t.VarDecl (di, vname, qt, var_decl_info) in let var_decl = Clang_ast_t.VarDecl (di, vname, qt, var_decl_info) in
Clang_ast_t.DeclStmt (stmt_info, init_expr_l, [var_decl]) Clang_ast_t.DeclStmt (stmt_info, init_expr_l, [var_decl])
@ -319,40 +301,40 @@ let build_OpaqueValueExpr si source_expr ei =
let opaque_value_expr_info = { Clang_ast_t.ovei_source_expr = Some source_expr } in let opaque_value_expr_info = { Clang_ast_t.ovei_source_expr = Some source_expr } in
Clang_ast_t.OpaqueValueExpr (si, [], ei, opaque_value_expr_info) Clang_ast_t.OpaqueValueExpr (si, [], ei, opaque_value_expr_info)
let pseudo_object_tp () = make_objc_class_type CFrontend_config.pseudo_object_type let pseudo_object_qt = make_objc_class_qual_type CFrontend_config.pseudo_object_type
(* Create expression PseudoObjectExpr for 'o.m' *) (* Create expression PseudoObjectExpr for 'o.m' *)
let build_PseudoObjectExpr tp_m o_cast_decl_ref_exp mname = let build_PseudoObjectExpr qt_m o_cast_decl_ref_exp mname =
match o_cast_decl_ref_exp with match o_cast_decl_ref_exp with
| Clang_ast_t.ImplicitCastExpr (si, _, ei, _) -> | Clang_ast_t.ImplicitCastExpr (si, _, ei, _) ->
let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in let ove = build_OpaqueValueExpr si o_cast_decl_ref_exp ei in
let ei_opre = make_expr_info (pseudo_object_tp ()) in let ei_opre = make_expr_info pseudo_object_qt in
let count_name = CAst_utils.make_name_decl CFrontend_config.count in let count_name = CAst_utils.make_name_decl CFrontend_config.count in
let pointer = si.Clang_ast_t.si_pointer in let pointer = si.Clang_ast_t.si_pointer in
let obj_c_property_ref_expr_info = { let obj_c_property_ref_expr_info = {
Clang_ast_t.oprei_kind = Clang_ast_t.oprei_kind =
`PropertyRef (make_decl_ref_no_tp `ObjCProperty pointer count_name false); `PropertyRef (make_decl_ref_no_qt `ObjCProperty pointer count_name false);
oprei_is_super_receiver = false; oprei_is_super_receiver = false;
oprei_is_messaging_getter = true; oprei_is_messaging_getter = true;
oprei_is_messaging_setter = false; oprei_is_messaging_setter = false;
} in } in
let opre = Clang_ast_t.ObjCPropertyRefExpr (si, [ove], ei_opre, obj_c_property_ref_expr_info) in let opre = Clang_ast_t.ObjCPropertyRefExpr (si, [ove], ei_opre, obj_c_property_ref_expr_info) in
let ome = make_message_expr tp_m mname o_cast_decl_ref_exp si false in let ome = make_message_expr qt_m mname o_cast_decl_ref_exp si false in
let poe_ei = make_general_expr_info tp_m `LValue `Ordinary in let poe_ei = make_general_expr_info qt_m `LValue `Ordinary in
Clang_ast_t.PseudoObjectExpr (si, [opre; ove; ome], poe_ei) Clang_ast_t.PseudoObjectExpr (si, [opre; ove; ome], poe_ei)
| _ -> assert false | _ -> assert false
let create_call stmt_info decl_pointer function_name tp parameters = let create_call stmt_info decl_pointer function_name qt parameters =
let expr_info_call = { let expr_info_call = {
Clang_ast_t.ei_type_ptr = create_void_star_type; Clang_ast_t.ei_qual_type = create_void_star_type;
ei_value_kind = `XValue; ei_value_kind = `XValue;
ei_object_kind = `Ordinary ei_object_kind = `Ordinary
} in } in
let expr_info_dre = make_expr_info_with_objc_kind tp `Ordinary in let expr_info_dre = make_expr_info_with_objc_kind qt `Ordinary in
let decl_ref = make_decl_ref_tp `Function decl_pointer function_name false tp in let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in
let decl_ref_info = make_decl_ref_expr_info decl_ref in let decl_ref_info = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = Clang_ast_t.DeclRefExpr (stmt_info, [], expr_info_dre, decl_ref_info) in let decl_ref_exp = Clang_ast_t.DeclRefExpr (stmt_info, [], expr_info_dre, decl_ref_info) in
let cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] tp `FunctionToPointerDecay in let cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] qt `FunctionToPointerDecay in
Clang_ast_t.CallExpr (stmt_info, cast:: parameters, expr_info_call) Clang_ast_t.CallExpr (stmt_info, cast:: parameters, expr_info_call)
(* For a of type NSArray* Translate (* For a of type NSArray* Translate
@ -383,8 +365,8 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let rec get_name_pointers lp = let rec get_name_pointers lp =
match lp with match lp with
| [] -> [] | [] -> []
| Clang_ast_t.ParmVarDecl (di, name, tp, _) :: lp' -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) :: lp' ->
(name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, tp):: get_name_pointers lp' (name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, qt):: get_name_pointers lp'
| _ -> assert false in | _ -> assert false in
let build_idx_decl pidx = let build_idx_decl pidx =
@ -392,51 +374,48 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, vdi) -> | Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, vdi) ->
let zero = create_integer_literal "0" in let zero = create_integer_literal "0" in
(* qt_idx idx = 0; *) (* qt_idx idx = 0; *)
let tp_idx = qt_idx.Clang_ast_t.qt_type_ptr in let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx qt_idx
let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx tp_idx
name_idx vdi (Some zero) in name_idx vdi (Some zero) in
let idx_ei = make_expr_info tp_idx in let idx_ei = make_expr_info qt_idx in
let pointer = di_idx.Clang_ast_t.di_pointer in let pointer = di_idx.Clang_ast_t.di_pointer in
let idx_decl_ref = make_decl_ref_tp `Var pointer name_idx false tp_idx in let idx_decl_ref = make_decl_ref_qt `Var pointer name_idx false qt_idx in
let idx_drei = make_decl_ref_expr_info idx_decl_ref in let idx_drei = make_decl_ref_expr_info idx_decl_ref in
let idx_decl_ref_exp = make_decl_ref_exp stmt_info idx_ei idx_drei in let idx_decl_ref_exp = make_decl_ref_exp stmt_info idx_ei idx_drei in
let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp] let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp]
tp_idx `LValueToRValue in qt_idx `LValueToRValue in
idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx idx_decl_stmt, idx_decl_ref_exp, idx_cast, qt_idx
| _ -> assert false in | _ -> assert false in
let cast_expr decl_ref tp = let cast_expr decl_ref qt =
let ei = make_expr_info tp in let ei = make_expr_info qt in
let drei = make_decl_ref_expr_info decl_ref in let drei = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = make_decl_ref_exp (fresh_stmt_info stmt_info) ei drei in let decl_ref_exp = make_decl_ref_exp (fresh_stmt_info stmt_info) ei drei in
create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] tp `LValueToRValue in create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] qt `LValueToRValue in
(* build statement BOOL *stop = malloc(sizeof(BOOL)); *) (* build statement BOOL *stop = malloc(sizeof(BOOL)); *)
let build_stop pstop = let build_stop pstop =
match pstop with match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, vdi) -> | Clang_ast_t.ParmVarDecl (di, name, qt, vdi) ->
let tp_fun = create_void_unsigned_long_type in let qt_fun = create_void_unsigned_long_type in
let type_opt = Some create_BOOL_type in let type_opt = Some create_BOOL_type in
let parameter = Clang_ast_t.UnaryExprOrTypeTraitExpr let parameter = Clang_ast_t.UnaryExprOrTypeTraitExpr
((fresh_stmt_info stmt_info), [], ((fresh_stmt_info stmt_info), [],
make_general_expr_info create_unsigned_long_type `RValue `Ordinary, make_general_expr_info create_unsigned_long_type `RValue `Ordinary,
{ Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_type_ptr = type_opt}) in { Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_qual_type = type_opt}) in
let pointer = di.Clang_ast_t.di_pointer in let pointer = di.Clang_ast_t.di_pointer in
let stmt_info = fresh_stmt_info stmt_info in let stmt_info = fresh_stmt_info stmt_info in
let malloc_name = CAst_utils.make_name_decl CFrontend_config.malloc in let malloc_name = CAst_utils.make_name_decl CFrontend_config.malloc in
let malloc = create_call stmt_info pointer malloc_name tp_fun [parameter] in let malloc = create_call stmt_info pointer malloc_name qt_fun [parameter] in
let tp = qt.Clang_ast_t.qt_type_ptr in let init_exp = create_implicit_cast_expr (fresh_stmt_info stmt_info) [malloc] qt `BitCast in
let init_exp = create_implicit_cast_expr (fresh_stmt_info stmt_info) [malloc] tp `BitCast in make_DeclStmt (fresh_stmt_info stmt_info) di qt name vdi (Some init_exp)
make_DeclStmt (fresh_stmt_info stmt_info) di tp name vdi (Some init_exp)
| _ -> assert false in | _ -> assert false in
(* BOOL *stop =NO; *) (* BOOL *stop =NO; *)
let stop_equal_no pstop = let stop_equal_no pstop =
match pstop with match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in let cast = cast_expr decl_ref qt in
let cast = cast_expr decl_ref tp in
let postfix_deref = { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true } in let postfix_deref = { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true } in
let lhs = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [cast], ei, postfix_deref) in let lhs = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [cast], ei, postfix_deref) in
let bool_NO = make_ObjCBoolLiteralExpr stmt_info 0 in let bool_NO = make_ObjCBoolLiteralExpr stmt_info 0 in
@ -448,28 +427,27 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let free_stop pstop = let free_stop pstop =
match pstop with match pstop with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in let qt_fun = create_void_void_type in
let tp_fun = create_void_void_type in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in let cast = cast_expr decl_ref qt in
let cast = cast_expr decl_ref tp in
let free_name = CAst_utils.make_name_decl CFrontend_config.free in let free_name = CAst_utils.make_name_decl CFrontend_config.free in
let parameter = let parameter =
create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] create_void_star_type `BitCast in create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] create_void_star_type `BitCast in
let pointer = di.Clang_ast_t.di_pointer in let pointer = di.Clang_ast_t.di_pointer in
create_call (fresh_stmt_info stmt_info) pointer free_name tp_fun [parameter] create_call (fresh_stmt_info stmt_info) pointer free_name qt_fun [parameter]
| _ -> assert false in | _ -> assert false in
(* idx<a.count *) (* idx<a.count *)
let bin_op pidx array_decl_ref_exp = let bin_op pidx array_decl_ref_exp =
let _, _, idx_cast, idx_tp = build_idx_decl pidx in let _, _, idx_cast, idx_qt = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_tp array_decl_ref_exp CFrontend_config.count in let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in
let lt = { Clang_ast_t.boi_kind = `LT } in let lt = { Clang_ast_t.boi_kind = `LT } in
let exp_info = make_expr_info create_int_type in let exp_info = make_expr_info create_int_type in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [idx_cast; rhs], exp_info, lt) in Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [idx_cast; rhs], exp_info, lt) in
(* idx++ *) (* idx++ *)
let un_op idx_decl_ref_expr tp_idx = let un_op idx_decl_ref_expr qt_idx =
let idx_ei = make_expr_info tp_idx in let idx_ei = make_expr_info qt_idx in
let postinc = { Clang_ast_t.uoi_kind = `PostInc; uoi_is_postfix = true } in let postinc = { Clang_ast_t.uoi_kind = `PostInc; uoi_is_postfix = true } in
Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [idx_decl_ref_expr], idx_ei, postinc) in Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [idx_decl_ref_expr], idx_ei, postinc) in
@ -483,14 +461,13 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let open Clang_ast_t in let open Clang_ast_t in
match pobj with match pobj with
| ParmVarDecl(di_obj, name_obj, qt_obj, _) -> | ParmVarDecl(di_obj, name_obj, qt_obj, _) ->
let tp_obj = qt_obj.Clang_ast_t.qt_type_ptr in let poe_ei = make_general_expr_info qt_obj `RValue `Ordinary in
let poe_ei = make_general_expr_info tp_obj `RValue `Ordinary in
let ei_array = get_ei_from_cast decl_ref_expr_array in let ei_array = get_ei_from_cast decl_ref_expr_array in
let ove_array = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_array ei_array in let ove_array = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_array ei_array in
let ei_idx = get_ei_from_cast decl_ref_expr_idx in let ei_idx = get_ei_from_cast decl_ref_expr_idx in
let ove_idx = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_idx ei_idx in let ove_idx = build_OpaqueValueExpr (fresh_stmt_info stmt_info) decl_ref_expr_idx ei_idx in
let objc_sre = ObjCSubscriptRefExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx], let objc_sre = ObjCSubscriptRefExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx],
make_expr_info (pseudo_object_tp ()), make_expr_info pseudo_object_qt,
{ osrei_kind =`ArraySubscript; osrei_getter = None; osrei_setter = None; }) in { osrei_kind =`ArraySubscript; osrei_getter = None; osrei_setter = None; }) in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config.object_at_indexed_subscript_m in let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config.object_at_indexed_subscript_m in
let ome = ObjCMessageExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in let ome = ObjCMessageExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in
@ -503,28 +480,26 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* NSArray *objects = a *) (* NSArray *objects = a *)
let objects_array_DeclStmt init = let objects_array_DeclStmt init =
let di = { empty_decl_info with Clang_ast_t.di_pointer = CAst_utils.get_fresh_pointer () } in let di = { empty_decl_info with Clang_ast_t.di_pointer = CAst_utils.get_fresh_pointer () } in
let tp = create_qual_type @@ create_pointer_type @@ let qt = create_pointer_qual_type ~is_const:false @@
make_objc_class_type CFrontend_config.nsarray_cl in make_objc_class_qual_type CFrontend_config.nsarray_cl in
(* init should be ImplicitCastExpr of array a *) (* init should be ImplicitCastExpr of array a *)
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (init) } in let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (init) } in
let objects_name = CAst_utils.make_name_decl CFrontend_config.objects in let objects_name = CAst_utils.make_name_decl CFrontend_config.objects in
let var_decl = Clang_ast_t.VarDecl (di, objects_name, tp, vdi) in let var_decl = Clang_ast_t.VarDecl (di, objects_name, qt, vdi) in
Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, tp)] in Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, qt)] in
let make_object_cast_decl_ref_expr objects = let make_object_cast_decl_ref_expr objects =
match objects with match objects with
| Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (_, name, qt, _)]) -> | Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (_, name, qt, _)]) ->
let tp = qt.Clang_ast_t.qt_type_ptr in let decl_ref = make_decl_ref_qt `Var si.Clang_ast_t.si_pointer name false qt in
let decl_ref = make_decl_ref_tp `Var si.Clang_ast_t.si_pointer name false tp in cast_expr decl_ref qt
cast_expr decl_ref tp
| _ -> assert false in | _ -> assert false in
let build_cast_decl_ref_expr_from_parm p = let build_cast_decl_ref_expr_from_parm p =
match p with match p with
| Clang_ast_t.ParmVarDecl (di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let tp = qt.Clang_ast_t.qt_type_ptr in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name false qt in
let decl_ref = make_decl_ref_tp `Var di.Clang_ast_t.di_pointer name false tp in cast_expr decl_ref qt
cast_expr decl_ref tp
| _ -> assert false in | _ -> assert false in
let qual_block_name = CAst_utils.make_name_decl block_name in let qual_block_name = CAst_utils.make_name_decl block_name in
@ -534,41 +509,41 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| Clang_ast_t.BlockExpr (bsi, _, bei, _) -> | Clang_ast_t.BlockExpr (bsi, _, bei, _) ->
let di = { empty_decl_info with di_pointer = CAst_utils.get_fresh_pointer () } in let di = { empty_decl_info with di_pointer = CAst_utils.get_fresh_pointer () } in
let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (be) } in let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (be) } in
let qt = create_qual_type bei.Clang_ast_t.ei_type_ptr in let qt = bei.Clang_ast_t.ei_qual_type in
let var_decl = Clang_ast_t.VarDecl (di, qual_block_name, qt, vdi) in let var_decl = Clang_ast_t.VarDecl (di, qual_block_name, qt, vdi) in
Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, qt)] Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, qt)]
| _ -> assert false in | _ -> assert false in
let make_block_call block_tp object_cast idx_cast stop_cast = let make_block_call block_qt object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_tp in let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_qt in
let fun_cast = cast_expr decl_ref block_tp in let fun_cast = cast_expr decl_ref block_qt in
let ei_call = make_expr_info create_void_star_type in let ei_call = make_expr_info create_void_star_type in
Clang_ast_t.CallExpr (fresh_stmt_info stmt_info, [fun_cast; object_cast; idx_cast; stop_cast], ei_call) in Clang_ast_t.CallExpr (fresh_stmt_info stmt_info, [fun_cast; object_cast; idx_cast; stop_cast], ei_call) in
(* build statement "if (stop) break;" *) (* build statement "if (stop) break;" *)
let build_if_stop stop_cast = let build_if_stop stop_cast =
let bool_tp = create_BOOL_type in let bool_qt = create_BOOL_type in
let ei = make_expr_info bool_tp in let ei = make_expr_info bool_qt in
let unary_op = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [stop_cast], ei, { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true }) in let unary_op = Clang_ast_t.UnaryOperator (fresh_stmt_info stmt_info, [stop_cast], ei, { Clang_ast_t.uoi_kind = `Deref; uoi_is_postfix = true }) in
let cond = create_implicit_cast_expr (fresh_stmt_info stmt_info) [unary_op] bool_tp `LValueToRValue in let cond = create_implicit_cast_expr (fresh_stmt_info stmt_info) [unary_op] bool_qt `LValueToRValue in
let break_stmt = Clang_ast_t.BreakStmt (fresh_stmt_info stmt_info, []) in let break_stmt = Clang_ast_t.BreakStmt (fresh_stmt_info stmt_info, []) in
Clang_ast_t.IfStmt Clang_ast_t.IfStmt
(fresh_stmt_info stmt_info, [dummy_stmt(); dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in (fresh_stmt_info stmt_info, [dummy_stmt(); dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in
let translate params array_cast_decl_ref_exp block_decl block_tp = let translate params array_cast_decl_ref_exp block_decl block_qt =
match params with match params with
| [pobj; pidx; pstop] -> | [pobj; pidx; pstop] ->
let objects_decl, op = objects_array_DeclStmt array_cast_decl_ref_exp in let objects_decl, op = objects_array_DeclStmt array_cast_decl_ref_exp in
let decl_stop = build_stop pstop in let decl_stop = build_stop pstop in
let assign_stop = stop_equal_no pstop in let assign_stop = stop_equal_no pstop in
let objects = make_object_cast_decl_ref_expr objects_decl in let objects = make_object_cast_decl_ref_expr objects_decl in
let idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx = build_idx_decl pidx in let idx_decl_stmt, idx_decl_ref_exp, idx_cast, qt_idx = build_idx_decl pidx in
let guard = bin_op pidx objects in let guard = bin_op pidx objects in
let incr = un_op idx_decl_ref_exp tp_idx in let incr = un_op idx_decl_ref_exp qt_idx in
let obj_assignment = build_object_DeclStmt pobj objects idx_cast in let obj_assignment = build_object_DeclStmt pobj objects idx_cast in
let object_cast = build_cast_decl_ref_expr_from_parm pobj in let object_cast = build_cast_decl_ref_expr_from_parm pobj in
let stop_cast = build_cast_decl_ref_expr_from_parm pstop in let stop_cast = build_cast_decl_ref_expr_from_parm pstop in
let call_block = make_block_call block_tp object_cast idx_cast stop_cast in let call_block = make_block_call block_qt object_cast idx_cast stop_cast in
let if_stop = build_if_stop stop_cast in let if_stop = build_if_stop stop_cast in
let free_stop = free_stop pstop in let free_stop = free_stop pstop in
[ objects_decl; block_decl; decl_stop; assign_stop; [ objects_decl; block_decl; decl_stop; assign_stop;
@ -580,7 +555,7 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| [s; BlockExpr (_, _, bei, BlockDecl (_, bdi)) as be] -> | [s; BlockExpr (_, _, bei, BlockDecl (_, bdi)) as be] ->
let block_decl, bv = make_block_decl be in let block_decl, bv = make_block_decl be in
let vars_to_register = get_name_pointers bdi.bdi_parameters in let vars_to_register = get_name_pointers bdi.bdi_parameters in
let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_type_ptr in let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_qual_type in
CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv
| _ -> (* When it is not the method we expect with only one parameter, we don't translate *) | _ -> (* When it is not the method we expect with only one parameter, we don't translate *)
Logging.out_debug "WARNING: Block Enumeration called at %s not translated." Logging.out_debug "WARNING: Block Enumeration called at %s not translated."
@ -592,27 +567,3 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
let trans_negation_with_conditional stmt_info expr_info stmt_list = let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal "0"] @ [create_integer_literal "1"] in let stmt_list_cond = stmt_list @ [create_integer_literal "0"] @ [create_integer_literal "1"] in
Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info) Clang_ast_t.ConditionalOperator (stmt_info, stmt_list_cond, expr_info)
let create_assume_not_null_call decl_info var_name var_type =
let stmt_info = stmt_info_with_fresh_pointer (make_stmt_info decl_info) in
let boi = { Clang_ast_t.boi_kind = `NE } in
let decl_ptr = decl_info.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_tp `Var decl_ptr var_name false var_type in
let stmt_info_var = dummy_stmt_info () in
let decl_ref_info = make_decl_ref_expr_info decl_ref in
let var_decl_ref = Clang_ast_t.DeclRefExpr (stmt_info_var, [], (make_expr_info var_type), decl_ref_info) in
let var_decl_ptr = CAst_utils.get_invalid_pointer () in
let expr_info = {
Clang_ast_t.ei_type_ptr = var_type;
ei_value_kind = `RValue;
ei_object_kind = `Ordinary
} in
let cast_info_call = { Clang_ast_t.cei_cast_kind = `LValueToRValue; cei_base_path = [] } in
let decl_ref_exp_cast = Clang_ast_t.ImplicitCastExpr (stmt_info, [var_decl_ref], expr_info, cast_info_call) in
let null_expr = create_integer_literal "0" in
let bin_op_expr_info = make_general_expr_info create_BOOL_type `RValue `Ordinary in
let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info bin_op_expr_info boi in
let parameters = [bin_op] in
let procname = Typ.Procname.to_string BuiltinDecl.__infer_assume in
let qual_procname = CAst_utils.make_name_decl procname in
create_call stmt_info var_decl_ptr qual_procname create_void_star_type parameters

35
infer/src/clang/ast_expressions.mli
Unescape View File

@ -19,49 +19,34 @@ val dummy_source_range : unit -> source_range
val dummy_stmt_info : unit -> stmt_info val dummy_stmt_info : unit -> stmt_info
val create_qual_type : ?is_const:bool -> type_ptr -> qual_type val create_class_qual_type : ?is_const:bool -> Typ.Name.t -> qual_type
val create_char_star_type : type_ptr val create_pointer_qual_type : is_const:bool -> qual_type -> qual_type
val create_char_star_qual_type : is_const:bool -> qual_type
val create_id_type : type_ptr val create_reference_qual_type : is_const:bool -> qual_type -> qual_type
val create_void_type : type_ptr val create_char_star_type : is_const:bool -> qual_type
val create_int_type : type_ptr val create_id_type : qual_type
val create_BOOL_type : type_ptr val create_void_type : qual_type
val create_class_type : Typ.Name.t -> type_ptr val create_int_type : qual_type
val create_class_qual_type : ?is_const:bool -> Typ.Name.t -> qual_type
val create_pointer_type : type_ptr -> type_ptr val create_BOOL_type : qual_type
val create_pointer_qual_type : is_const:bool -> type_ptr -> qual_type
val create_integer_literal : string -> stmt val create_integer_literal : string -> stmt
val create_reference_type : type_ptr -> type_ptr
val make_objc_ivar_decl : decl_info -> type_ptr -> named_decl_info -> decl
val make_stmt_info : decl_info -> stmt_info val make_stmt_info : decl_info -> stmt_info
val make_decl_ref_tp : decl_kind -> pointer -> named_decl_info -> bool -> type_ptr -> decl_ref
val make_decl_ref_expr_info : decl_ref -> decl_ref_expr_info val make_decl_ref_expr_info : decl_ref -> decl_ref_expr_info
val make_general_expr_info : type_ptr -> value_kind -> object_kind -> expr_info
val make_expr_info : type_ptr -> expr_info
val make_next_object_exp : stmt_info -> stmt -> Clang_ast_t.stmt -> val make_next_object_exp : stmt_info -> stmt -> Clang_ast_t.stmt ->
Clang_ast_t.stmt * Clang_ast_t.stmt Clang_ast_t.stmt * Clang_ast_t.stmt
val create_nil : stmt_info -> stmt val create_nil : stmt_info -> stmt
val create_implicit_cast_expr : stmt_info -> stmt list -> type_ptr -> cast_kind -> stmt val create_implicit_cast_expr : stmt_info -> stmt list -> qual_type -> cast_kind -> stmt
val make_message_expr : type_ptr -> string -> stmt -> stmt_info -> bool -> stmt
val make_binary_stmt : stmt -> stmt -> stmt_info -> expr_info -> binary_operator_info -> stmt val make_binary_stmt : stmt -> stmt -> stmt_info -> expr_info -> binary_operator_info -> stmt
@ -78,5 +63,3 @@ val translate_block_enumerate : string -> stmt_info -> stmt list -> expr_info
(* We translate the logical negation of an integer with a conditional*) (* We translate the logical negation of an integer with a conditional*)
(* !x <=> x?0:1 *) (* !x <=> x?0:1 *)
val trans_negation_with_conditional : stmt_info -> expr_info -> stmt list -> stmt val trans_negation_with_conditional : stmt_info -> expr_info -> stmt list -> stmt
val create_assume_not_null_call : decl_info -> named_decl_info -> type_ptr -> stmt

65
infer/src/clang/cAst_utils.ml
Unescape View File

@ -15,7 +15,7 @@ open! PVariant
module L = Logging module L = Logging
module F = Format module F = Format
type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t type qual_type_to_sil_type = Tenv.t -> Clang_ast_t.qual_type -> Typ.t
let sanitize_name = Str.global_replace (Str.regexp "[/ ]") "_" let sanitize_name = Str.global_replace (Str.regexp "[/ ]") "_"
let get_qual_name qual_name_list = let get_qual_name qual_name_list =
@ -56,7 +56,7 @@ let get_invalid_pointer () =
CFrontend_config.invalid_pointer CFrontend_config.invalid_pointer
let type_from_unary_expr_or_type_trait_expr_info info = let type_from_unary_expr_or_type_trait_expr_info info =
match info.Clang_ast_t.uttei_type_ptr with match info.Clang_ast_t.uttei_qual_type with
| Some tp -> Some tp | Some tp -> Some tp
| None -> None | None -> None
@ -145,16 +145,7 @@ let get_decl_from_typ_ptr typ_ptr =
| Clang_ast_t.ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr | Clang_ast_t.ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr
| _ -> None | _ -> None
(* TODO take the attributes into account too. To be done after we get the attribute's arguments. *) let sil_annot_of_type {Clang_ast_t.qt_type_ptr} =
let is_type_nonnull type_ptr =
let open Clang_ast_t in
match get_type type_ptr with
| Some AttributedType (_, attr_info) ->
attr_info.ati_attr_kind = `Nonnull
| _ ->
false
let sil_annot_of_type type_ptr =
let default_visibility = true in let default_visibility = true in
let mk_annot annot_name_opt = let mk_annot annot_name_opt =
match annot_name_opt with match annot_name_opt with
@ -162,7 +153,7 @@ let sil_annot_of_type type_ptr =
[{ Annot.class_name = annot_name; parameters = []; }, default_visibility] [{ Annot.class_name = annot_name; parameters = []; }, default_visibility]
| None -> Annot.Item.empty in | None -> Annot.Item.empty in
let annot_name_opt = let annot_name_opt =
match get_type type_ptr with match get_type qt_type_ptr with
| Some AttributedType (_, attr_info) -> | Some AttributedType (_, attr_info) ->
if attr_info.ati_attr_kind = `Nullable then Some Annotations.nullable if attr_info.ati_attr_kind = `Nullable then Some Annotations.nullable
else if attr_info.ati_attr_kind = `Nonnull then Some Annotations.nonnull else if attr_info.ati_attr_kind = `Nonnull then Some Annotations.nonnull
@ -177,8 +168,8 @@ let name_of_typedef_type_info {Clang_ast_t.tti_decl_ptr} =
get_qualified_name name_decl_info get_qualified_name name_decl_info
| _ -> QualifiedCppName.empty | _ -> QualifiedCppName.empty
let name_opt_of_typedef_type_ptr type_ptr = let name_opt_of_typedef_qual_type qual_type =
match get_type type_ptr with match get_type qual_type.Clang_ast_t.qt_type_ptr with
| Some Clang_ast_t.TypedefType (_, typedef_type_info) -> | Some Clang_ast_t.TypedefType (_, typedef_type_info) ->
Some (name_of_typedef_type_info typedef_type_info) Some (name_of_typedef_type_info typedef_type_info)
| _ -> None | _ -> None
@ -188,16 +179,24 @@ let string_of_qual_type {Clang_ast_t.qt_type_ptr; qt_is_const} =
(if qt_is_const then "is_const " else "") (if qt_is_const then "is_const " else "")
(Clang_ast_extend.type_ptr_to_string qt_type_ptr) (Clang_ast_extend.type_ptr_to_string qt_type_ptr)
let add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt fail_if_not_found = let qual_type_of_decl_ptr decl_ptr = {
(* This function needs to be in this module - CAst_utils can't depend on
Ast_expressions *)
Clang_ast_t.qt_type_ptr=Clang_ast_extend.DeclPtr decl_ptr;
qt_is_const=false
}
let add_type_from_decl_ref qual_type_to_sil_type tenv dr =
let qual_type = qual_type_of_decl_ptr dr.Clang_ast_t.dr_decl_pointer in
ignore (qual_type_to_sil_type tenv qual_type)
let add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt fail_if_not_found =
match decl_ref_opt with (* translate interface first if found *) match decl_ref_opt with (* translate interface first if found *)
| Some dr -> | Some dr -> add_type_from_decl_ref qual_type_to_sil_type tenv dr
ignore (type_ptr_to_sil_type tenv (Clang_ast_extend.DeclPtr dr.Clang_ast_t.dr_decl_pointer));
| _ -> if fail_if_not_found then assert false else () | _ -> 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_type_from_decl_ref_list qual_type_to_sil_type tenv decl_ref_list =
let add_elem dr = List.iter ~f:(add_type_from_decl_ref qual_type_to_sil_type tenv) decl_ref_list
ignore (type_ptr_to_sil_type tenv (Clang_ast_extend.DeclPtr dr.Clang_ast_t.dr_decl_pointer)) in
List.iter ~f:add_elem decl_ref_list
let get_function_decl_with_body decl_ptr = let get_function_decl_with_body decl_ptr =
let open Clang_ast_t in let open Clang_ast_t in
@ -216,8 +215,8 @@ let get_function_decl_with_body decl_ptr =
let get_info_from_decl_ref decl_ref = let get_info_from_decl_ref decl_ref =
let name_info = match decl_ref.Clang_ast_t.dr_name with Some ni -> ni | _ -> assert false in let name_info = match decl_ref.Clang_ast_t.dr_name with Some ni -> ni | _ -> assert false in
let decl_ptr = decl_ref.Clang_ast_t.dr_decl_pointer in let decl_ptr = decl_ref.Clang_ast_t.dr_decl_pointer in
let type_ptr = match decl_ref.Clang_ast_t.dr_type_ptr with Some tp -> tp | _ -> assert false in let qual_type = match decl_ref.Clang_ast_t.dr_qual_type with Some tp -> tp | _ -> assert false in
name_info, decl_ptr, type_ptr name_info, decl_ptr, qual_type
(* st |= EF (atomic_pred param) *) (* st |= EF (atomic_pred param) *)
let rec exists_eventually_st atomic_pred param st = let rec exists_eventually_st atomic_pred param st =
@ -349,20 +348,20 @@ let rec is_objc_if_descendant ?(blacklist = default_blacklist) if_decl ancestors
|| is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors) || is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors)
| _ -> false | _ -> false
let rec type_ptr_to_objc_interface type_ptr = let rec qual_type_to_objc_interface qual_type =
let typ_opt = get_desugared_type type_ptr in let typ_opt = get_desugared_type (qual_type.Clang_ast_t.qt_type_ptr) in
ctype_to_objc_interface typ_opt ctype_to_objc_interface typ_opt
and ctype_to_objc_interface typ_opt = and ctype_to_objc_interface typ_opt =
match (typ_opt : Clang_ast_t.c_type option) with match (typ_opt : Clang_ast_t.c_type option) with
| Some ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr | Some ObjCInterfaceType (_, decl_ptr) -> get_decl decl_ptr
| Some ObjCObjectPointerType (_, (inner_qual_type: Clang_ast_t.qual_type)) -> | Some ObjCObjectPointerType (_, (inner_qual_type: Clang_ast_t.qual_type)) ->
type_ptr_to_objc_interface inner_qual_type.qt_type_ptr qual_type_to_objc_interface inner_qual_type
| Some FunctionProtoType (_, function_type_info, _) | Some FunctionProtoType (_, function_type_info, _)
| Some FunctionNoProtoType (_, function_type_info) -> | Some FunctionNoProtoType (_, function_type_info) ->
type_ptr_to_objc_interface function_type_info.Clang_ast_t.fti_return_type qual_type_to_objc_interface function_type_info.Clang_ast_t.fti_return_type
| _ -> None | _ -> None
let type_ptr_is_typedef_named type_ptr (type_name: string): bool = let qual_type_is_typedef_named qual_type (type_name: string): bool =
let is_decl_name_match decl_opt = let is_decl_name_match decl_opt =
let tuple_opt = match decl_opt with let tuple_opt = match decl_opt with
| Some decl -> Clang_ast_proj.get_named_decl_tuple decl | Some decl -> Clang_ast_proj.get_named_decl_tuple decl
@ -371,7 +370,7 @@ let type_ptr_is_typedef_named type_ptr (type_name: string): bool =
| Some (_, ni) -> | Some (_, ni) ->
String.equal type_name ni.ni_name String.equal type_name ni.ni_name
| _ -> false in | _ -> false in
match get_type type_ptr with match get_type qual_type.Clang_ast_t.qt_type_ptr with
| Some TypedefType (_, tti) -> | Some TypedefType (_, tti) ->
let decl_opt = get_decl tti.tti_decl_ptr in let decl_opt = get_decl tti.tti_decl_ptr in
is_decl_name_match decl_opt is_decl_name_match decl_opt
@ -383,8 +382,8 @@ let if_decl_to_di_pointer_opt if_decl =
Some if_decl_info.di_pointer Some if_decl_info.di_pointer
| _ -> None | _ -> None
let is_instance_type type_ptr = let is_instance_type qual_type =
match name_opt_of_typedef_type_ptr type_ptr with match name_opt_of_typedef_qual_type qual_type with
| Some name -> String.equal (QualifiedCppName.to_qual_string name) "instancetype" | Some name -> String.equal (QualifiedCppName.to_qual_string name) "instancetype"
| None -> false | None -> false
@ -392,7 +391,7 @@ let return_type_matches_class_type rtp type_decl_pointer =
if is_instance_type rtp then if is_instance_type rtp then
true true
else else
let return_type_decl_opt = type_ptr_to_objc_interface rtp in let return_type_decl_opt = qual_type_to_objc_interface rtp in
let return_type_decl_pointer_opt = let return_type_decl_pointer_opt =
Option.map ~f:if_decl_to_di_pointer_opt return_type_decl_opt in Option.map ~f:if_decl_to_di_pointer_opt return_type_decl_opt in
[%compare.equal : int option option] (Some type_decl_pointer) return_type_decl_pointer_opt [%compare.equal : int option option] (Some type_decl_pointer) return_type_decl_pointer_opt

24
infer/src/clang/cAst_utils.mli
Unescape View File

@ -11,14 +11,12 @@ open! IStd
(** Functions for transformations of ast nodes *) (** Functions for transformations of ast nodes *)
val is_type_nonnull : Clang_ast_t.type_ptr -> bool
val get_fresh_pointer : unit -> Clang_ast_t.pointer val get_fresh_pointer : unit -> Clang_ast_t.pointer
val get_invalid_pointer : unit -> Clang_ast_t.pointer val get_invalid_pointer : unit -> Clang_ast_t.pointer
val type_from_unary_expr_or_type_trait_expr_info : val type_from_unary_expr_or_type_trait_expr_info :
Clang_ast_t.unary_expr_or_type_trait_expr_info -> Clang_ast_t.type_ptr option Clang_ast_t.unary_expr_or_type_trait_expr_info -> Clang_ast_t.qual_type option
val get_decl : Clang_ast_t.pointer -> Clang_ast_t.decl option val get_decl : Clang_ast_t.pointer -> Clang_ast_t.decl option
@ -62,8 +60,8 @@ val get_decl_from_typ_ptr : Clang_ast_t.type_ptr -> Clang_ast_t.decl option
val name_of_typedef_type_info : Clang_ast_t.typedef_type_info -> QualifiedCppName.t val name_of_typedef_type_info : Clang_ast_t.typedef_type_info -> QualifiedCppName.t
(** returns name of typedef if type_ptr points to Typedef, None otherwise *) (** returns name of typedef if qual_type points to Typedef, None otherwise *)
val name_opt_of_typedef_type_ptr : Clang_ast_t.type_ptr -> QualifiedCppName.t option val name_opt_of_typedef_qual_type : Clang_ast_t.qual_type -> QualifiedCppName.t option
val string_of_qual_type : Clang_ast_t.qual_type -> string val string_of_qual_type : Clang_ast_t.qual_type -> string
@ -71,18 +69,20 @@ val make_name_decl : string -> Clang_ast_t.named_decl_info
val make_qual_name_decl : string list -> string -> Clang_ast_t.named_decl_info val make_qual_name_decl : string list -> string -> Clang_ast_t.named_decl_info
type type_ptr_to_sil_type = Tenv.t -> Clang_ast_t.type_ptr -> Typ.t type qual_type_to_sil_type = Tenv.t -> Clang_ast_t.qual_type -> Typ.t
val qual_type_of_decl_ptr : Clang_ast_t.pointer -> Clang_ast_t.qual_type
val add_type_from_decl_ref : type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref option -> val add_type_from_decl_ref_opt : qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref option ->
bool -> unit bool -> unit
val add_type_from_decl_ref_list : type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref list -> val add_type_from_decl_ref_list : qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl_ref list ->
unit unit
val get_function_decl_with_body : Clang_ast_t.pointer -> Clang_ast_t.decl option val get_function_decl_with_body : Clang_ast_t.pointer -> Clang_ast_t.decl option
val get_info_from_decl_ref : Clang_ast_t.decl_ref -> val get_info_from_decl_ref : Clang_ast_t.decl_ref ->
Clang_ast_t.named_decl_info * Clang_ast_t.pointer * Clang_ast_t.type_ptr Clang_ast_t.named_decl_info * Clang_ast_t.pointer * Clang_ast_t.qual_type
val exists_eventually_st : ('a -> Clang_ast_t.stmt -> bool) -> 'a -> Clang_ast_t.stmt -> bool val exists_eventually_st : ('a -> Clang_ast_t.stmt -> bool) -> 'a -> Clang_ast_t.stmt -> bool
@ -131,13 +131,13 @@ val get_super_ObjCImplementationDecl :
val is_objc_if_descendant : val is_objc_if_descendant :
?blacklist:string list -> Clang_ast_t.decl option -> string list -> bool ?blacklist:string list -> Clang_ast_t.decl option -> string list -> bool
val type_ptr_to_objc_interface : Clang_ast_t.type_ptr -> Clang_ast_t.decl option val qual_type_to_objc_interface : Clang_ast_t.qual_type -> Clang_ast_t.decl option
val type_ptr_is_typedef_named : Clang_ast_t.type_ptr -> string -> bool val qual_type_is_typedef_named : Clang_ast_t.qual_type -> string -> bool
(** A class method that returns an instance of the class is a factory method. *) (** A class method that returns an instance of the class is a factory method. *)
val is_objc_factory_method : Clang_ast_t.decl -> Clang_ast_t.decl -> bool val is_objc_factory_method : Clang_ast_t.decl -> Clang_ast_t.decl -> bool
val name_of_decl_ref_opt : Clang_ast_t.decl_ref option -> string option val name_of_decl_ref_opt : Clang_ast_t.decl_ref option -> string option
val sil_annot_of_type : Clang_ast_t.type_ptr -> Annot.Item.t val sil_annot_of_type : Clang_ast_t.qual_type -> Annot.Item.t

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

@ -34,7 +34,7 @@ let fields_superclass tenv interface_decl_info =
| _ -> []) | _ -> [])
| _ -> [] | _ -> []
let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attributes = let build_sil_field qual_type_to_sil_type tenv field_name qual_type prop_attributes =
let prop_atts = List.map ~f:Clang_ast_j.string_of_property_attribute prop_attributes in let prop_atts = List.map ~f:Clang_ast_j.string_of_property_attribute prop_attributes in
let annotation_from_type t = let annotation_from_type t =
match t.Typ.desc with match t.Typ.desc with
@ -42,7 +42,7 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
| Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret] | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
| _ -> [] in | _ -> [] in
let fname = CGeneral_utils.mk_class_field_name field_name in let fname = CGeneral_utils.mk_class_field_name field_name in
let typ = type_ptr_to_sil_type tenv type_ptr in let typ = qual_type_to_sil_type tenv qual_type in
let item_annotations = match prop_atts with let item_annotations = match prop_atts with
| [] -> | [] ->
({ Annot.class_name = Config.ivar_attributes; parameters = annotation_from_type typ }, ({ Annot.class_name = Config.ivar_attributes; parameters = annotation_from_type typ },
@ -50,30 +50,30 @@ let build_sil_field type_ptr_to_sil_type tenv field_name type_ptr prop_attribute
| _ -> | _ ->
({ Annot.class_name = Config.property_attributes; parameters = prop_atts }, ({ Annot.class_name = Config.property_attributes; parameters = prop_atts },
true) in true) in
let item_annotations = item_annotations :: (CAst_utils.sil_annot_of_type type_ptr) in let item_annotations = item_annotations :: (CAst_utils.sil_annot_of_type qual_type) in
fname, typ, item_annotations fname, typ, item_annotations
(* 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 type_ptr_to_sil_type tenv decl_list = let rec get_fields qual_type_to_sil_type tenv decl_list =
let open Clang_ast_t in let open Clang_ast_t in
let add_field name_info qt attributes decl_list' = let add_field name_info (qt : qual_type) attributes decl_list' =
let fields = get_fields type_ptr_to_sil_type tenv decl_list' in let fields = get_fields qual_type_to_sil_type tenv decl_list' in
let field_tuple = build_sil_field type_ptr_to_sil_type tenv let field_tuple = build_sil_field qual_type_to_sil_type tenv
name_info qt.Clang_ast_t.qt_type_ptr attributes in name_info qt attributes in
CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in CGeneral_utils.append_no_duplicates_fields [field_tuple] fields in
match decl_list with match decl_list with
| [] -> [] | [] -> []
| ObjCPropertyDecl (_, _, obj_c_property_decl_info) :: decl_list' -> | ObjCPropertyDecl (_, _, obj_c_property_decl_info) :: decl_list' ->
(let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in (let ivar_decl_ref = obj_c_property_decl_info.Clang_ast_t.opdi_ivar_decl in
match CAst_utils.get_decl_opt_with_decl_ref ivar_decl_ref with match CAst_utils.get_decl_opt_with_decl_ref ivar_decl_ref with
| Some (ObjCIvarDecl (_, name_info, type_ptr, _, _)) -> | Some (ObjCIvarDecl (_, name_info, qual_type, _, _)) ->
let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in let attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in
add_field name_info type_ptr attributes decl_list' add_field name_info qual_type attributes decl_list'
| _ -> get_fields type_ptr_to_sil_type tenv decl_list') | _ -> get_fields qual_type_to_sil_type tenv decl_list')
| ObjCIvarDecl (_, name_info, type_ptr, _, _) :: decl_list' -> | ObjCIvarDecl (_, name_info, qual_type, _, _) :: decl_list' ->
add_field name_info type_ptr [] decl_list' add_field name_info qual_type [] decl_list'
| _ :: decl_list' -> | _ :: decl_list' ->
get_fields type_ptr_to_sil_type tenv decl_list' get_fields qual_type_to_sil_type tenv 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. *)

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

@ -13,14 +13,11 @@ open! IStd
type field_type = Fieldname.t * Typ.t * (Annot.t * bool) list type field_type = Fieldname.t * Typ.t * (Annot.t * bool) list
val get_fields : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl list -> val get_fields : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl list ->
field_type list field_type list
val fields_superclass : Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> field_type list val fields_superclass : Tenv.t -> Clang_ast_t.obj_c_interface_decl_info -> field_type list
val build_sil_field : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.named_decl_info ->
Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list -> field_type
val add_missing_fields : Tenv.t -> QualifiedCppName.t -> field_type list -> unit val add_missing_fields : Tenv.t -> QualifiedCppName.t -> field_type list -> unit
val modelled_field : Clang_ast_t.named_decl_info -> field_type list val modelled_field : Clang_ast_t.named_decl_info -> field_type list

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

@ -184,29 +184,29 @@ struct
| ObjCInterfaceDecl(_, _, decl_list, _, _) -> | ObjCInterfaceDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore ignore
(ObjcInterface_decl.interface_declaration CType_decl.type_ptr_to_sil_type tenv dec); (ObjcInterface_decl.interface_declaration CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCProtocolDecl(_, _, decl_list, _, _) -> | ObjCProtocolDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcProtocol_decl.protocol_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcProtocol_decl.protocol_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryDecl(_, _, decl_list, _, _) -> | ObjCCategoryDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcCategory_decl.category_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcCategory_decl.category_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list process_methods trans_unit_ctx tenv cg cfg curr_class decl_list
| ObjCCategoryImplDecl(_, _, decl_list, _, _) -> | ObjCCategoryImplDecl(_, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
ignore (ObjcCategory_decl.category_impl_decl CType_decl.type_ptr_to_sil_type tenv dec); ignore (ObjcCategory_decl.category_impl_decl CType_decl.qual_type_to_sil_type tenv dec);
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list; process_methods trans_unit_ctx tenv cg cfg curr_class decl_list;
| ObjCImplementationDecl(decl_info, _, decl_list, _, _) -> | ObjCImplementationDecl(decl_info, _, decl_list, _, _) ->
let curr_class = CContext.ContextClsDeclPtr dec_ptr in let curr_class = CContext.ContextClsDeclPtr dec_ptr in
let class_typename = CType_decl.get_record_typename ~tenv dec in let class_typename = CType_decl.get_record_typename ~tenv dec in
let type_ptr_to_sil_type = CType_decl.type_ptr_to_sil_type in let qual_type_to_sil_type = CType_decl.qual_type_to_sil_type in
ignore (ObjcInterface_decl.interface_impl_declaration type_ptr_to_sil_type tenv dec); ignore (ObjcInterface_decl.interface_impl_declaration qual_type_to_sil_type tenv dec);
CMethod_trans.add_default_method_for_class trans_unit_ctx class_typename decl_info; CMethod_trans.add_default_method_for_class trans_unit_ctx class_typename decl_info;
process_methods trans_unit_ctx tenv cg cfg curr_class decl_list; process_methods trans_unit_ctx tenv cg cfg curr_class decl_list;

4
infer/src/clang/cGeneral_utils.ml
Unescape View File

@ -154,8 +154,8 @@ let mk_sil_global_var {CFrontend_config.source_file} ?(mk_name=fun _ x -> x)
~is_static_local:(var_decl_info.Clang_ast_t.vdi_is_static_local) ~is_static_local:(var_decl_info.Clang_ast_t.vdi_is_static_local)
(mk_name name_string simple_name) translation_unit (mk_name name_string simple_name) translation_unit
let mk_sil_var trans_unit_ctx named_decl_info decl_info_type_ptr_opt procname outer_procname = let mk_sil_var trans_unit_ctx named_decl_info decl_info_qual_type_opt procname outer_procname =
match decl_info_type_ptr_opt with match decl_info_qual_type_opt with
| Some (decl_info, qt, var_decl_info, should_be_mangled) -> | Some (decl_info, qt, var_decl_info, should_be_mangled) ->
let name_string, simple_name = get_var_name_mangled named_decl_info var_decl_info in let name_string, simple_name = get_var_name_mangled named_decl_info var_decl_info in
if var_decl_info.Clang_ast_t.vdi_is_global then if var_decl_info.Clang_ast_t.vdi_is_global then

4
infer/src/clang/cMethod_signature.ml
Unescape View File

@ -15,7 +15,7 @@ open! IStd
type method_signature = { type method_signature = {
mutable name : Typ.Procname.t; mutable name : Typ.Procname.t;
args : (Mangled.t * Clang_ast_t.qual_type) list; args : (Mangled.t * Clang_ast_t.qual_type) list;
ret_type : Clang_ast_t.type_ptr; ret_type : Clang_ast_t.qual_type;
attributes : Clang_ast_t.attribute list; attributes : Clang_ast_t.attribute list;
loc : Clang_ast_t.source_range; loc : Clang_ast_t.source_range;
is_instance : bool; is_instance : bool;
@ -101,5 +101,5 @@ let ms_to_string ms =
IList.to_string IList.to_string
(fun (s1, s2) -> (Mangled.to_string s1) ^ ", " ^ (CAst_utils.string_of_qual_type s2)) (fun (s1, s2) -> (Mangled.to_string s1) ^ ", " ^ (CAst_utils.string_of_qual_type s2))
ms.args ms.args
^ "->" ^ (Clang_ast_extend.type_ptr_to_string ms.ret_type) ^ " " ^ ^ "->" ^ (Clang_ast_extend.type_ptr_to_string ms.ret_type.Clang_ast_t.qt_type_ptr) ^ " " ^
Clang_ast_j.string_of_source_range ms.loc Clang_ast_j.string_of_source_range ms.loc

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

@ -21,7 +21,7 @@ val ms_set_name : method_signature -> Typ.Procname.t -> unit
val ms_get_args : method_signature -> val ms_get_args : method_signature ->
(Mangled.t * Clang_ast_t.qual_type) list (Mangled.t * Clang_ast_t.qual_type) list
val ms_get_ret_type : method_signature -> Clang_ast_t.type_ptr val ms_get_ret_type : method_signature -> Clang_ast_t.qual_type
val ms_get_attributes : method_signature -> Clang_ast_t.attribute list val ms_get_attributes : method_signature -> Clang_ast_t.attribute list
@ -43,7 +43,7 @@ val ms_is_getter : method_signature -> bool
val ms_is_setter : method_signature -> bool val ms_is_setter : method_signature -> bool
val make_ms : Typ.Procname.t -> (Mangled.t * Clang_ast_t.qual_type) list -> Clang_ast_t.type_ptr val make_ms : Typ.Procname.t -> (Mangled.t * Clang_ast_t.qual_type) list -> Clang_ast_t.qual_type
-> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> ?is_cpp_virtual:bool -> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> ?is_cpp_virtual:bool
-> CFrontend_config.clang_lang -> Clang_ast_t.pointer option -> Clang_ast_t.pointer option -> CFrontend_config.clang_lang -> Clang_ast_t.pointer option -> Clang_ast_t.pointer option
-> Typ.t option -> method_signature -> Typ.t option -> method_signature

61
infer/src/clang/cMethod_trans.ml
Unescape View File

@ -28,10 +28,10 @@ type method_call_type =
let equal_method_call_type = [%compare.equal : method_call_type] let equal_method_call_type = [%compare.equal : method_call_type]
type function_method_decl_info = type function_method_decl_info =
| Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.type_ptr | Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.qual_type
| Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.cxx_method_decl_info * Clang_ast_t.pointer * Clang_ast_t.type_ptr | Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.cxx_method_decl_info * Clang_ast_t.pointer * Clang_ast_t.qual_type
| ObjC_Meth_decl_info of Clang_ast_t.obj_c_method_decl_info * Clang_ast_t.pointer | ObjC_Meth_decl_info of Clang_ast_t.obj_c_method_decl_info * Clang_ast_t.pointer
| Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.type_ptr * CContext.t | Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.qual_type * CContext.t
let is_instance_method function_method_decl_info = let is_instance_method function_method_decl_info =
match function_method_decl_info with match function_method_decl_info with
@ -52,10 +52,10 @@ let get_class_param function_method_decl_info =
if (is_instance_method function_method_decl_info) then if (is_instance_method function_method_decl_info) then
match function_method_decl_info with match function_method_decl_info with
| Cpp_Meth_decl_info (_, _, class_decl_ptr, _) -> | Cpp_Meth_decl_info (_, _, class_decl_ptr, _) ->
let class_type = Ast_expressions.create_qual_type (Clang_ast_extend.DeclPtr class_decl_ptr) in let class_type = CAst_utils.qual_type_of_decl_ptr class_decl_ptr in
[(Mangled.from_string CFrontend_config.this, class_type)] [(Mangled.from_string CFrontend_config.this, class_type)]
| ObjC_Meth_decl_info (_, class_decl_ptr) -> | ObjC_Meth_decl_info (_, class_decl_ptr) ->
let class_type = Ast_expressions.create_qual_type (Clang_ast_extend.DeclPtr class_decl_ptr) in let class_type = CAst_utils.qual_type_of_decl_ptr class_decl_ptr in
[(Mangled.from_string CFrontend_config.self, class_type)] [(Mangled.from_string CFrontend_config.self, class_type)]
| _ -> [] | _ -> []
else [] else []
@ -73,11 +73,11 @@ let is_objc_method function_method_decl_info =
let get_return_param tenv function_method_decl_info = let get_return_param tenv function_method_decl_info =
let is_objc_method = is_objc_method function_method_decl_info in let is_objc_method = is_objc_method function_method_decl_info in
let return_type_ptr = get_original_return_type function_method_decl_info in let return_qual_type = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.type_ptr_to_sil_type tenv return_type_ptr in let return_typ = CType_decl.qual_type_to_sil_type tenv return_qual_type in
if should_add_return_param return_typ ~is_objc_method then if should_add_return_param return_typ ~is_objc_method then
[(Mangled.from_string CFrontend_config.return_param, [(Mangled.from_string CFrontend_config.return_param,
Ast_expressions.create_pointer_qual_type ~is_const:false return_type_ptr)] Ast_expressions.create_pointer_qual_type ~is_const:false return_qual_type)]
else else
[] []
@ -110,25 +110,25 @@ let get_parameters trans_unit_ctx tenv function_method_decl_info =
match par with match par with
| Clang_ast_t.ParmVarDecl (_, name_info, qt, var_decl_info) -> | Clang_ast_t.ParmVarDecl (_, name_info, qt, var_decl_info) ->
let _, mangled = CGeneral_utils.get_var_name_mangled name_info var_decl_info in let _, mangled = CGeneral_utils.get_var_name_mangled name_info var_decl_info in
let param_typ = CType_decl.type_ptr_to_sil_type tenv qt.Clang_ast_t.qt_type_ptr in let param_typ = CType_decl.qual_type_to_sil_type tenv qt in
let qt_type_ptr = let new_qt =
match param_typ.Typ.desc with match param_typ.Typ.desc with
| Tstruct _ when CGeneral_utils.is_cpp_translation trans_unit_ctx -> | Tstruct _ when CGeneral_utils.is_cpp_translation trans_unit_ctx ->
Ast_expressions.create_reference_type qt.Clang_ast_t.qt_type_ptr Ast_expressions.create_reference_qual_type ~is_const:false qt
| _ -> qt.Clang_ast_t.qt_type_ptr in | _ -> qt in
(mangled, {qt with qt_type_ptr}) (mangled, new_qt)
| _ -> assert false in | _ -> assert false in
let pars = List.map ~f:par_to_ms_par (get_param_decls function_method_decl_info) in let pars = List.map ~f:par_to_ms_par (get_param_decls function_method_decl_info) in
get_class_param function_method_decl_info @ pars @ get_return_param tenv function_method_decl_info get_class_param function_method_decl_info @ pars @ get_return_param tenv function_method_decl_info
(** get return type of the function and optionally type of function's return parameter *) (** get return type of the function and optionally type of function's return parameter *)
let get_return_val_and_param_types tenv function_method_decl_info = let get_return_val_and_param_types tenv function_method_decl_info =
let return_type_ptr = get_original_return_type function_method_decl_info in let return_qual_type = get_original_return_type function_method_decl_info in
let return_typ = CType_decl.type_ptr_to_sil_type tenv return_type_ptr in let return_typ = CType_decl.qual_type_to_sil_type tenv return_qual_type in
let is_objc_method = is_objc_method function_method_decl_info in let is_objc_method = is_objc_method function_method_decl_info in
if should_add_return_param return_typ ~is_objc_method then if should_add_return_param return_typ ~is_objc_method then
Ast_expressions.create_void_type, Some (CType.add_pointer_to_typ return_typ) Ast_expressions.create_void_type, Some (CType.add_pointer_to_typ return_typ)
else return_type_ptr, None else return_qual_type, None
let build_method_signature trans_unit_ctx tenv decl_info procname function_method_decl_info let build_method_signature trans_unit_ctx tenv decl_info procname function_method_decl_info
parent_pointer pointer_to_property_opt = parent_pointer pointer_to_property_opt =
@ -151,7 +151,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
let open Clang_ast_t in let open Clang_ast_t in
match meth_decl, block_data_opt with match meth_decl, block_data_opt with
| FunctionDecl (decl_info, _, qt, fdi), _ -> | FunctionDecl (decl_info, _, qt, fdi), _ ->
let func_decl = Func_decl_info (fdi, qt.Clang_ast_t.qt_type_ptr) in let func_decl = Func_decl_info (fdi, qt) in
let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in
let ms = build_method_signature trans_unit_ctx tenv decl_info procname func_decl None None in let ms = build_method_signature trans_unit_ctx tenv decl_info procname func_decl None None in
ms, fdi.Clang_ast_t.fdi_body, [] ms, fdi.Clang_ast_t.fdi_body, []
@ -161,7 +161,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
| CXXDestructorDecl (decl_info, _, qt, fdi, mdi), _ -> | CXXDestructorDecl (decl_info, _, qt, fdi, mdi), _ ->
let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in let procname = CProcname.from_decl trans_unit_ctx ~tenv meth_decl in
let parent_ptr = Option.value_exn decl_info.di_parent_pointer in let parent_ptr = Option.value_exn decl_info.di_parent_pointer in
let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt.Clang_ast_t.qt_type_ptr) in let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt) in
let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in
let ms = build_method_signature let ms = build_method_signature
trans_unit_ctx tenv decl_info procname method_decl parent_pointer None in trans_unit_ctx tenv decl_info procname method_decl parent_pointer None in
@ -258,8 +258,8 @@ let get_class_name_method_call_from_clang trans_unit_ctx tenv obj_c_message_expr
(* Get class name from a method call accorsing to the info given by the receiver kind *) (* Get class name from a method call accorsing to the info given by the receiver kind *)
let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_info act_params = let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_info act_params =
match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with match obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind with
| `Class tp -> | `Class qt ->
let sil_type = CType_decl.type_ptr_to_sil_type context.CContext.tenv tp in let sil_type = CType_decl.qual_type_to_sil_type context.CContext.tenv qt in
(CType.objc_classname_of_type sil_type) (CType.objc_classname_of_type sil_type)
| `Instance -> | `Instance ->
(match act_params with (match act_params with
@ -282,7 +282,7 @@ let get_formal_parameters tenv ms =
let rec defined_parameters pl = let rec defined_parameters pl =
match pl with match pl with
| [] -> [] | [] -> []
| (mangled, {Clang_ast_t.qt_type_ptr}):: pl' -> | (mangled, qual_type):: pl' ->
let should_add_pointer name ms = let should_add_pointer name ms =
let is_objc_self = let is_objc_self =
String.equal name CFrontend_config.self && String.equal name CFrontend_config.self &&
@ -293,16 +293,16 @@ let get_formal_parameters tenv ms =
CFrontend_config.equal_clang_lang CFrontend_config.equal_clang_lang
(CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in (CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in
(is_objc_self && CMethod_signature.ms_is_instance ms) || is_cxx_this in (is_objc_self && CMethod_signature.ms_is_instance ms) || is_cxx_this in
let tp = if should_add_pointer (Mangled.to_string mangled) ms then let qt = if should_add_pointer (Mangled.to_string mangled) ms then
(Ast_expressions.create_pointer_type qt_type_ptr) (Ast_expressions.create_pointer_qual_type ~is_const:false qual_type)
else qt_type_ptr in else qual_type in
let typ = CType_decl.type_ptr_to_sil_type tenv tp in let typ = CType_decl.qual_type_to_sil_type tenv qt in
(mangled, typ):: defined_parameters pl' in (mangled, typ):: defined_parameters pl' in
defined_parameters (CMethod_signature.ms_get_args ms) defined_parameters (CMethod_signature.ms_get_args ms)
let get_return_type tenv ms = let get_return_type tenv ms =
let return_type = CMethod_signature.ms_get_ret_type ms in let return_type = CMethod_signature.ms_get_ret_type ms in
CType_decl.type_ptr_to_sil_type tenv return_type CType_decl.qual_type_to_sil_type tenv return_type
let sil_func_attributes_of_attributes attrs = let sil_func_attributes_of_attributes attrs =
let rec do_translation acc al = match al with let rec do_translation acc al = match al with
@ -327,12 +327,13 @@ let should_create_procdesc cfg procname defined set_objc_accessor_attr =
| None -> true | None -> true
let sil_method_annotation_of_args args method_type : Annot.Method.t = let sil_method_annotation_of_args args method_type : Annot.Method.t =
let args_types = List.map ~f:(fun (_, qt) -> qt.Clang_ast_t.qt_type_ptr) args in let args_types = List.map ~f:snd args in
let param_annots = List.map ~f:CAst_utils.sil_annot_of_type args_types in let param_annots = List.map ~f:CAst_utils.sil_annot_of_type args_types in
let retval_annot = CAst_utils.sil_annot_of_type method_type in let retval_annot = CAst_utils.sil_annot_of_type method_type in
retval_annot, param_annots retval_annot, param_annots
let is_pointer_to_const type_ptr = match CAst_utils.get_type type_ptr with let is_pointer_to_const {Clang_ast_t.qt_type_ptr} =
match CAst_utils.get_type qt_type_ptr with
| Some PointerType (_, {Clang_ast_t.qt_is_const}) | Some PointerType (_, {Clang_ast_t.qt_is_const})
| Some ObjCObjectPointerType (_, {Clang_ast_t.qt_is_const}) | Some ObjCObjectPointerType (_, {Clang_ast_t.qt_is_const})
| Some RValueReferenceType (_, {Clang_ast_t.qt_is_const}) | Some RValueReferenceType (_, {Clang_ast_t.qt_is_const})
@ -348,9 +349,9 @@ let get_const_args_indices ~shift args =
let rec aux result = function let rec aux result = function
| [] -> | [] ->
List.rev result List.rev result
| (_, {Clang_ast_t.qt_type_ptr})::tl -> | (_, qual_type)::tl ->
incr i; incr i;
if is_pointer_to_const qt_type_ptr then if is_pointer_to_const qual_type then
aux (!i - 1::result) tl aux (!i - 1::result) tl
else else
aux result tl in aux result tl in

2
infer/src/clang/cModule_type.ml
Unescape View File

@ -9,7 +9,7 @@
open! IStd open! IStd
type block_data = CContext.t * Clang_ast_t.type_ptr * Typ.Procname.t * (Pvar.t * Typ.t) list type block_data = CContext.t * Clang_ast_t.qual_type * Typ.Procname.t * (Pvar.t * Typ.t) list
type instr_type = [ type instr_type = [
| `ClangStmt of Clang_ast_t.stmt | `ClangStmt of Clang_ast_t.stmt

8
infer/src/clang/cPredicates.ml
Unescape View File

@ -95,7 +95,7 @@ let _is_object_of_class_named comp receiver cname =
| PseudoObjectExpr (_, _, ei) | PseudoObjectExpr (_, _, ei)
| ImplicitCastExpr (_, _, ei, _) | ImplicitCastExpr (_, _, ei, _)
| ParenExpr (_, _, ei) -> | ParenExpr (_, _, ei) ->
(match CAst_utils.type_ptr_to_objc_interface ei.ei_type_ptr with (match CAst_utils.qual_type_to_objc_interface ei.ei_qual_type with
| Some interface -> comp (Ctl_parser_types.Decl interface) cname | Some interface -> comp (Ctl_parser_types.Decl interface) cname
| _ -> false) | _ -> false)
| _ -> false | _ -> false
@ -126,7 +126,7 @@ let is_receiver_kind_class comp omei cname =
let open Clang_ast_t in let open Clang_ast_t in
match omei.omei_receiver_kind with match omei.omei_receiver_kind with
| `Class ptr -> | `Class ptr ->
(match CAst_utils.get_desugared_type ptr with (match CAst_utils.get_desugared_type ptr.Clang_ast_t.qt_type_ptr with
| Some ObjCInterfaceType (_, ptr) -> | Some ObjCInterfaceType (_, ptr) ->
(match CAst_utils.get_decl ptr with (match CAst_utils.get_decl ptr with
| Some ObjCInterfaceDecl (_, ndi, _, _, _) -> | Some ObjCInterfaceDecl (_, ndi, _, _, _) ->
@ -219,7 +219,7 @@ let is_property_pointer_type an =
let open Clang_ast_t in let open Clang_ast_t in
match an with match an with
| Ctl_parser_types.Decl (ObjCPropertyDecl (_, _, pdi)) -> | Ctl_parser_types.Decl (ObjCPropertyDecl (_, _, pdi)) ->
(match CAst_utils.get_desugared_type pdi.opdi_type_ptr with (match CAst_utils.get_desugared_type pdi.opdi_qual_type.Clang_ast_t.qt_type_ptr with
| Some MemberPointerType _ | Some MemberPointerType _
| Some ObjCObjectPointerType _ | Some ObjCObjectPointerType _
| Some BlockPointerType _ -> true | Some BlockPointerType _ -> true
@ -319,7 +319,7 @@ let isa classname an =
| Ctl_parser_types.Stmt stmt -> | Ctl_parser_types.Stmt stmt ->
(match Clang_ast_proj.get_expr_tuple stmt with (match Clang_ast_proj.get_expr_tuple stmt with
| Some (_, _, expr_info) -> | Some (_, _, expr_info) ->
let typ = CAst_utils.get_desugared_type expr_info.ei_type_ptr in let typ = CAst_utils.get_desugared_type expr_info.ei_qual_type.qt_type_ptr in
CAst_utils.is_ptr_to_objc_class typ classname CAst_utils.is_ptr_to_objc_class typ classname
| _ -> false) | _ -> false)
| _ -> false | _ -> false

123
infer/src/clang/cTrans.ml
Unescape View File

@ -93,7 +93,7 @@ struct
let objc_exp_of_type_block fun_exp_stmt = let objc_exp_of_type_block fun_exp_stmt =
match fun_exp_stmt with match fun_exp_stmt with
| Clang_ast_t.ImplicitCastExpr(_, _, ei, _) | Clang_ast_t.ImplicitCastExpr(_, _, ei, _)
when CType.is_block_type ei.Clang_ast_t.ei_type_ptr -> true when CType.is_block_type ei.Clang_ast_t.ei_qual_type -> true
| _ -> false | _ -> false
(* This function add in tenv a class representing an objc block. *) (* This function add in tenv a class representing an objc block. *)
@ -261,8 +261,8 @@ struct
Pvar.mk_tmp var_name_suffix procname Pvar.mk_tmp var_name_suffix procname
let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info = let mk_temp_sil_var_for_expr tenv procdesc var_name_prefix expr_info =
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let typ = CType_decl.type_ptr_to_sil_type tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type tenv qual_type in
(mk_temp_sil_var procdesc var_name_prefix, typ) (mk_temp_sil_var procdesc var_name_prefix, typ)
let create_var_exp_tmp_var trans_state expr_info var_name = let create_var_exp_tmp_var trans_state expr_info var_name =
@ -412,15 +412,15 @@ struct
(* The stmt seems to be always empty *) (* The stmt seems to be always empty *)
let unaryExprOrTypeTraitExpr_trans trans_state expr_info unary_expr_or_type_trait_expr_info = let unaryExprOrTypeTraitExpr_trans trans_state expr_info unary_expr_or_type_trait_expr_info =
let tenv = trans_state.context.CContext.tenv in let tenv = trans_state.context.CContext.tenv in
let typ = CType_decl.type_ptr_to_sil_type tenv expr_info.Clang_ast_t.ei_type_ptr in let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in
match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with match unary_expr_or_type_trait_expr_info.Clang_ast_t.uttei_kind with
| `SizeOf -> | `SizeOf ->
let tp = let qt_opt =
CAst_utils.type_from_unary_expr_or_type_trait_expr_info CAst_utils.type_from_unary_expr_or_type_trait_expr_info
unary_expr_or_type_trait_expr_info in unary_expr_or_type_trait_expr_info in
let sizeof_typ = let sizeof_typ =
match tp with match qt_opt with
| Some tp -> CType_decl.type_ptr_to_sil_type tenv tp | Some qt -> CType_decl.qual_type_to_sil_type tenv qt
| None -> typ (* Some default type since the type is missing *) in | None -> typ (* Some default type since the type is missing *) in
{ empty_res_trans with { empty_res_trans with
exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] } exps = [(Exp.Sizeof (sizeof_typ, None, Subtype.exact), sizeof_typ)] }
@ -437,7 +437,7 @@ struct
let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in let root_node' = GotoLabel.find_goto_label trans_state.context label_name sil_loc in
{ empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes } { empty_res_trans with root_nodes = [root_node']; leaf_nodes = trans_state.succ_nodes }
let get_builtin_pname_opt trans_unit_ctx qual_name decl_opt type_ptr = let get_builtin_pname_opt trans_unit_ctx qual_name decl_opt (qual_type : Clang_ast_t.qual_type) =
let get_annotate_attr_arg decl = let get_annotate_attr_arg decl =
let open Clang_ast_t in let open Clang_ast_t in
let decl_info = Clang_ast_proj.get_decl_tuple decl in let decl_info = Clang_ast_proj.get_decl_tuple decl in
@ -458,9 +458,9 @@ struct
Some (Typ.Procname.from_string_c_fun attr) Some (Typ.Procname.from_string_c_fun attr)
| _ when CTrans_models.is_modeled_builtin name -> | _ when CTrans_models.is_modeled_builtin name ->
Some (Typ.Procname.from_string_c_fun (CFrontend_config.infer ^ name)) Some (Typ.Procname.from_string_c_fun (CFrontend_config.infer ^ name))
| _ when CTrans_models.is_release_builtin name type_ptr -> | _ when CTrans_models.is_release_builtin name qual_type.qt_type_ptr ->
Some BuiltinDecl.__objc_release_cf Some BuiltinDecl.__objc_release_cf
| _ when CTrans_models.is_retain_builtin name type_ptr -> | _ when CTrans_models.is_retain_builtin name qual_type.qt_type_ptr ->
Some BuiltinDecl.__objc_retain_cf Some BuiltinDecl.__objc_retain_cf
| _ when String.equal name CFrontend_config.malloc && | _ when String.equal name CFrontend_config.malloc &&
CGeneral_utils.is_objc_extension trans_unit_ctx -> CGeneral_utils.is_objc_extension trans_unit_ctx ->
@ -471,13 +471,13 @@ struct
let function_deref_trans trans_state decl_ref = let function_deref_trans trans_state decl_ref =
let open CContext in let open CContext in
let context = trans_state.context in let context = trans_state.context in
let name_info, decl_ptr, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in
Option.iter ~f:(call_translation context) decl_opt; Option.iter ~f:(call_translation context) decl_opt;
let qual_name = CAst_utils.get_qualified_name name_info in let qual_name = CAst_utils.get_qualified_name name_info in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let pname = let pname =
match get_builtin_pname_opt context.translation_unit_context qual_name decl_opt type_ptr with match get_builtin_pname_opt context.translation_unit_context qual_name decl_opt qual_type with
| Some builtin_pname -> builtin_pname | Some builtin_pname -> builtin_pname
| None -> | None ->
let name = QualifiedCppName.to_qual_string qual_name in let name = QualifiedCppName.to_qual_string qual_name in
@ -488,9 +488,9 @@ struct
let open CContext in let open CContext in
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in let name_info, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
Logging.out_debug "!!!!! Dealing with field '%s' @." name_info.Clang_ast_t.ni_name; Logging.out_debug "!!!!! Dealing with field '%s' @." name_info.Clang_ast_t.ni_name;
let field_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let field_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps let (obj_sil, class_typ) = extract_exp_from_list pre_trans_result.exps
"WARNING: in Field dereference we expect to know the object\n" in "WARNING: in Field dereference we expect to know the object\n" in
let is_pointer_typ = match class_typ.desc with let is_pointer_typ = match class_typ.desc with
@ -511,7 +511,7 @@ struct
(* it's done in var_deref_trans. The only exception is during field initialization in*) (* it's done in var_deref_trans. The only exception is during field initialization in*)
(* constructor's initializer list (when reference itself is initialized) *) (* constructor's initializer list (when reference itself is initialized) *)
let should_add_deref = (not is_pointer_typ) || let should_add_deref = (not is_pointer_typ) ||
(not is_constructor_init && CType.is_reference_type type_ptr) in (not is_constructor_init && CType.is_reference_type qual_type) in
let exp, deref_instrs = if should_add_deref then let exp, deref_instrs = if should_add_deref then
let id = Ident.create_fresh Ident.knormal in let id = Ident.create_fresh Ident.knormal in
let deref_instr = Sil.Load (id, field_exp, field_typ, sil_loc) in let deref_instr = Sil.Load (id, field_exp, field_typ, sil_loc) in
@ -525,12 +525,12 @@ struct
let open CContext in let open CContext in
let context = trans_state.context in let context = trans_state.context in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, decl_ptr, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in let decl_opt = CAst_utils.get_function_decl_with_body decl_ptr in
Option.iter ~f:(call_translation context) decl_opt; Option.iter ~f:(call_translation context) decl_opt;
let method_name = CAst_utils.get_unqualified_name name_info in let method_name = CAst_utils.get_unqualified_name name_info in
Logging.out_debug "!!!!! Dealing with method '%s' @." method_name; Logging.out_debug "!!!!! Dealing with method '%s' @." method_name;
let method_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let method_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let ms_opt = CMethod_trans.method_signature_of_pointer let ms_opt = CMethod_trans.method_signature_of_pointer
context.translation_unit_context context.tenv decl_ptr in context.translation_unit_context context.tenv decl_ptr in
let is_instance_method = match ms_opt with let is_instance_method = match ms_opt with
@ -566,7 +566,7 @@ struct
let qual_method_name = CAst_utils.get_qualified_name name_info in let qual_method_name = CAst_utils.get_qualified_name name_info in
let pname = let pname =
match get_builtin_pname_opt context.translation_unit_context qual_method_name decl_opt match get_builtin_pname_opt context.translation_unit_context qual_method_name decl_opt
type_ptr with qual_type with
| Some builtin_pname -> builtin_pname | Some builtin_pname -> builtin_pname
| None -> | None ->
let class_typename = Typ.Name.Cpp.from_qual_name Typ.NoTemplate let class_typename = Typ.Name.Cpp.from_qual_name Typ.NoTemplate
@ -580,9 +580,10 @@ struct
instrs = pre_trans_result.instrs @ extra_instrs; instrs = pre_trans_result.instrs @ extra_instrs;
} }
let destructor_deref_trans trans_state pvar_trans_result class_type_ptr si = let destructor_deref_trans trans_state pvar_trans_result class_qual_type si =
let open Clang_ast_t in let open Clang_ast_t in
let destruct_decl_ref_opt = match CAst_utils.get_decl_from_typ_ptr class_type_ptr with let destruct_decl_ref_opt =
match CAst_utils.get_decl_from_typ_ptr class_qual_type.Clang_ast_t.qt_type_ptr with
| Some CXXRecordDecl (_, _, _ , _, _, _, _, cxx_record_info) | Some CXXRecordDecl (_, _, _ , _, _, _, _, cxx_record_info)
| Some ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, cxx_record_info, _) -> | Some ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, cxx_record_info, _) ->
cxx_record_info.xrdi_destructor cxx_record_info.xrdi_destructor
@ -592,20 +593,20 @@ struct
method_deref_trans trans_state pvar_trans_result decl_ref si `CXXDestructor method_deref_trans trans_state pvar_trans_result decl_ref si `CXXDestructor
| None -> empty_res_trans | None -> empty_res_trans
let this_expr_trans trans_state sil_loc class_type_ptr = let this_expr_trans trans_state sil_loc class_qual_type =
let context = trans_state.context in let context = trans_state.context in
let procname = Procdesc.get_proc_name context.CContext.procdesc in let procname = Procdesc.get_proc_name context.CContext.procdesc in
let name = CFrontend_config.this in let name = CFrontend_config.this in
let pvar = Pvar.mk (Mangled.from_string name) procname in let pvar = Pvar.mk (Mangled.from_string name) procname in
let exp = Exp.Lvar pvar in let exp = Exp.Lvar pvar in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv class_type_ptr in let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv class_qual_type in
let exps = [(exp, typ)] in let exps = [(exp, typ)] in
(* there is no cast operation in AST, but backend needs it *) (* there is no cast operation in AST, but backend needs it *)
dereference_value_from_result sil_loc { empty_res_trans with exps = exps } ~strip_pointer:false dereference_value_from_result sil_loc { empty_res_trans with exps = exps } ~strip_pointer:false
let cxxThisExpr_trans trans_state stmt_info expr_info = let cxxThisExpr_trans trans_state stmt_info expr_info =
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in
this_expr_trans trans_state sil_loc expr_info.Clang_ast_t.ei_type_ptr this_expr_trans trans_state sil_loc expr_info.Clang_ast_t.ei_qual_type
let rec labelStmt_trans trans_state stmt_info stmt_list label_name = let rec labelStmt_trans trans_state stmt_info stmt_list label_name =
let context = trans_state.context in let context = trans_state.context in
@ -622,8 +623,8 @@ struct
and var_deref_trans trans_state stmt_info (decl_ref : Clang_ast_t.decl_ref) = and var_deref_trans trans_state stmt_info (decl_ref : Clang_ast_t.decl_ref) =
let context = trans_state.context in let context = trans_state.context in
let _, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in let _, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let ast_typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let ast_typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
let typ = let typ =
match ast_typ.Typ.desc with match ast_typ.Typ.desc with
| Tstruct _ when decl_ref.dr_kind = `ParmVar -> | Tstruct _ when decl_ref.dr_kind = `ParmVar ->
@ -713,8 +714,8 @@ struct
and enum_constant_trans trans_state decl_ref = and enum_constant_trans trans_state decl_ref =
let context = trans_state.context in let context = trans_state.context in
let _, _, type_ptr = CAst_utils.get_info_from_decl_ref decl_ref in let _, _, qual_type = CAst_utils.get_info_from_decl_ref decl_ref in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
let const_exp = get_enum_constant_expr context decl_ref.Clang_ast_t.dr_decl_pointer in let const_exp = get_enum_constant_expr context decl_ref.Clang_ast_t.dr_decl_pointer in
{ empty_res_trans with exps = [(const_exp, typ)] } { empty_res_trans with exps = [(const_exp, typ)] }
@ -770,7 +771,7 @@ struct
let trans_state' = { trans_state_pri with succ_nodes = [] } in let trans_state' = { trans_state_pri with succ_nodes = [] } in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let typ = let typ =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
match stmt_list with match stmt_list with
| [s1; s2] -> (* Assumption: We expect precisely 2 stmt corresponding to the 2 operands*) | [s1; s2] -> (* Assumption: We expect precisely 2 stmt corresponding to the 2 operands*)
let rhs_owning_method = CTrans_utils.is_owning_method s2 in let rhs_owning_method = CTrans_utils.is_owning_method s2 in
@ -992,9 +993,9 @@ struct
params_stmt si (Typ.mk Tvoid) false extra_res_trans in params_stmt si (Typ.mk Tvoid) false extra_res_trans in
{ res_trans with exps=extra_res_trans.exps } { res_trans with exps=extra_res_trans.exps }
and cxx_destructor_call_trans trans_state si this_res_trans class_type_ptr = and cxx_destructor_call_trans trans_state si this_res_trans class_qual_type =
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state si in
let res_trans_callee = destructor_deref_trans trans_state this_res_trans class_type_ptr si in let res_trans_callee = destructor_deref_trans trans_state this_res_trans class_qual_type si in
let is_cpp_call_virtual = res_trans_callee.is_cpp_call_virtual in let is_cpp_call_virtual = res_trans_callee.is_cpp_call_virtual in
if res_trans_callee.exps <> [] then if res_trans_callee.exps <> [] then
cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si (Typ.mk Tvoid) cxx_method_construct_call_trans trans_state_pri res_trans_callee [] si (Typ.mk Tvoid)
@ -1015,11 +1016,11 @@ struct
else if String.equal selector CFrontend_config.alloc || else if String.equal selector CFrontend_config.alloc ||
String.equal selector CFrontend_config.new_str then String.equal selector CFrontend_config.new_str then
match receiver_kind with match receiver_kind with
| `Class type_ptr -> | `Class qual_type ->
let class_opt = let class_opt =
CMethod_trans.get_class_name_method_call_from_clang CMethod_trans.get_class_name_method_call_from_clang
context.translation_unit_context context.CContext.tenv obj_c_message_expr_info in context.translation_unit_context context.CContext.tenv obj_c_message_expr_info in
Some (new_or_alloc_trans trans_state_pri sil_loc si type_ptr class_opt selector) Some (new_or_alloc_trans trans_state_pri sil_loc si qual_type class_opt selector)
| _ -> None | _ -> None
(* assertions *) (* assertions *)
else if CTrans_models.is_handleFailureInMethod selector then else if CTrans_models.is_handleFailureInMethod selector then
@ -1135,8 +1136,8 @@ struct
(match stmt_list with (match stmt_list with
| [cond; exp1; exp2] -> | [cond; exp1; exp2] ->
let typ = let typ =
CType_decl.type_ptr_to_sil_type CType_decl.qual_type_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let var_typ = add_reference_if_glvalue typ expr_info in let var_typ = add_reference_if_glvalue typ expr_info in
let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in let join_node = create_node (Procdesc.Node.Join_node) [] sil_loc context in
Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes []; Procdesc.node_set_succs_exn context.procdesc join_node succ_nodes [];
@ -1622,7 +1623,7 @@ struct
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let var_type = let var_type =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let lh = var_or_zero_in_init_list tenv var_exp var_type ~return_zero:false in let lh = var_or_zero_in_init_list tenv var_exp var_type ~return_zero:false in
let res_trans_subexpr_list = let res_trans_subexpr_list =
initListExpr_initializers_trans trans_state var_exp 0 stmts typ false stmt_info in initListExpr_initializers_trans trans_state var_exp 0 stmts typ false stmt_info in
@ -1722,19 +1723,17 @@ struct
let do_var_dec (di, var_name, qual_type, vdi) next_node = let do_var_dec (di, var_name, qual_type, vdi) next_node =
let var_decl = VarDecl (di, var_name, qual_type, vdi) in let var_decl = VarDecl (di, var_name, qual_type, vdi) in
let pvar = CVar_decl.sil_var_of_decl context var_decl procname in let pvar = CVar_decl.sil_var_of_decl context var_decl procname in
let typ = CType_decl.type_ptr_to_sil_type let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
context.CContext.tenv
qual_type.Clang_ast_t.qt_type_ptr in
CVar_decl.add_var_to_locals procdesc var_decl typ pvar; CVar_decl.add_var_to_locals procdesc var_decl typ pvar;
let trans_state' = { trans_state with succ_nodes = next_node } in let trans_state' = { trans_state with succ_nodes = next_node } in
init_expr_trans trans_state' (Exp.Lvar pvar, typ) stmt_info vdi.Clang_ast_t.vdi_init_expr in init_expr_trans trans_state' (Exp.Lvar pvar, typ) stmt_info vdi.Clang_ast_t.vdi_init_expr in
match var_decls with match var_decls with
| [] -> { empty_res_trans with root_nodes = next_nodes } | [] -> { empty_res_trans with root_nodes = next_nodes }
| VarDecl (di, n, tp, vdi) :: var_decls' -> | VarDecl (di, n, qt, vdi) :: var_decls' ->
(* Var are defined when procdesc is created, here we only take care of initialization*) (* Var are defined when procdesc is created, here we only take care of initialization*)
let res_trans_vd = collect_all_decl trans_state var_decls' next_nodes stmt_info in let res_trans_vd = collect_all_decl trans_state var_decls' next_nodes stmt_info in
let res_trans_tmp = do_var_dec (di, n, tp, vdi) res_trans_vd.root_nodes in let res_trans_tmp = do_var_dec (di, n, qt, vdi) res_trans_vd.root_nodes in
{ empty_res_trans with { empty_res_trans with
root_nodes = res_trans_tmp.root_nodes; leaf_nodes = []; root_nodes = res_trans_tmp.root_nodes; leaf_nodes = [];
instrs = res_trans_tmp.instrs @ res_trans_vd.instrs; instrs = res_trans_tmp.instrs @ res_trans_vd.instrs;
@ -1824,7 +1823,7 @@ struct
"WARNING: In CastExpr There must be only one stmt defining the expression to be cast.\n" in "WARNING: In CastExpr There must be only one stmt defining the expression to be cast.\n" in
let res_trans_stmt = instruction trans_state stmt in let res_trans_stmt = instruction trans_state stmt in
let typ = let typ =
CType_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in CType_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let cast_kind = cast_expr_info.Clang_ast_t.cei_cast_kind in let cast_kind = cast_expr_info.Clang_ast_t.cei_cast_kind in
(* This gives the differnece among cast operations kind*) (* This gives the differnece among cast operations kind*)
let is_objc_bridged_cast_expr _ stmt = let is_objc_bridged_cast_expr _ stmt =
@ -1872,8 +1871,8 @@ struct
extract_exp_from_list res_trans_stmt.exps extract_exp_from_list res_trans_stmt.exps
"\nWARNING: Missing operand in unary operator. NEED FIXING.\n" in "\nWARNING: Missing operand in unary operator. NEED FIXING.\n" in
let ret_typ = let ret_typ =
CType_decl.type_ptr_to_sil_type CType_decl.qual_type_to_sil_type
context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in
let exp_op, instr_op = let exp_op, instr_op =
CArithmetic_trans.unary_operation_instruction CArithmetic_trans.unary_operation_instruction
context.translation_unit_context unary_operator_info sil_e' ret_typ sil_loc in context.translation_unit_context unary_operator_info sil_e' ret_typ sil_loc in
@ -1954,7 +1953,7 @@ struct
and objCBoxedExpr_trans trans_state info sel stmt_info stmts = and objCBoxedExpr_trans trans_state info sel stmt_info stmts =
let typ = let typ =
CType_decl.class_from_pointer_type CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let obj_c_message_expr_info = Ast_expressions.make_obj_c_message_expr_info_class sel typ None in let obj_c_message_expr_info = Ast_expressions.make_obj_c_message_expr_info_class sel typ None in
let message_stmt = let message_stmt =
Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in
@ -1963,7 +1962,7 @@ struct
and objCArrayLiteral_trans trans_state info stmt_info stmts = and objCArrayLiteral_trans trans_state info stmt_info stmts =
let typ = let typ =
CType_decl.class_from_pointer_type CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let meth = CFrontend_config.array_with_objects_count_m in let meth = CFrontend_config.array_with_objects_count_m in
let obj_c_mes_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in let obj_c_mes_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in
let stmts = stmts @ [Ast_expressions.create_nil stmt_info] in let stmts = stmts @ [Ast_expressions.create_nil stmt_info] in
@ -1973,7 +1972,7 @@ struct
and objCDictionaryLiteral_trans trans_state info stmt_info stmts = and objCDictionaryLiteral_trans trans_state info stmt_info stmts =
let typ = let typ =
CType_decl.class_from_pointer_type CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let dictionary_literal_pname = BuiltinDecl.__objc_dictionary_literal in let dictionary_literal_pname = BuiltinDecl.__objc_dictionary_literal in
let dictionary_literal_s = Typ.Procname.get_method dictionary_literal_pname in let dictionary_literal_s = Typ.Procname.get_method dictionary_literal_pname in
let obj_c_message_expr_info = let obj_c_message_expr_info =
@ -1987,10 +1986,10 @@ struct
and objCStringLiteral_trans trans_state stmt_info stmts info = and objCStringLiteral_trans trans_state stmt_info stmts info =
let stmts = [Ast_expressions.create_implicit_cast_expr stmt_info stmts let stmts = [Ast_expressions.create_implicit_cast_expr stmt_info stmts
Ast_expressions.create_char_star_type `ArrayToPointerDecay] in (Ast_expressions.create_char_star_type ~is_const:true) `ArrayToPointerDecay] in
let typ = let typ =
CType_decl.class_from_pointer_type CType_decl.class_from_pointer_type
trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in
let meth = CFrontend_config.string_with_utf8_m in let meth = CFrontend_config.string_with_utf8_m in
let obj_c_mess_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in let obj_c_mess_expr_info = Ast_expressions.make_obj_c_message_expr_info_class meth typ None in
let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_mess_expr_info) in let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_mess_expr_info) in
@ -2040,9 +2039,9 @@ struct
match decl with match decl with
| Clang_ast_t.BlockDecl (_, block_decl_info) -> | Clang_ast_t.BlockDecl (_, block_decl_info) ->
let open CContext in let open CContext in
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let block_pname = CProcname.mk_fresh_block_procname procname in let block_pname = CProcname.mk_fresh_block_procname procname in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
(* We need to set the explicit dependency between the newly created block and the *) (* We need to set the explicit dependency between the newly created block and the *)
(* defining procedure. We add an edge in the call graph.*) (* defining procedure. We add an edge in the call graph.*)
Cg.add_edge context.cg procname block_pname; Cg.add_edge context.cg procname block_pname;
@ -2050,7 +2049,7 @@ struct
let captureds = CVar_decl.captured_vars_from_block_info context captured_block_vars in let captureds = CVar_decl.captured_vars_from_block_info context captured_block_vars in
let ids_instrs = List.map ~f:assign_captured_var captureds in let ids_instrs = List.map ~f:assign_captured_var captureds in
let ids, instrs = List.unzip ids_instrs in let ids, instrs = List.unzip ids_instrs in
let block_data = (context, type_ptr, block_pname, captureds) in let block_data = (context, qual_type, block_pname, captureds) in
F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl F.function_decl context.translation_unit_context context.tenv context.cfg context.cg decl
(Some block_data); (Some block_data);
let captured_vars = let captured_vars =
@ -2095,12 +2094,12 @@ struct
and lambdaExpr_trans trans_state expr_info decl = and lambdaExpr_trans trans_state expr_info decl =
let open CContext in let open CContext in
let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in let qual_type = expr_info.Clang_ast_t.ei_qual_type in
let context = trans_state.context in let context = trans_state.context in
call_translation context decl; call_translation context decl;
let procname = Procdesc.get_proc_name context.procdesc in let procname = Procdesc.get_proc_name context.procdesc in
let lambda_pname = CMethod_trans.get_procname_from_cpp_lambda context decl in let lambda_pname = CMethod_trans.get_procname_from_cpp_lambda context decl in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.tenv qual_type in
(* We need to set the explicit dependency between the newly created lambda and the *) (* We need to set the explicit dependency between the newly created lambda and the *)
(* defining procedure. We add an edge in the call graph.*) (* defining procedure. We add an edge in the call graph.*)
Cg.add_edge context.cg procname lambda_pname; Cg.add_edge context.cg procname lambda_pname;
@ -2216,14 +2215,14 @@ struct
let trans_state' = { trans_state with var_exp_typ = var_exp_typ } in let trans_state' = { trans_state with var_exp_typ = var_exp_typ } in
instruction trans_state' stmt instruction trans_state' stmt
and cxxDynamicCastExpr_trans trans_state stmt_info stmts cast_type_ptr = and cxxDynamicCastExpr_trans trans_state stmt_info stmts cast_qual_type =
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let trans_state' = { trans_state_pri with succ_nodes = [] } in let trans_state' = { trans_state_pri with succ_nodes = [] } in
let context = trans_state.context in let context = trans_state.context in
let subtypes = Subtype.subtypes_cast in let subtypes = Subtype.subtypes_cast in
let tenv = context.CContext.tenv in let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let cast_type = CType_decl.type_ptr_to_sil_type tenv cast_type_ptr in let cast_type = CType_decl.qual_type_to_sil_type tenv cast_qual_type in
let sizeof_expr = match cast_type.desc with let sizeof_expr = match cast_type.desc with
| Typ.Tptr (typ, _) -> Exp.Sizeof (typ, None, subtypes) | Typ.Tptr (typ, _) -> Exp.Sizeof (typ, None, subtypes)
| _ -> assert false in | _ -> assert false in
@ -2308,8 +2307,7 @@ struct
let context = trans_state.context in let context = trans_state.context in
let tenv = context.CContext.tenv in let tenv = context.CContext.tenv in
let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in let sil_loc = CLocation.get_sil_location stmt_info trans_state.context in
let type_pointer = expr_info.Clang_ast_t.ei_type_ptr in let typ = CType_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in
let typ = CType_decl.type_ptr_to_sil_type tenv type_pointer in
let fun_name = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_fun in let fun_name = Typ.Procname.from_string_c_fun CFrontend_config.infer_skip_fun in
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let trans_state_param = { trans_state_pri with succ_nodes = [] } in let trans_state_param = { trans_state_pri with succ_nodes = [] } in
@ -2606,8 +2604,8 @@ struct
(* right now we ignore this expression and try to translate the child node *) (* right now we ignore this expression and try to translate the child node *)
parenExpr_trans trans_state stmt_list parenExpr_trans trans_state stmt_list
| CXXDynamicCastExpr (stmt_info, stmts, _, _, type_ptr, _) -> | CXXDynamicCastExpr (stmt_info, stmts, _, _, qual_type, _) ->
cxxDynamicCastExpr_trans trans_state stmt_info stmts type_ptr cxxDynamicCastExpr_trans trans_state stmt_info stmts qual_type
| CXXDefaultArgExpr (_, _, _, default_expr_info) | CXXDefaultArgExpr (_, _, _, default_expr_info)
| CXXDefaultInitExpr (_, _, _, default_expr_info) -> | CXXDefaultInitExpr (_, _, _, default_expr_info) ->
@ -2676,8 +2674,9 @@ struct
let child_stmt_info = let child_stmt_info =
{ (Ast_expressions.dummy_stmt_info ()) with Clang_ast_t.si_source_range = source_range } in { (Ast_expressions.dummy_stmt_info ()) with Clang_ast_t.si_source_range = source_range } in
let trans_state' = PriorityNode.try_claim_priority_node trans_state this_stmt_info in let trans_state' = PriorityNode.try_claim_priority_node trans_state this_stmt_info in
let class_type_ptr = Ast_expressions.create_pointer_type (Clang_ast_extend.DeclPtr class_ptr) in let class_qual_type = Ast_expressions.create_pointer_qual_type ~is_const:false
let this_res_trans = this_expr_trans trans_state' sil_loc class_type_ptr in (CAst_utils.qual_type_of_decl_ptr class_ptr) in
let this_res_trans = this_expr_trans trans_state' sil_loc class_qual_type in
let var_res_trans = match ctor_init.Clang_ast_t.xci_subject with let var_res_trans = match ctor_init.Clang_ast_t.xci_subject with
| `Delegating _ | `BaseClass _ -> | `Delegating _ | `BaseClass _ ->
let this_exp, this_typ = extract_exp_from_list this_res_trans.exps let this_exp, this_typ = extract_exp_from_list this_res_trans.exps

4
infer/src/clang/cTrans_models.ml
Unescape View File

@ -73,7 +73,7 @@ let is_modeled_attribute attr_name =
let get_first_param_typedef_string_opt type_ptr = let get_first_param_typedef_string_opt type_ptr =
match CAst_utils.get_desugared_type type_ptr with match CAst_utils.get_desugared_type type_ptr with
| Some Clang_ast_t.FunctionProtoType (_, _, {pti_params_type = [param_ptr]}) -> | Some Clang_ast_t.FunctionProtoType (_, _, {pti_params_type = [param_ptr]}) ->
CAst_utils.name_opt_of_typedef_type_ptr param_ptr CAst_utils.name_opt_of_typedef_qual_type param_ptr
|> Option.map ~f:QualifiedCppName.to_qual_string |> Option.map ~f:QualifiedCppName.to_qual_string
| _ -> None | _ -> None
@ -150,7 +150,7 @@ let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname la
String.equal method_name CFrontend_config.string_with_utf8_m in String.equal method_name CFrontend_config.string_with_utf8_m in
let id_type = Ast_expressions.create_id_type in let id_type = Ast_expressions.create_id_type in
let args = [(Mangled.from_string "x", let args = [(Mangled.from_string "x",
Ast_expressions.create_char_star_qual_type ~is_const:true)] in Ast_expressions.create_char_star_type ~is_const:true)] in
get_predefined_ms_method condition class_name method_name Typ.Procname.ObjCClassMethod get_predefined_ms_method condition class_name method_name Typ.Procname.ObjCClassMethod
mk_procname lang args id_type [] None mk_procname lang args id_type [] None

26
infer/src/clang/cTrans_utils.ml
Unescape View File

@ -351,9 +351,9 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
PriorityNode.compute_results_to_parent trans_state loc nname stmt_info [res_trans_tmp] in PriorityNode.compute_results_to_parent trans_state loc nname stmt_info [res_trans_tmp] in
{ res_trans with exps = [(Exp.Var init_ret_id, alloc_ret_type)]} { res_trans with exps = [(Exp.Var init_ret_id, alloc_ret_type)]}
let new_or_alloc_trans trans_state loc stmt_info type_ptr class_name_opt selector = let new_or_alloc_trans trans_state loc stmt_info qual_type class_name_opt selector =
let tenv = trans_state.context.CContext.tenv in let tenv = trans_state.context.CContext.tenv in
let function_type = CType_decl.type_ptr_to_sil_type tenv type_ptr in let function_type = CType_decl.qual_type_to_sil_type tenv qual_type in
let class_name = let class_name =
match class_name_opt with match class_name_opt with
| Some class_name -> class_name | Some class_name -> class_name
@ -548,20 +548,20 @@ let extract_stmt_from_singleton stmt_list warning_string =
let rec get_type_from_exp_stmt stmt = let rec get_type_from_exp_stmt stmt =
let do_decl_ref_exp i = let do_decl_ref_exp i =
match i.Clang_ast_t.drti_decl_ref with match i.Clang_ast_t.drti_decl_ref with
| Some d -> (match d.Clang_ast_t.dr_type_ptr with | Some d -> (match d.Clang_ast_t.dr_qual_type with
| Some n -> n | Some n -> n
| _ -> assert false ) | _ -> assert false )
| _ -> assert false in | _ -> assert false in
let open Clang_ast_t in let open Clang_ast_t in
match stmt with match stmt with
| CXXOperatorCallExpr(_, _, ei) | CXXOperatorCallExpr(_, _, ei)
| CallExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr | CallExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr | MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type
| ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_type_ptr | ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr | ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr | ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type
| ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_type_ptr | ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_qual_type
| PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr | PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type
| CStyleCastExpr(_, stmt_list, _, _, _) | CStyleCastExpr(_, stmt_list, _, _, _)
| UnaryOperator(_, stmt_list, _, _) | UnaryOperator(_, stmt_list, _, _)
| ImplicitCastExpr(_, stmt_list, _, _) -> | ImplicitCastExpr(_, stmt_list, _, _) ->
@ -658,7 +658,7 @@ let rec contains_opaque_value_expr s =
(* checks if a unary operator is a logic negation applied to integers*) (* checks if a unary operator is a logic negation applied to integers*)
let is_logical_negation_of_int tenv ei uoi = let is_logical_negation_of_int tenv ei uoi =
match (CType_decl.type_ptr_to_sil_type tenv ei.Clang_ast_t.ei_type_ptr).desc, match (CType_decl.qual_type_to_sil_type tenv ei.Clang_ast_t.ei_qual_type).desc,
uoi.Clang_ast_t.uoi_kind with uoi.Clang_ast_t.uoi_kind with
| Typ.Tint _,`LNot -> true | Typ.Tint _,`LNot -> true
| _, _ -> false | _, _ -> false
@ -668,8 +668,8 @@ let rec is_block_stmt stmt =
match stmt with match stmt with
| BlockExpr _ -> true | BlockExpr _ -> true
| DeclRefExpr (_, _, expr_info, _) -> | DeclRefExpr (_, _, expr_info, _) ->
let tp = expr_info.Clang_ast_t.ei_type_ptr in let qt = expr_info.Clang_ast_t.ei_qual_type in
CType.is_block_type tp CType.is_block_type qt
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple stmt) with | _ -> (match snd (Clang_ast_proj.get_stmt_tuple stmt) with
| [sub_stmt] -> is_block_stmt sub_stmt | [sub_stmt] -> is_block_stmt sub_stmt
| _ -> false) | _ -> false)

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

@ -76,7 +76,7 @@ val is_enumeration_constant : Clang_ast_t.stmt -> bool
val is_member_exp : Clang_ast_t.stmt -> bool val is_member_exp : Clang_ast_t.stmt -> bool
val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.type_ptr val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.qual_type
(** Given trans_result with ONE expression, create temporary variable with dereferenced value of an (** Given trans_result with ONE expression, create temporary variable with dereferenced value of an
expression assigned to it *) expression assigned to it *)
@ -109,7 +109,7 @@ val alloc_trans :
Typ.Procname.t option -> trans_result Typ.Procname.t option -> trans_result
val new_or_alloc_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info -> val new_or_alloc_trans : trans_state -> Location.t -> Clang_ast_t.stmt_info ->
Clang_ast_t.type_ptr -> Typ.Name.t option -> string -> trans_result Clang_ast_t.qual_type -> Typ.Name.t option -> string -> trans_result
val cpp_new_trans : Location.t -> Typ.t -> Exp.t option -> trans_result val cpp_new_trans : Location.t -> Typ.t -> Exp.t option -> trans_result

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

@ -59,8 +59,8 @@ let pointer_attribute_of_objc_attribute attr_info =
| `OCL_Weak -> Typ.Pk_objc_weak | `OCL_Weak -> Typ.Pk_objc_weak
| `OCL_Autoreleasing -> Typ.Pk_objc_autoreleasing | `OCL_Autoreleasing -> Typ.Pk_objc_autoreleasing
let rec build_array_type translate_decl tenv type_ptr n_opt = let rec build_array_type translate_decl tenv (qual_type : Clang_ast_t.qual_type) n_opt =
let array_type = type_ptr_to_sil_type translate_decl tenv type_ptr in let array_type = qual_type_to_sil_type translate_decl tenv qual_type in
let len = Option.map ~f:(fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in let len = Option.map ~f:(fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in
Typ.mk (Tarray (array_type, len)) Typ.mk (Tarray (array_type, len))
@ -68,8 +68,8 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info =
match type_info.Clang_ast_t.ti_desugared_type with match type_info.Clang_ast_t.ti_desugared_type with
| Some type_ptr -> | Some type_ptr ->
(match CAst_utils.get_type type_ptr with (match CAst_utils.get_type type_ptr with
| Some Clang_ast_t.ObjCObjectPointerType (_, {Clang_ast_t.qt_type_ptr}) -> | Some Clang_ast_t.ObjCObjectPointerType (_, qual_type) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, pointer_attribute_of_objc_attribute attr_info)) Typ.mk (Tptr (typ, pointer_attribute_of_objc_attribute attr_info))
| _ -> type_ptr_to_sil_type translate_decl tenv type_ptr) | _ -> type_ptr_to_sil_type translate_decl tenv type_ptr)
| None -> Typ.mk Tvoid | None -> Typ.mk Tvoid
@ -80,48 +80,48 @@ and sil_type_of_c_type translate_decl tenv c_type : Typ.t =
| NoneType _ -> Typ.mk Tvoid | NoneType _ -> Typ.mk Tvoid
| BuiltinType (_, builtin_type_kind) -> | BuiltinType (_, builtin_type_kind) ->
sil_type_of_builtin_type_kind builtin_type_kind sil_type_of_builtin_type_kind builtin_type_kind
| PointerType (_, {Clang_ast_t.qt_type_ptr}) | PointerType (_, qual_type)
| ObjCObjectPointerType (_, {Clang_ast_t.qt_type_ptr}) -> | ObjCObjectPointerType (_, qual_type) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in let typ = qual_type_to_sil_type translate_decl tenv qual_type in
if Typ.equal typ (get_builtin_objc_type `ObjCClass) then if Typ.equal typ (get_builtin_objc_type `ObjCClass) then
typ typ
else Typ.mk (Tptr (typ, Typ.Pk_pointer)) else Typ.mk (Tptr (typ, Typ.Pk_pointer))
| ObjCObjectType (_, objc_object_type_info) -> | ObjCObjectType (_, objc_object_type_info) ->
type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type
| BlockPointerType (_, type_ptr) -> | BlockPointerType (_, qual_type) ->
let typ = type_ptr_to_sil_type translate_decl tenv type_ptr in let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, Typ.Pk_pointer)) Typ.mk (Tptr (typ, Typ.Pk_pointer))
| IncompleteArrayType (_, type_ptr) | IncompleteArrayType (_, qual_type)
| DependentSizedArrayType (_, type_ptr) | DependentSizedArrayType (_, qual_type)
| VariableArrayType (_, type_ptr) -> | VariableArrayType (_, qual_type) ->
build_array_type translate_decl tenv type_ptr None build_array_type translate_decl tenv qual_type None
| ConstantArrayType (_, type_ptr, n) -> | ConstantArrayType (_, qual_type, n) ->
build_array_type translate_decl tenv type_ptr (Some n) build_array_type translate_decl tenv qual_type (Some n)
| FunctionProtoType _ | FunctionProtoType _
| FunctionNoProtoType _ -> | FunctionNoProtoType _ ->
Typ.mk (Tfun false) Typ.mk (Tfun false)
| ParenType (_, type_ptr) -> | ParenType (_, qual_type) ->
type_ptr_to_sil_type translate_decl tenv type_ptr qual_type_to_sil_type translate_decl tenv qual_type
| DecayedType (_, type_ptr) -> | DecayedType (_, qual_type) ->
type_ptr_to_sil_type translate_decl tenv type_ptr qual_type_to_sil_type translate_decl tenv qual_type
| RecordType (_, pointer) | RecordType (_, pointer)
| EnumType (_, pointer) -> | EnumType (_, pointer) ->
decl_ptr_to_sil_type translate_decl tenv pointer decl_ptr_to_sil_type translate_decl tenv pointer
| ElaboratedType (type_info) -> | ElaboratedType (type_info) ->
(match type_info.Clang_ast_t.ti_desugared_type with (match type_info.Clang_ast_t.ti_desugared_type with (* TODO desugar to qualtype *)
Some type_ptr -> type_ptr_to_sil_type translate_decl tenv type_ptr Some type_ptr -> type_ptr_to_sil_type translate_decl tenv type_ptr
| None -> Typ.mk Tvoid) | None -> Typ.mk Tvoid)
| ObjCInterfaceType (_, pointer) -> | ObjCInterfaceType (_, pointer) ->
decl_ptr_to_sil_type translate_decl tenv pointer decl_ptr_to_sil_type translate_decl tenv pointer
| RValueReferenceType (_, {Clang_ast_t.qt_type_ptr}) | RValueReferenceType (_, qual_type)
| LValueReferenceType (_, {Clang_ast_t.qt_type_ptr}) -> | LValueReferenceType (_, qual_type) ->
let typ = type_ptr_to_sil_type translate_decl tenv qt_type_ptr in let typ = qual_type_to_sil_type translate_decl tenv qual_type in
Typ.mk (Tptr (typ, Typ.Pk_reference)) Typ.mk (Tptr (typ, Typ.Pk_reference))
| AttributedType (type_info, attr_info) -> | AttributedType (type_info, attr_info) -> (* TODO desugar to qualtyp *)
sil_type_of_attr_type translate_decl tenv type_info attr_info sil_type_of_attr_type translate_decl tenv type_info attr_info
| _ -> (* TypedefType, etc *) | _ -> (* TypedefType, etc *)
let type_info = Clang_ast_proj.get_type_tuple c_type in let type_info = Clang_ast_proj.get_type_tuple c_type in
match type_info.Clang_ast_t.ti_desugared_type with match type_info.Clang_ast_t.ti_desugared_type with (* TODO desugar typedeftype to qualtype *)
| Some typ -> type_ptr_to_sil_type translate_decl tenv typ | Some typ -> type_ptr_to_sil_type translate_decl tenv typ
| None -> Typ.mk Tvoid | None -> Typ.mk Tvoid
@ -165,13 +165,16 @@ and type_ptr_to_sil_type translate_decl tenv type_ptr =
| Clang_ast_types.TypePtr.Ptr _ -> clang_type_ptr_to_sil_type translate_decl tenv type_ptr | Clang_ast_types.TypePtr.Ptr _ -> clang_type_ptr_to_sil_type translate_decl tenv type_ptr
| Clang_ast_extend.Builtin kind -> sil_type_of_builtin_type_kind kind | Clang_ast_extend.Builtin kind -> sil_type_of_builtin_type_kind kind
| Clang_ast_extend.PointerOf typ -> | Clang_ast_extend.PointerOf typ ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in let sil_typ = qual_type_to_sil_type translate_decl tenv typ in
Typ.mk (Tptr (sil_typ, Pk_pointer)) Typ.mk (Tptr (sil_typ, Pk_pointer))
| Clang_ast_extend.ReferenceOf typ -> | Clang_ast_extend.ReferenceOf typ ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in let sil_typ = qual_type_to_sil_type translate_decl tenv typ in
Typ.mk (Tptr (sil_typ, Pk_reference)) Typ.mk (Tptr (sil_typ, Pk_reference))
| Clang_ast_extend.ClassType typename -> | Clang_ast_extend.ClassType typename ->
Typ.mk (Tstruct typename) Typ.mk (Tstruct typename)
| Clang_ast_extend.DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr | Clang_ast_extend.DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr
| Clang_ast_extend.ErrorType -> Typ.mk Tvoid | Clang_ast_extend.ErrorType -> Typ.mk Tvoid
| _ -> raise (invalid_arg "unknown variant for type_ptr") | _ -> raise (invalid_arg "unknown variant for type_ptr")
and qual_type_to_sil_type translate_decl tenv qual_type =
type_ptr_to_sil_type translate_decl tenv qual_type.Clang_ast_t.qt_type_ptr (* FIXME *)

3
infer/src/clang/cType_to_sil_type.mli
Unescape View File

@ -17,3 +17,6 @@ val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Typ.t
val type_ptr_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) -> val type_ptr_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) ->
Tenv.t -> Clang_ast_t.type_ptr -> Typ.t Tenv.t -> Clang_ast_t.type_ptr -> Typ.t
val qual_type_to_sil_type : (Tenv.t -> Clang_ast_t.decl -> Typ.t) ->
Tenv.t -> Clang_ast_t.qual_type -> Typ.t

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

@ -68,9 +68,9 @@ let compute_autorelease_pool_vars context stmts =
| Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' -> | Clang_ast_t.DeclRefExpr (_, _, _, drei):: stmts' ->
let map1 = match drei.Clang_ast_t.drti_decl_ref with let map1 = match drei.Clang_ast_t.drti_decl_ref with
| Some decl_ref -> | Some decl_ref ->
(match decl_ref.Clang_ast_t.dr_type_ptr with (match decl_ref.Clang_ast_t.dr_qual_type with
| Some type_ptr when decl_ref.Clang_ast_t.dr_kind = `Var -> | Some qual_type when decl_ref.Clang_ast_t.dr_kind = `Var ->
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
let procname = Procdesc.get_proc_name context.CContext.procdesc in let procname = Procdesc.get_proc_name context.CContext.procdesc in
let pvar = sil_var_of_decl_ref context decl_ref procname in let pvar = sil_var_of_decl_ref context decl_ref procname in
if Pvar.is_local pvar then if Pvar.is_local pvar then
@ -93,15 +93,15 @@ let captured_vars_from_block_info context cvl =
let sil_var_of_captured_var cv vars = let sil_var_of_captured_var cv vars =
match cv.Clang_ast_t.bcv_variable with match cv.Clang_ast_t.bcv_variable with
| Some dr -> | Some dr ->
(match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_type_ptr with (match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_qual_type with
| Some name_info, Some type_ptr -> | Some name_info, Some qual_type ->
let n = name_info.Clang_ast_t.ni_name in let n = name_info.Clang_ast_t.ni_name in
if String.equal n CFrontend_config.self && if String.equal n CFrontend_config.self &&
not (CContext.is_objc_instance context) then not (CContext.is_objc_instance context) then
vars vars
else else
let pvar = sil_var_of_decl_ref context dr procname in let pvar = sil_var_of_decl_ref context dr procname in
let typ = CType_decl.type_ptr_to_sil_type context.CContext.tenv type_ptr in let typ = CType_decl.qual_type_to_sil_type context.CContext.tenv qual_type in
(pvar, typ) :: vars (pvar, typ) :: vars
| _ -> assert false) | _ -> assert false)
| _ -> assert false in | _ -> assert false in

17
infer/src/clang/clang_ast_extend.ml
Unescape View File

@ -17,8 +17,8 @@ open! IStd
(* Type pointers *) (* Type pointers *)
type Clang_ast_types.TypePtr.t += type Clang_ast_types.TypePtr.t +=
| Builtin of Clang_ast_t.builtin_type_kind | Builtin of Clang_ast_t.builtin_type_kind
| PointerOf of Clang_ast_types.TypePtr.t | PointerOf of Clang_ast_t.qual_type
| ReferenceOf of Clang_ast_types.TypePtr.t | ReferenceOf of Clang_ast_t.qual_type
| ClassType of Typ.Name.t | ClassType of Typ.Name.t
| DeclPtr of int | DeclPtr of int
| ErrorType | ErrorType
@ -33,10 +33,10 @@ module TypePointerOrd = struct
| Builtin a, Builtin b -> Polymorphic_compare.compare a b | Builtin a, Builtin b -> Polymorphic_compare.compare a b
| Builtin _, _ -> 1 | Builtin _, _ -> 1
| _, Builtin _ -> -1 | _, Builtin _ -> -1
| PointerOf a, PointerOf b -> compare a b | PointerOf a, PointerOf b -> compare_qual_type a b
| PointerOf _, _ -> 1 | PointerOf _, _ -> 1
| _, PointerOf _ -> -1 | _, PointerOf _ -> -1
| ReferenceOf a, ReferenceOf b -> compare a b | ReferenceOf a, ReferenceOf b -> compare_qual_type a b
| ReferenceOf _, _ -> 1 | ReferenceOf _, _ -> 1
| _, ReferenceOf _ -> -1 | _, ReferenceOf _ -> -1
| ClassType a, ClassType b -> Typ.Name.compare a b | ClassType a, ClassType b -> Typ.Name.compare a b
@ -47,6 +47,11 @@ module TypePointerOrd = struct
| _, DeclPtr _ -> -1 | _, DeclPtr _ -> -1
| ErrorType, ErrorType -> 0 | ErrorType, ErrorType -> 0
| _ -> raise (invalid_arg ("unexpected type_ptr variants: ")) | _ -> raise (invalid_arg ("unexpected type_ptr variants: "))
and compare_qual_type (qt1 : Clang_ast_t.qual_type) (qt2 : Clang_ast_t.qual_type) =
let (<>) = Int.(<>) in
let qt_cmp = compare qt1.qt_type_ptr qt2.qt_type_ptr in
if qt_cmp <> 0 then qt_cmp else
Bool.compare qt1.qt_is_const qt2.qt_is_const
end end
module TypePointerMap = Caml.Map.Make(TypePointerOrd) module TypePointerMap = Caml.Map.Make(TypePointerOrd)
@ -55,8 +60,8 @@ module TypePointerMap = Caml.Map.Make(TypePointerOrd)
let rec type_ptr_to_string = function let rec type_ptr_to_string = function
| Clang_ast_types.TypePtr.Ptr raw -> "clang_ptr_" ^ (string_of_int raw) | Clang_ast_types.TypePtr.Ptr raw -> "clang_ptr_" ^ (string_of_int raw)
| Builtin t -> "sil_" ^ (Clang_ast_j.string_of_builtin_type_kind t) | Builtin t -> "sil_" ^ (Clang_ast_j.string_of_builtin_type_kind t)
| PointerOf typ -> "pointer_of_" ^ type_ptr_to_string typ | PointerOf typ -> "pointer_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
| ReferenceOf typ -> "reference_of_" ^ type_ptr_to_string typ | ReferenceOf typ -> "reference_of_" ^ type_ptr_to_string typ.Clang_ast_t.qt_type_ptr
| ClassType name -> "class_name_" ^ Typ.Name.name name | ClassType name -> "class_name_" ^ Typ.Name.name name
| DeclPtr raw -> "decl_ptr_" ^ (string_of_int raw) | DeclPtr raw -> "decl_ptr_" ^ (string_of_int raw)
| ErrorType -> "error_type" | ErrorType -> "error_type"

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

@ -34,17 +34,17 @@ let get_classname_from_category_decl ocdi =
let get_classname_from_category_impl ocidi = let get_classname_from_category_impl ocidi =
get_classname ocidi.Clang_ast_t.ocidi_class_interface get_classname ocidi.Clang_ast_t.ocidi_class_interface
let add_category_decl type_ptr_to_sil_type tenv category_impl_info = let add_category_decl qual_type_to_sil_type tenv category_impl_info =
let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in let decl_ref_opt = category_impl_info.Clang_ast_t.ocidi_category_decl in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_class_decl type_ptr_to_sil_type tenv category_decl_info = let add_class_decl qual_type_to_sil_type tenv category_decl_info =
let decl_ref_opt = category_decl_info.Clang_ast_t.odi_class_interface in let decl_ref_opt = category_decl_info.Clang_ast_t.odi_class_interface in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt true CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_category_implementation type_ptr_to_sil_type tenv category_decl_info = let add_category_implementation qual_type_to_sil_type tenv category_decl_info =
let decl_ref_opt = category_decl_info.Clang_ast_t.odi_implementation in let decl_ref_opt = category_decl_info.Clang_ast_t.odi_implementation in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt false
let get_base_class_name_from_category decl = let get_base_class_name_from_category decl =
let open Clang_ast_t in let open Clang_ast_t in
@ -65,8 +65,8 @@ let get_base_class_name_from_category decl =
(* 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 type_ptr_to_sil_type tenv class_name decl_info decl_list = let process_category qual_type_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 decl_fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
let class_tn_name = Typ.Name.Objc.from_qual_name class_name in let class_tn_name = Typ.Name.Objc.from_qual_name class_name in
let class_tn_type = Typ.mk (Typ.Tstruct class_tn_name) in let class_tn_type = Typ.mk (Typ.Tstruct class_tn_name) in
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
@ -81,27 +81,27 @@ let process_category type_ptr_to_sil_type tenv class_name decl_info decl_list =
| _ -> ()); | _ -> ());
class_tn_type class_tn_type
let category_decl type_ptr_to_sil_type tenv decl = let category_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) -> | ObjCCategoryDecl (decl_info, name_info, decl_list, _, cdi) ->
let name = CAst_utils.get_qualified_name name_info in let name = CAst_utils.get_qualified_name name_info in
let class_name = get_classname_from_category_decl cdi in let class_name = get_classname_from_category_decl cdi in
Logging.out_debug "ADDING: ObjCCategoryDecl for '%a'\n" QualifiedCppName.pp name; Logging.out_debug "ADDING: ObjCCategoryDecl for '%a'\n" QualifiedCppName.pp name;
let _ = add_class_decl type_ptr_to_sil_type tenv cdi in let _ = add_class_decl qual_type_to_sil_type tenv cdi in
let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in let typ = process_category qual_type_to_sil_type tenv class_name decl_info decl_list in
let _ = add_category_implementation type_ptr_to_sil_type tenv cdi in let _ = add_category_implementation qual_type_to_sil_type tenv cdi in
typ typ
| _ -> assert false | _ -> assert false
let category_impl_decl type_ptr_to_sil_type tenv decl = let category_impl_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) -> | ObjCCategoryImplDecl (decl_info, name_info, decl_list, _, cii) ->
let name = CAst_utils.get_qualified_name name_info in let name = CAst_utils.get_qualified_name name_info in
let class_name = get_classname_from_category_impl cii in let class_name = get_classname_from_category_impl cii in
Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%a'\n" QualifiedCppName.pp name; Logging.out_debug "ADDING: ObjCCategoryImplDecl for '%a'\n" QualifiedCppName.pp name;
let _ = add_category_decl type_ptr_to_sil_type tenv cii in let _ = add_category_decl qual_type_to_sil_type tenv cii in
let typ = process_category type_ptr_to_sil_type tenv class_name decl_info decl_list in let typ = process_category qual_type_to_sil_type tenv class_name decl_info decl_list in
typ typ
| _ -> assert false | _ -> assert false

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

@ -12,9 +12,9 @@ open! IStd
(** 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 : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t val category_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val category_impl_decl : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t val category_impl_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val noname_category : string -> string val noname_category : string -> string

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

@ -36,23 +36,23 @@ let get_protocols protocols =
) protocols in ) protocols in
protocol_names protocol_names
let add_class_decl type_ptr_to_sil_type tenv idi = let add_class_decl qual_type_to_sil_type tenv idi =
let decl_ref_opt = idi.Clang_ast_t.oidi_class_interface in 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 CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt true
let add_super_class_decl type_ptr_to_sil_type tenv ocdi = let add_super_class_decl qual_type_to_sil_type tenv ocdi =
let decl_ref_opt = ocdi.Clang_ast_t.otdi_super in let decl_ref_opt = ocdi.Clang_ast_t.otdi_super in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false CAst_utils.add_type_from_decl_ref_opt qual_type_to_sil_type tenv decl_ref_opt false
let add_protocols_decl type_ptr_to_sil_type tenv protocols = let add_protocols_decl qual_type_to_sil_type tenv protocols =
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv protocols
let add_categories_decl type_ptr_to_sil_type tenv categories = let add_categories_decl qual_type_to_sil_type tenv categories =
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv categories CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv categories
let add_class_implementation type_ptr_to_sil_type tenv idi = let add_class_implementation qual_type_to_sil_type tenv idi =
let decl_ref_opt = idi.Clang_ast_t.otdi_implementation in let decl_ref_opt = idi.Clang_ast_t.otdi_implementation in
CAst_utils.add_type_from_decl_ref type_ptr_to_sil_type tenv decl_ref_opt false CAst_utils.add_type_from_decl_ref_opt qual_type_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. *)
@ -65,16 +65,16 @@ let get_interface_supers 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_supers_fields type_ptr_to_sil_type tenv decl_list let create_supers_fields qual_type_to_sil_type tenv decl_list
otdi_super otdi_protocols = 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 supers = get_interface_supers super protocols in let supers = get_interface_supers super protocols in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in let fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
supers, fields supers, fields
(* 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 type_ptr_to_sil_type tenv decl_info name_info decl_list ocidi = let add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info decl_list ocidi =
let class_name = CAst_utils.get_qualified_name name_info in let class_name = CAst_utils.get_qualified_name name_info in
Logging.out_debug "ADDING: ObjCInterfaceDecl for '%a'\n" QualifiedCppName.pp class_name; Logging.out_debug "ADDING: ObjCInterfaceDecl for '%a'\n" QualifiedCppName.pp class_name;
let interface_name = Typ.Name.Objc.from_qual_name class_name in let interface_name = Typ.Name.Objc.from_qual_name class_name in
@ -82,7 +82,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list oc
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
CAst_utils.update_sil_types_map decl_key interface_type; CAst_utils.update_sil_types_map decl_key interface_type;
let decl_supers, decl_fields = let decl_supers, decl_fields =
create_supers_fields type_ptr_to_sil_type tenv decl_list create_supers_fields qual_type_to_sil_type tenv decl_list
ocidi.Clang_ast_t.otdi_super ocidi.Clang_ast_t.otdi_super
ocidi.Clang_ast_t.otdi_protocols in ocidi.Clang_ast_t.otdi_protocols in
let fields_sc = CField_decl.fields_superclass tenv ocidi in let fields_sc = CField_decl.fields_superclass tenv ocidi in
@ -117,30 +117,30 @@ let add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info decl_list oc
interface_type interface_type
(* 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 type_ptr_to_sil_type tenv decl = let interface_declaration qual_type_to_sil_type tenv decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) -> | ObjCInterfaceDecl (decl_info, name_info, decl_list, _, ocidi) ->
let typ = add_class_to_tenv type_ptr_to_sil_type tenv decl_info name_info let typ = add_class_to_tenv qual_type_to_sil_type tenv decl_info name_info
decl_list ocidi in decl_list ocidi in
let _ = add_class_implementation type_ptr_to_sil_type tenv ocidi in let _ = add_class_implementation qual_type_to_sil_type tenv ocidi in
let _ = add_super_class_decl type_ptr_to_sil_type tenv ocidi in let _ = add_super_class_decl qual_type_to_sil_type tenv ocidi in
let _ = add_protocols_decl type_ptr_to_sil_type tenv ocidi.Clang_ast_t.otdi_protocols in let _ = add_protocols_decl qual_type_to_sil_type tenv ocidi.Clang_ast_t.otdi_protocols in
let known_categories = ocidi.Clang_ast_t.otdi_known_categories in let known_categories = ocidi.Clang_ast_t.otdi_known_categories in
let _ = add_categories_decl type_ptr_to_sil_type tenv known_categories in let _ = add_categories_decl qual_type_to_sil_type tenv known_categories in
typ typ
| _ -> assert false | _ -> assert false
(* Translate the methods defined in the implementation.*) (* Translate the methods defined in the implementation.*)
let interface_impl_declaration type_ptr_to_sil_type tenv decl = let interface_impl_declaration qual_type_to_sil_type tenv decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) -> | ObjCImplementationDecl (decl_info, name_info, decl_list, _, idi) ->
let class_name = CAst_utils.get_qualified_name name_info in let class_name = CAst_utils.get_qualified_name name_info in
Logging.out_debug Logging.out_debug
"ADDING: ObjCImplementationDecl for class '%a'\n" QualifiedCppName.pp class_name; "ADDING: ObjCImplementationDecl for class '%a'\n" QualifiedCppName.pp class_name;
let _ = add_class_decl type_ptr_to_sil_type tenv idi in let _ = add_class_decl qual_type_to_sil_type tenv idi in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv decl_list in let fields = CField_decl.get_fields qual_type_to_sil_type tenv decl_list in
CField_decl.add_missing_fields tenv class_name fields; CField_decl.add_missing_fields tenv class_name fields;
let class_tn_name = Typ.Name.Objc.from_qual_name class_name in let class_tn_name = Typ.Name.Objc.from_qual_name class_name in
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in

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

@ -12,10 +12,10 @@ open! IStd
(** In this module an ObjC interface declaration is processed. The class is saved in the tenv as a (** 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 *) struct with the corresponding fields, potential superclass and list of defined methods *)
val interface_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> val interface_declaration : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
Typ.t Typ.t
val interface_impl_declaration : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> val interface_impl_declaration : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl ->
Typ.t Typ.t
val is_pointer_to_objc_class : Typ.t -> bool val is_pointer_to_objc_class : Typ.t -> bool

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

@ -11,11 +11,11 @@ open! IStd
module L = Logging module L = Logging
let add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info = let add_protocol_super qual_type_to_sil_type tenv obj_c_protocol_decl_info =
let protocols = obj_c_protocol_decl_info.Clang_ast_t.opcdi_protocols in let protocols = obj_c_protocol_decl_info.Clang_ast_t.opcdi_protocols in
CAst_utils.add_type_from_decl_ref_list type_ptr_to_sil_type tenv protocols CAst_utils.add_type_from_decl_ref_list qual_type_to_sil_type tenv protocols
let protocol_decl type_ptr_to_sil_type tenv decl = let protocol_decl qual_type_to_sil_type tenv decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| ObjCProtocolDecl(decl_info, name_info, _, _, obj_c_protocol_decl_info) -> | ObjCProtocolDecl(decl_info, name_info, _, _, obj_c_protocol_decl_info) ->
@ -30,7 +30,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl =
let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in let decl_key = Clang_ast_extend.DeclPtr decl_info.Clang_ast_t.di_pointer in
CAst_utils.update_sil_types_map decl_key protocol_type; CAst_utils.update_sil_types_map decl_key protocol_type;
ignore( Tenv.mk_struct tenv ~methods:[] protocol_name ); ignore( Tenv.mk_struct tenv ~methods:[] protocol_name );
add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info; add_protocol_super qual_type_to_sil_type tenv obj_c_protocol_decl_info;
protocol_type protocol_type
| _ -> assert false | _ -> assert false

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

@ -12,6 +12,6 @@ open! IStd
(** 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 : CAst_utils.type_ptr_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t val protocol_decl : CAst_utils.qual_type_to_sil_type -> Tenv.t -> Clang_ast_t.decl -> Typ.t
val is_protocol : Clang_ast_t.decl -> bool val is_protocol : Clang_ast_t.decl -> bool

Write Preview
Loading…
Cancel
Save