Update fcp and remove qual_type type

Summary: @​public
qual_type was the same as type_ptr, so it was removed.
This commit makes it compatible with facebook-clang-plugins

Commands ran:
codemod --extensions ml,mli 'qual_type' 'type_ptr'
codemod --extensions ml,mli 'qt' 'tp'

If there is any other popular name for qual_type, let me know

Reviewed By: @dulmarod

Differential Revision: D2498289
master
Andrzej Kotulski 9 years ago committed by facebook-github-bot-1
parent 30a7a2fd8e
commit d6b1d422fd

@ -1 +1 @@
Subproject commit 52b5fd8f3c171c2782f243532fd316236e6a0348 Subproject commit 657a463bfb6cd9e194684f5953c66f196a078ff9

@ -76,43 +76,43 @@ let stmt_info_with_fresh_pointer stmt_info = {
si_source_range = stmt_info.Clang_ast_t.si_source_range; si_source_range = stmt_info.Clang_ast_t.si_source_range;
} }
let create_qual_type_with_just_pointer pointer = pointer let create_type_ptr_with_just_pointer pointer = pointer
let get_constant_qual_type s = let get_constant_type_ptr s =
let pointer = CFrontend_config.type_pointer_prefix ^ s in let pointer = CFrontend_config.type_pointer_prefix ^ s in
pointer pointer
(* Whenever new type are added manually to the translation here, *) (* Whenever new type are added manually to the translation here, *)
(* they should be added to the map in cTypes_decl too!! *) (* they should be added to the map in cTypes_decl too!! *)
let create_int_type = let create_int_type =
get_constant_qual_type "int" get_constant_type_ptr "int"
let create_void_type = let create_void_type =
get_constant_qual_type "void" get_constant_type_ptr "void"
let create_void_star_type = let create_void_star_type =
get_constant_qual_type "void *" get_constant_type_ptr "void *"
let create_id_type = let create_id_type =
get_constant_qual_type CFrontend_config.id_cl get_constant_type_ptr CFrontend_config.id_cl
let create_nsarray_star_type = let create_nsarray_star_type =
get_constant_qual_type (CFrontend_config.nsarray_cl ^ " *") get_constant_type_ptr (CFrontend_config.nsarray_cl ^ " *")
let create_char_star_type = let create_char_star_type =
get_constant_qual_type "char *" get_constant_type_ptr "char *"
let create_BOOL_type = let create_BOOL_type =
get_constant_qual_type "signed char" get_constant_type_ptr "signed char"
let create_unsigned_long_type = let create_unsigned_long_type =
get_constant_qual_type "unsigned long" get_constant_type_ptr "unsigned long"
let create_void_unsigned_long_type = let create_void_unsigned_long_type =
get_constant_qual_type "void *(unsigned long)" get_constant_type_ptr "void *(unsigned long)"
let create_void_void_type = let create_void_void_type =
get_constant_qual_type "void (void *)" get_constant_type_ptr "void (void *)"
let create_class_type class_name = "custom_class_name*" ^ class_name let create_class_type class_name = "custom_class_name*" ^ class_name
@ -123,7 +123,7 @@ let create_pointer_type class_type = "custom_pointer_" ^ class_type
let create_integer_literal stmt_info n = let create_integer_literal stmt_info 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_qual_type = create_int_type; Clang_ast_t.ei_type_ptr = create_int_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -134,9 +134,9 @@ let create_integer_literal stmt_info 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 qt = let create_cstyle_cast_expr stmt_info stmts tp =
let expr_info = { let expr_info = {
Clang_ast_t.ei_qual_type = create_void_star_type; Clang_ast_t.ei_type_ptr = create_void_star_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -144,11 +144,11 @@ let create_cstyle_cast_expr stmt_info stmts qt =
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, qt) Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, tp)
let create_parent_expr stmt_info stmts = let create_parent_expr stmt_info stmts =
let expr_info = { let expr_info = {
Clang_ast_t.ei_qual_type = create_void_star_type; Clang_ast_t.ei_type_ptr = create_void_star_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -156,7 +156,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_qual_type = typ; Clang_ast_t.ei_type_ptr = typ;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary; ei_object_kind = `Ordinary;
} in } in
@ -182,17 +182,17 @@ 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 qt vk objc_kind = { let make_expr_info tp vk objc_kind = {
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_type_ptr = tp;
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 qt objc_kind = let make_expr_info_with_objc_kind tp objc_kind =
make_expr_info qt `LValue objc_kind make_expr_info tp `LValue objc_kind
let make_lvalue_obc_prop_expr_info qt = let make_lvalue_obc_prop_expr_info tp =
make_expr_info qt `LValue `ObjCProperty make_expr_info tp `LValue `ObjCProperty
let make_method_decl_info mdi body = let make_method_decl_info mdi body =
{ mdi with Clang_ast_t.omdi_body = Some body; } { mdi with Clang_ast_t.omdi_body = Some body; }
@ -211,36 +211,36 @@ 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 qt = { let make_obj_c_message_expr_info_class selector tp = {
Clang_ast_t.omei_selector = selector; Clang_ast_t.omei_selector = selector;
omei_receiver_kind = `Class (create_class_type qt); omei_receiver_kind = `Class (create_class_type tp);
omei_is_definition_found = false; omei_is_definition_found = false;
omei_decl_pointer = None (* TODO look into it *) omei_decl_pointer = None (* TODO look into it *)
} }
let make_decl_ref k decl_ptr name is_hidden qt_opt = { let make_decl_ref k decl_ptr name is_hidden tp_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_qual_type = qt_opt dr_type_ptr = tp_opt
} }
let make_decl_ref_qt k decl_ptr name is_hidden qt = let make_decl_ref_tp k decl_ptr name is_hidden tp =
make_decl_ref k decl_ptr name is_hidden (Some qt) make_decl_ref k decl_ptr name is_hidden (Some tp)
let make_decl_ref_no_qt k decl_ptr name is_hidden = let make_decl_ref_no_tp 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 qt = let make_decl_ref_invalid k name is_hidden tp =
make_decl_ref k (Ast_utils.get_invalid_pointer ()) name is_hidden (Some qt) make_decl_ref k (Ast_utils.get_invalid_pointer ()) name is_hidden (Some tp)
let make_decl_ref_self ptr qt = { let make_decl_ref_self ptr tp = {
Clang_ast_t.dr_kind = `ImplicitParam; Clang_ast_t.dr_kind = `ImplicitParam;
dr_decl_pointer = ptr; dr_decl_pointer = ptr;
dr_name = Some (Ast_utils.make_name_decl "self"); dr_name = Some (Ast_utils.make_name_decl "self");
dr_is_hidden = false ; dr_is_hidden = false ;
dr_qual_type = Some qt dr_type_ptr = Some tp
} }
let make_decl_ref_expr_info decl_ref = { let make_decl_ref_expr_info decl_ref = {
@ -248,15 +248,15 @@ let make_decl_ref_expr_info decl_ref = {
drti_found_decl_ref = None; drti_found_decl_ref = None;
} }
let make_obj_c_ivar_ref_expr_info k ptr n qt = { let make_obj_c_ivar_ref_expr_info k ptr n tp = {
Clang_ast_t.ovrei_decl_ref = make_decl_ref_qt k ptr n false qt; Clang_ast_t.ovrei_decl_ref = make_decl_ref_tp k ptr n false tp;
ovrei_pointer = Ast_utils.get_fresh_pointer (); ovrei_pointer = Ast_utils.get_fresh_pointer ();
ovrei_is_free_ivar = true; ovrei_is_free_ivar = true;
} }
(* Build an AST cast expression of a decl_ref_expr *) (* Build an AST cast expression of a decl_ref_expr *)
let make_cast_expr qt di decl_ref_expr_info objc_kind = let make_cast_expr tp di decl_ref_expr_info objc_kind =
let expr_info = make_expr_info_with_objc_kind qt objc_kind in let expr_info = make_expr_info_with_objc_kind tp objc_kind in
let stmt_info = make_stmt_info di in let stmt_info = make_stmt_info di in
let decl_ref_exp = make_decl_ref_exp stmt_info expr_info decl_ref_expr_info in let decl_ref_exp = make_decl_ref_exp stmt_info expr_info decl_ref_expr_info in
let cast_expr = { let cast_expr = {
@ -268,21 +268,21 @@ let make_cast_expr qt di decl_ref_expr_info objc_kind =
cast_exp_rhs cast_exp_rhs
(* Build AST expression self.field_name as `LValue *) (* Build AST expression self.field_name as `LValue *)
let make_self_field class_type di qt field_name = let make_self_field class_type di tp field_name =
let qt_class = create_pointer_type (create_class_type class_type) in let tp_class = create_pointer_type (create_class_type class_type) in
let expr_info = make_expr_info_with_objc_kind qt `ObjCProperty in let expr_info = make_expr_info_with_objc_kind tp `ObjCProperty in
let stmt_info = make_stmt_info di in let stmt_info = make_stmt_info di in
let cast_exp = make_cast_expr qt_class di (make_decl_ref_expr_info (make_decl_ref_self di.Clang_ast_t.di_pointer qt_class)) `ObjCProperty in let cast_exp = make_cast_expr tp_class di (make_decl_ref_expr_info (make_decl_ref_self di.Clang_ast_t.di_pointer tp_class)) `ObjCProperty in
let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info (`ObjCIvar) di.Clang_ast_t.di_pointer field_name qt in let obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info (`ObjCIvar) di.Clang_ast_t.di_pointer field_name tp in
let ivar_ref_exp = let ivar_ref_exp =
Clang_ast_t.ObjCIvarRefExpr(stmt_info, [cast_exp], expr_info, obj_c_ivar_ref_expr_info) in Clang_ast_t.ObjCIvarRefExpr(stmt_info, [cast_exp], expr_info, obj_c_ivar_ref_expr_info) in
ivar_ref_exp ivar_ref_exp
(* Build AST expression for self.field_name casted as `RValue. *) (* Build AST expression for self.field_name casted as `RValue. *)
let make_deref_self_field class_decl_opt di qt field_name = let make_deref_self_field class_decl_opt di tp field_name =
let stmt_info = make_stmt_info di in let stmt_info = make_stmt_info di in
let ivar_ref_exp = make_self_field class_decl_opt di qt field_name in let ivar_ref_exp = make_self_field class_decl_opt di tp field_name in
let expr_info' = make_expr_info_with_objc_kind qt `ObjCProperty in let expr_info' = make_expr_info_with_objc_kind tp `ObjCProperty in
let cast_exp_info = { let cast_exp_info = {
Clang_ast_t.cei_cast_kind = `LValueToRValue; Clang_ast_t.cei_cast_kind = `LValueToRValue;
cei_base_path = []; cei_base_path = [];
@ -291,7 +291,7 @@ let make_deref_self_field class_decl_opt di qt field_name =
Clang_ast_t.ImplicitCastExpr(stmt_info, [ivar_ref_exp], expr_info', cast_exp_info) in Clang_ast_t.ImplicitCastExpr(stmt_info, [ivar_ref_exp], expr_info', cast_exp_info) in
cast_exp' cast_exp'
let make_objc_ivar_decl decl_info qt property_impl_decl_info ivar_name = let make_objc_ivar_decl decl_info tp property_impl_decl_info ivar_name =
let field_decl_info = { let field_decl_info = {
Clang_ast_t.fldi_is_mutable = true; Clang_ast_t.fldi_is_mutable = true;
fldi_is_module_private = true; fldi_is_module_private = true;
@ -302,16 +302,16 @@ let make_objc_ivar_decl decl_info qt property_impl_decl_info ivar_name =
Clang_ast_t.ovdi_is_synthesize = true; (* NOTE: We set true here because we use this definition to synthesize the getter/setter*) 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; ovdi_access_control = `Private;
} in } in
Clang_ast_t.ObjCIvarDecl(decl_info, ivar_name, qt, field_decl_info, obj_c_ivar_decl_info) Clang_ast_t.ObjCIvarDecl(decl_info, ivar_name, tp, field_decl_info, obj_c_ivar_decl_info)
let make_expr_info qt = { let make_expr_info tp = {
Clang_ast_t.ei_qual_type = qt; 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 qt vk ok = { let make_general_expr_info tp vk ok = {
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_type_ptr = tp;
ei_value_kind = vk; ei_value_kind = vk;
ei_object_kind = ok ei_object_kind = ok
} }
@ -320,21 +320,21 @@ 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_decl_ref_exp_var (var_name, var_qt, var_ptr) var_kind stmt_info = let make_decl_ref_exp_var (var_name, var_tp, var_ptr) var_kind stmt_info =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in let stmt_info = stmt_info_with_fresh_pointer stmt_info in
let decl_ref = make_decl_ref_qt var_kind var_ptr var_name false var_qt in let decl_ref = make_decl_ref_tp var_kind var_ptr var_name false var_tp in
let expr_info = make_expr_info var_qt in let expr_info = make_expr_info var_tp in
make_decl_ref_exp stmt_info expr_info (make_decl_ref_expr_info decl_ref) make_decl_ref_exp stmt_info expr_info (make_decl_ref_expr_info decl_ref)
let make_message_expr param_qt selector decl_ref_exp stmt_info add_cast = let make_message_expr param_tp 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_qt `LValueToRValue in let cast_expr = create_implicit_cast_expr stmt_info [decl_ref_exp] param_tp `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_qt `ObjCProperty in let expr_info = make_expr_info_with_objc_kind param_tp `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_compound_stmt stmts stmt_info = let make_compound_stmt stmts stmt_info =
@ -350,7 +350,7 @@ let make_next_object_exp stmt_info item items =
match item with match item with
| Clang_ast_t.DeclStmt (stmt_info, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) -> | Clang_ast_t.DeclStmt (stmt_info, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) ->
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_qt `Var decl_ptr name_info false var_type in let decl_ref = make_decl_ref_tp `Var decl_ptr name_info false var_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
@ -383,75 +383,75 @@ let translate_dispatch_function block_name stmt_info stmt_list ei n =
let open Clang_ast_t in let open Clang_ast_t in
match block_expr with match block_expr with
| BlockExpr (bsi, bsl, bei, bd) -> | BlockExpr (bsi, bsl, bei, bd) ->
let qt = bei.ei_qual_type in let tp = bei.ei_type_ptr in
let cast_info = { cei_cast_kind = `BitCast; cei_base_path =[]} in let cast_info = { cei_cast_kind = `BitCast; cei_base_path =[]} in
let block_def = ImplicitCastExpr(stmt_info,[block_expr], bei, cast_info) in let block_def = ImplicitCastExpr(stmt_info,[block_expr], bei, cast_info) in
let decl_info = { empty_decl_info let decl_info = { empty_decl_info
with di_pointer = stmt_info.si_pointer; di_source_range = stmt_info.si_source_range } in with di_pointer = stmt_info.si_pointer; di_source_range = stmt_info.si_source_range } in
let var_decl_info = { empty_var_decl with vdi_init_expr = Some block_def } in let var_decl_info = { empty_var_decl with vdi_init_expr = Some block_def } in
let block_var_decl = VarDecl(decl_info, block_name_info, ei.ei_qual_type, var_decl_info) in let block_var_decl = VarDecl(decl_info, block_name_info, ei.ei_type_ptr, var_decl_info) in
let decl_stmt = DeclStmt(stmt_info,[], [block_var_decl]) in let decl_stmt = DeclStmt(stmt_info,[], [block_var_decl]) in
let expr_info_call = make_general_expr_info create_void_star_type `XValue `Ordinary in let expr_info_call = make_general_expr_info create_void_star_type `XValue `Ordinary in
let expr_info_dre = make_expr_info_with_objc_kind qt `Ordinary in let expr_info_dre = make_expr_info_with_objc_kind tp `Ordinary in
let decl_ref = make_decl_ref_qt `Var stmt_info.si_pointer block_name_info false qt in let decl_ref = make_decl_ref_tp `Var stmt_info.si_pointer block_name_info false tp 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
let cast_info_call = { cei_cast_kind = `LValueToRValue; cei_base_path =[]} in let cast_info_call = { cei_cast_kind = `LValueToRValue; cei_base_path =[]} in
let decl_ref_exp = DeclRefExpr(stmt_info, [], expr_info_dre, decl_ref_expr_info) in let decl_ref_exp = DeclRefExpr(stmt_info, [], expr_info_dre, decl_ref_expr_info) in
let stmt_call = ImplicitCastExpr(stmt_info, [decl_ref_exp], bei, cast_info_call) in let stmt_call = ImplicitCastExpr(stmt_info, [decl_ref_exp], bei, cast_info_call) in
let call_block_var = CallExpr(stmt_info, [stmt_call], expr_info_call) in let call_block_var = CallExpr(stmt_info, [stmt_call], expr_info_call) in
CompoundStmt (stmt_info, [decl_stmt; call_block_var]), qt CompoundStmt (stmt_info, [decl_stmt; call_block_var]), tp
| _ -> assert false (* when we call this function we have already checked that this cannot be possible *) | _ -> assert false (* when we call this function we have already checked that this cannot be possible *)
(* Create declaration statement: qt vname = iexp *) (* Create declaration statement: tp vname = iexp *)
let make_DeclStmt stmt_info di qt vname iexp = let make_DeclStmt stmt_info di tp vname 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'] qt `IntegralCast in let ie = create_implicit_cast_expr stmt_info [iexp'] tp `IntegralCast in
Some ie, [ie] Some ie, [ie]
| None -> None, [] in | None -> None, [] in
let var_decl_info = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = init_expr_opt } in let var_decl_info = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = init_expr_opt } in
let var_decl = Clang_ast_t.VarDecl (di, vname, qt, var_decl_info) in let var_decl = Clang_ast_t.VarDecl (di, vname, tp, 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])
let build_OpaqueValueExpr si source_expr ei = 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_qt () = create_class_type CFrontend_config.pseudo_object_type let pseudo_object_tp () = create_class_type CFrontend_config.pseudo_object_type
(* Create expression PseudoObjectExpr for 'o.m' *) (* Create expression PseudoObjectExpr for 'o.m' *)
let build_PseudoObjectExpr qt_m o_cast_decl_ref_exp mname = let build_PseudoObjectExpr tp_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, stmt_list, ei, cast_expr_info) -> | Clang_ast_t.ImplicitCastExpr (si, stmt_list, ei, cast_expr_info) ->
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_qt ()) in let ei_opre = make_expr_info (pseudo_object_tp ()) in
let count_name = Ast_utils.make_name_decl CFrontend_config.count in let count_name = Ast_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_qt `ObjCProperty pointer count_name false); `PropertyRef (make_decl_ref_no_tp `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 qt_m mname o_cast_decl_ref_exp si false in let ome = make_message_expr tp_m mname o_cast_decl_ref_exp si false in
let poe_ei = make_general_expr_info qt_m `LValue `Ordinary in let poe_ei = make_general_expr_info tp_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 qt parameters = let create_call stmt_info decl_pointer function_name tp parameters =
let expr_info_call = { let expr_info_call = {
Clang_ast_t.ei_qual_type = create_void_star_type; Clang_ast_t.ei_type_ptr = 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 qt `Ordinary in let expr_info_dre = make_expr_info_with_objc_kind tp `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in let decl_ref = make_decl_ref_tp `Function decl_pointer function_name false tp 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] qt `FunctionToPointerDecay in let cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] tp `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 *)
@ -481,55 +481,55 @@ 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, qt, _) :: lp' -> | Clang_ast_t.ParmVarDecl (di, name, tp, _) :: lp' ->
(name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, qt):: get_name_pointers lp' (name.Clang_ast_t.ni_name, di.Clang_ast_t.di_pointer, tp):: get_name_pointers lp'
| _ -> assert false in | _ -> assert false in
let build_idx_decl pidx = let build_idx_decl pidx =
match pidx with match pidx with
| Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, _) -> | Clang_ast_t.ParmVarDecl (di_idx, name_idx, tp_idx, _) ->
let zero = create_integer_literal stmt_info "0" in let zero = create_integer_literal stmt_info "0" in
(* qt_idx idx = 0; *) (* tp_idx idx = 0; *)
let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx qt_idx name_idx (Some zero) in let idx_decl_stmt = make_DeclStmt (fresh_stmt_info stmt_info) di_idx tp_idx name_idx (Some zero) in
let idx_ei = make_expr_info qt_idx in let idx_ei = make_expr_info tp_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_qt `Var pointer name_idx false qt_idx in let idx_decl_ref = make_decl_ref_tp `Var pointer name_idx false tp_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] qt_idx `LValueToRValue in let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp] tp_idx `LValueToRValue in
idx_decl_stmt, idx_decl_ref_exp, idx_cast, qt_idx idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_idx
| _ -> assert false in | _ -> assert false in
let cast_expr decl_ref qt = let cast_expr decl_ref tp =
let ei = make_expr_info qt in let ei = make_expr_info tp 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] qt `LValueToRValue in create_implicit_cast_expr (fresh_stmt_info stmt_info) [decl_ref_exp] tp `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, _) -> | Clang_ast_t.ParmVarDecl (di, name, tp, _) ->
let qt_fun = create_void_unsigned_long_type in let tp_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_expr_info create_unsigned_long_type, make_expr_info create_unsigned_long_type,
{ Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_qual_type = type_opt}) in { Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_type_ptr = 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 = Ast_utils.make_name_decl CFrontend_config.malloc in let malloc_name = Ast_utils.make_name_decl CFrontend_config.malloc in
let malloc = create_call stmt_info pointer malloc_name qt_fun [parameter] in let malloc = create_call stmt_info pointer malloc_name tp_fun [parameter] 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 (Some init_exp) make_DeclStmt (fresh_stmt_info stmt_info) di tp name (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, tp, _) ->
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
@ -540,28 +540,28 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* build statement free(stop); *) (* build statement free(stop); *)
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, tp, _) ->
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 = Ast_utils.make_name_decl CFrontend_config.free in let free_name = Ast_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 qt_fun [parameter] create_call (fresh_stmt_info stmt_info) pointer free_name tp_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_decl_stmt, idx_decl_ref_exp, idx_cast, idx_qt = build_idx_decl pidx in let idx_decl_stmt, idx_decl_ref_exp, idx_cast, idx_tp = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in let rhs = build_PseudoObjectExpr idx_tp 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 qt_idx = let un_op idx_decl_ref_expr tp_idx =
let idx_ei = make_expr_info qt_idx in let idx_ei = make_expr_info tp_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
@ -571,48 +571,48 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
| _ -> assert false in | _ -> assert false in
(* id object= objects[idx]; *) (* id object= objects[idx]; *)
let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx qt_idx = let build_object_DeclStmt pobj decl_ref_expr_array decl_ref_expr_idx tp_idx =
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, tp_obj, _) ->
let poe_ei = make_general_expr_info qt_obj `LValue `Ordinary in let poe_ei = make_general_expr_info tp_obj `LValue `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_qt ()), make_expr_info (pseudo_object_tp ()),
{ 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
let pseudo_obj_expr = PseudoObjectExpr (fresh_stmt_info stmt_info, [objc_sre; ove_array; ove_idx; ome], poe_ei) in let pseudo_obj_expr = PseudoObjectExpr (fresh_stmt_info stmt_info, [objc_sre; ove_array; ove_idx; ome], poe_ei) in
let vdi = { empty_var_decl_info with vdi_init_expr = Some (pseudo_obj_expr) } in let vdi = { empty_var_decl_info with vdi_init_expr = Some (pseudo_obj_expr) } in
let var_decl = VarDecl (di_obj, name_obj, qt_obj, vdi) in let var_decl = VarDecl (di_obj, name_obj, tp_obj, vdi) in
DeclStmt (fresh_stmt_info stmt_info, [pseudo_obj_expr], [var_decl]) DeclStmt (fresh_stmt_info stmt_info, [pseudo_obj_expr], [var_decl])
| _ -> assert false in | _ -> assert false in
(* 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 = Ast_utils.get_fresh_pointer () } in let di = { empty_decl_info with Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer () } in
let qt = create_pointer_type (create_class_type CFrontend_config.nsarray_cl) in let tp = create_pointer_type (create_class_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 = Ast_utils.make_name_decl CFrontend_config.objects in let objects_name = Ast_utils.make_name_decl CFrontend_config.objects in
let var_decl = Clang_ast_t.VarDecl (di, objects_name, qt, vdi) in let var_decl = Clang_ast_t.VarDecl (di, objects_name, tp, vdi) in
Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, qt)] in Clang_ast_t.DeclStmt (fresh_stmt_info stmt_info, [init], [var_decl]), [(CFrontend_config.objects, di.Clang_ast_t.di_pointer, tp)] 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 (di, name, qt, vdi)]) -> | Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (di, name, tp, vdi)]) ->
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, tp, _) ->
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 = Ast_utils.make_name_decl block_name in let qual_block_name = Ast_utils.make_name_decl block_name in
@ -622,40 +622,40 @@ 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 Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer () } in let di = { empty_decl_info with Clang_ast_t.di_pointer = Ast_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 = bei.Clang_ast_t.ei_qual_type in let tp = bei.Clang_ast_t.ei_type_ptr 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, tp, vdi) in
Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, bei.Clang_ast_t.ei_qual_type)] Clang_ast_t.DeclStmt (bsi, [be], [var_decl]), [(block_name, di.Clang_ast_t.di_pointer, bei.Clang_ast_t.ei_type_ptr)]
| _ -> assert false in | _ -> assert false in
let make_block_call block_qt object_cast idx_cast stop_cast = let make_block_call block_tp object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_qt in let decl_ref = make_decl_ref_invalid `Var qual_block_name false block_tp in
let fun_cast = cast_expr decl_ref block_qt in let fun_cast = cast_expr decl_ref block_tp 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_qt = create_BOOL_type in let bool_tp = create_BOOL_type in
let ei = make_expr_info bool_qt in let ei = make_expr_info bool_tp 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_qt `LValueToRValue in let cond = create_implicit_cast_expr (fresh_stmt_info stmt_info) [unary_op] bool_tp `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 (fresh_stmt_info stmt_info, [dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in Clang_ast_t.IfStmt (fresh_stmt_info stmt_info, [dummy_stmt (); cond; break_stmt; dummy_stmt ()]) in
let translate params array_cast_decl_ref_exp block_decl block_qt = let translate params array_cast_decl_ref_exp block_decl block_tp =
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, qt_idx = build_idx_decl pidx in let idx_decl_stmt, idx_decl_ref_exp, idx_cast, tp_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 qt_idx in let incr = un_op idx_decl_ref_exp tp_idx in
let obj_assignment = build_object_DeclStmt pobj objects idx_cast qt_idx in let obj_assignment = build_object_DeclStmt pobj objects idx_cast tp_idx 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_qt object_cast idx_cast stop_cast in let call_block = make_block_call block_tp 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;
@ -667,7 +667,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_qual_type in let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_type_ptr 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 *)
Printing.log_out "WARNING: Block Enumeration called at %s not translated." (Clang_ast_j.string_of_stmt_info stmt_info); Printing.log_out "WARNING: Block Enumeration called at %s not translated." (Clang_ast_j.string_of_stmt_info stmt_info);
@ -679,14 +679,14 @@ let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal stmt_info "0"] @ [create_integer_literal stmt_info "1"] in let stmt_list_cond = stmt_list @ [create_integer_literal stmt_info "0"] @ [create_integer_literal stmt_info "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_call stmt_info decl_pointer function_name qt parameters = let create_call stmt_info decl_pointer function_name tp parameters =
let expr_info_call = { let expr_info_call = {
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_type_ptr = tp;
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 qt `Ordinary in let expr_info_dre = make_expr_info_with_objc_kind tp `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in let decl_ref = make_decl_ref_tp `Function decl_pointer function_name false tp 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
Clang_ast_t.CallExpr (stmt_info, decl_ref_exp:: parameters, expr_info_call) Clang_ast_t.CallExpr (stmt_info, decl_ref_exp:: parameters, expr_info_call)
@ -695,13 +695,13 @@ 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 stmt_info = stmt_info_with_fresh_pointer (make_stmt_info decl_info) in
let boi = { Clang_ast_t.boi_kind = `NE } in let boi = { Clang_ast_t.boi_kind = `NE } in
let decl_ptr = Ast_utils.get_invalid_pointer () in let decl_ptr = Ast_utils.get_invalid_pointer () in
let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type 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 stmt_info_var = dummy_stmt_info () 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 var_decl_ref = Clang_ast_t.DeclRefExpr (stmt_info_var, [], (make_expr_info var_type), decl_ref_info) 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 = Ast_utils.get_invalid_pointer () in let var_decl_ptr = Ast_utils.get_invalid_pointer () in
let expr_info = { let expr_info = {
Clang_ast_t.ei_qual_type = var_type; Clang_ast_t.ei_type_ptr = var_type;
ei_value_kind = `RValue; ei_value_kind = `RValue;
ei_object_kind = `Ordinary ei_object_kind = `Ordinary
} in } in

@ -21,66 +21,66 @@ val dummy_source_range : unit -> source_range
val dummy_stmt_info : unit -> stmt_info val dummy_stmt_info : unit -> stmt_info
val create_char_star_type : qual_type val create_char_star_type : type_ptr
val create_id_type : qual_type val create_id_type : type_ptr
val create_nsarray_star_type : qual_type val create_nsarray_star_type : type_ptr
val create_void_type : qual_type val create_void_type : type_ptr
val create_int_type : qual_type val create_int_type : type_ptr
val create_void_star_type : qual_type val create_void_star_type : type_ptr
val create_BOOL_type : qual_type val create_BOOL_type : type_ptr
val create_unsigned_long_type : qual_type val create_unsigned_long_type : type_ptr
val create_void_unsigned_long_type : qual_type val create_void_unsigned_long_type : type_ptr
val create_void_void_type : qual_type val create_void_void_type : type_ptr
val create_class_type : string -> qual_type val create_class_type : string -> type_ptr
val create_struct_type : string -> qual_type val create_struct_type : string -> type_ptr
val create_pointer_type : qual_type -> qual_type val create_pointer_type : type_ptr -> type_ptr
val create_qual_type_with_just_pointer : Clang_ast_t.pointer -> qual_type val create_type_ptr_with_just_pointer : Clang_ast_t.pointer -> type_ptr
val make_objc_ivar_decl : decl_info -> qual_type -> obj_c_property_impl_decl_info -> val make_objc_ivar_decl : decl_info -> type_ptr -> obj_c_property_impl_decl_info ->
named_decl_info -> decl named_decl_info -> decl
val make_deref_self_field : string -> decl_info -> qual_type -> named_decl_info -> stmt val make_deref_self_field : string -> decl_info -> type_ptr -> named_decl_info -> stmt
val make_stmt_info : decl_info -> stmt_info val make_stmt_info : decl_info -> stmt_info
val make_method_decl_info : obj_c_method_decl_info -> stmt -> obj_c_method_decl_info val make_method_decl_info : obj_c_method_decl_info -> stmt -> obj_c_method_decl_info
val make_decl_ref_qt : decl_kind -> pointer -> named_decl_info -> bool -> qual_type -> decl_ref 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 : qual_type -> value_kind -> object_kind -> expr_info val make_general_expr_info : type_ptr -> value_kind -> object_kind -> expr_info
val make_expr_info : qual_type -> expr_info val make_expr_info : type_ptr -> expr_info
val make_cast_expr : qual_type -> decl_info -> decl_ref_expr_info -> object_kind -> stmt val make_cast_expr : type_ptr -> decl_info -> decl_ref_expr_info -> object_kind -> stmt
val make_self_field : string -> decl_info -> qual_type -> named_decl_info -> stmt val make_self_field : string -> decl_info -> type_ptr -> named_decl_info -> stmt
val make_next_object_exp : stmt_info -> stmt -> Clang_ast_t.stmt -> Clang_ast_t.stmt val make_next_object_exp : stmt_info -> 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 -> qual_type -> cast_kind -> stmt val create_implicit_cast_expr : stmt_info -> stmt list -> type_ptr -> cast_kind -> stmt
val make_message_expr : qual_type -> string -> stmt -> stmt_info -> bool -> stmt val make_message_expr : type_ptr -> string -> stmt -> stmt_info -> bool -> stmt
val make_compound_stmt : stmt list -> stmt_info -> stmt val make_compound_stmt : stmt list -> stmt_info -> stmt
val make_decl_ref_exp_var : named_decl_info * qual_type * pointer -> decl_kind -> stmt_info -> stmt val make_decl_ref_exp_var : named_decl_info * type_ptr * pointer -> decl_kind -> stmt_info -> 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
@ -88,12 +88,12 @@ val make_obj_c_message_expr_info_class : string -> string -> obj_c_message_expr_
val make_obj_c_message_expr_info_instance : string -> obj_c_message_expr_info val make_obj_c_message_expr_info_instance : string -> obj_c_message_expr_info
val translate_dispatch_function : string -> stmt_info -> stmt list -> expr_info -> int -> stmt * qual_type val translate_dispatch_function : string -> stmt_info -> stmt list -> expr_info -> int -> stmt * type_ptr
val translate_block_enumerate : string -> stmt_info -> stmt list -> expr_info -> stmt * (string * string* qual_type) list val translate_block_enumerate : string -> stmt_info -> stmt list -> expr_info -> stmt * (string * string* type_ptr) list
(* 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 -> qual_type -> stmt val create_assume_not_null_call : decl_info -> named_decl_info -> type_ptr -> stmt

@ -104,7 +104,7 @@ let pp_ast_decl fmt ast_decl =
let prefix1 = prefix ^ " " in let prefix1 = prefix ^ " " in
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| FunctionDecl (decl_info, name, qt, fdecl_info) -> | FunctionDecl (decl_info, name, tp, fdecl_info) ->
F.fprintf fmt "%sFunctionDecl %s %a@\n" F.fprintf fmt "%sFunctionDecl %s %a@\n"
prefix prefix
name.Clang_ast_t.ni_name name.Clang_ast_t.ni_name
@ -118,7 +118,7 @@ let pp_ast_decl fmt ast_decl =
name.Clang_ast_t.ni_name name.Clang_ast_t.ni_name
pp_source_range decl_info.di_source_range; pp_source_range decl_info.di_source_range;
Option.may (dump_stmt prefix1) obj_c_method_decl_info.omdi_body Option.may (dump_stmt prefix1) obj_c_method_decl_info.omdi_body
| VarDecl (decl_info, name, qual_type, var_decl_info) -> | VarDecl (decl_info, name, type_ptr, var_decl_info) ->
F.fprintf fmt "%sVarDecl %a@\n" F.fprintf fmt "%sVarDecl %a@\n"
prefix prefix
pp_source_range decl_info.di_source_range; pp_source_range decl_info.di_source_range;
@ -251,7 +251,7 @@ and decl_process_locs loc_composer decl =
let decl_list' = list_map (decl_process_locs loc_composer) decl_list in let decl_list' = list_map (decl_process_locs loc_composer) decl_list in
decl_set_sub_decls decl1 decl_list' in decl_set_sub_decls decl1 decl_list' in
let open Clang_ast_t in let open Clang_ast_t in
let get_updated_fun_decl (decl_info', name, qt, fdecl_info) = let get_updated_fun_decl (decl_info', name, tp, fdecl_info) =
let fdi_decls_in_prototype_scope' = let fdi_decls_in_prototype_scope' =
list_map (decl_process_locs loc_composer) fdecl_info.fdi_decls_in_prototype_scope in list_map (decl_process_locs loc_composer) fdecl_info.fdi_decls_in_prototype_scope in
let fdi_parameters' = let fdi_parameters' =
@ -262,7 +262,7 @@ and decl_process_locs loc_composer decl =
fdi_body = body'; fdi_body = body';
fdi_parameters = fdi_parameters'; fdi_parameters = fdi_parameters';
fdi_decls_in_prototype_scope = fdi_decls_in_prototype_scope'; } in fdi_decls_in_prototype_scope = fdi_decls_in_prototype_scope'; } in
(decl_info', name, qt, fdecl_info') in (decl_info', name, tp, fdecl_info') in
match decl' with match decl' with
| FunctionDecl fun_info -> FunctionDecl (get_updated_fun_decl fun_info) | FunctionDecl fun_info -> FunctionDecl (get_updated_fun_decl fun_info)
| CXXMethodDecl fun_info -> CXXMethodDecl (get_updated_fun_decl fun_info) | CXXMethodDecl fun_info -> CXXMethodDecl (get_updated_fun_decl fun_info)
@ -271,12 +271,12 @@ and decl_process_locs loc_composer decl =
Option.map (stmt_process_locs loc_composer) obj_c_method_decl_info.omdi_body in Option.map (stmt_process_locs loc_composer) obj_c_method_decl_info.omdi_body in
let obj_c_method_decl_info' = { obj_c_method_decl_info with omdi_body = body' } in let obj_c_method_decl_info' = { obj_c_method_decl_info with omdi_body = body' } in
ObjCMethodDecl (decl_info', name, obj_c_method_decl_info') ObjCMethodDecl (decl_info', name, obj_c_method_decl_info')
| VarDecl (decl_info, string, qual_type, var_decl_info) -> | VarDecl (decl_info, string, type_ptr, var_decl_info) ->
let vdi_init_expr' = let vdi_init_expr' =
Option.map (stmt_process_locs loc_composer) var_decl_info.vdi_init_expr in Option.map (stmt_process_locs loc_composer) var_decl_info.vdi_init_expr in
let var_decl_info' = let var_decl_info' =
{ var_decl_info with vdi_init_expr = vdi_init_expr' } in { var_decl_info with vdi_init_expr = vdi_init_expr' } in
VarDecl (decl_info, string, qual_type, var_decl_info') VarDecl (decl_info, string, type_ptr, var_decl_info')
| _ -> | _ ->
decl' decl'

@ -29,7 +29,7 @@ let global_procdesc = ref (create_empty_procdesc ())
let rec get_enum_constants context decl_list v = let rec get_enum_constants context decl_list v =
match decl_list with match decl_list with
| [] -> [] | [] -> []
| Clang_ast_t.EnumConstantDecl (decl_info, name_info, qual_type, enum_constant_decl_info) :: decl_list' -> | Clang_ast_t.EnumConstantDecl (decl_info, name_info, type_ptr, enum_constant_decl_info) :: decl_list' ->
let name = name_info.Clang_ast_t.ni_name in let name = name_info.Clang_ast_t.ni_name in
(match enum_constant_decl_info.Clang_ast_t.ecdi_init_expr with (match enum_constant_decl_info.Clang_ast_t.ecdi_init_expr with
| None -> Printing.log_out "%s" (" ...Defining Enum Constant ("^name^", "^(string_of_int v)); | None -> Printing.log_out "%s" (" ...Defining Enum Constant ("^name^", "^(string_of_int v));

@ -47,14 +47,14 @@ let get_field_www name_field fl =
"WARNING: In MemberExpr there must be only one type defininf for the struct. Returning (NO_FIELD_NAME, Tvoid)\n" "WARNING: In MemberExpr there must be only one type defininf for the struct. Returning (NO_FIELD_NAME, Tvoid)\n"
(Ident.create_fieldname (Mangled.from_string "NO_FIELD_NAME") 0, Sil.Tvoid) (Ident.create_fieldname (Mangled.from_string "NO_FIELD_NAME") 0, Sil.Tvoid)
let build_sil_field tenv field_name qual_type prop_atts = let build_sil_field tenv field_name type_ptr prop_atts =
let annotation_from_type t = let annotation_from_type t =
match t with match t with
| Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak] | Sil.Tptr (_, Sil.Pk_objc_weak) -> [Config.weak]
| Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret] | Sil.Tptr (_, Sil.Pk_objc_unsafe_unretained) -> [Config.unsafe_unret]
| _ -> [] in | _ -> [] in
let fname = General_utils.mk_class_field_name field_name in let fname = General_utils.mk_class_field_name field_name in
let typ = CTypes_decl.qual_type_to_sil_type tenv qual_type in let typ = CTypes_decl.type_ptr_to_sil_type tenv type_ptr in
let item_annotations = match prop_atts with let item_annotations = match prop_atts with
| [] -> | [] ->
[({ Sil.class_name = Config.ivar_attributes; Sil.parameters = annotation_from_type typ }, true)] [({ Sil.class_name = Config.ivar_attributes; Sil.parameters = annotation_from_type typ }, true)]
@ -78,25 +78,25 @@ let ivar_property curr_class ivar =
| None -> Printing.log_out "No property found for ivar '%s'@." ivar.Clang_ast_t.ni_name; | None -> Printing.log_out "No property found for ivar '%s'@." ivar.Clang_ast_t.ni_name;
[] []
let build_sil_field_property curr_class tenv field_name qual_type prop_attributes_opt = let build_sil_field_property curr_class tenv field_name type_ptr prop_attributes_opt =
let prop_attributes = let prop_attributes =
match prop_attributes_opt with match prop_attributes_opt with
| Some prop_attributes -> prop_attributes | Some prop_attributes -> prop_attributes
| None -> ivar_property curr_class field_name in | None -> ivar_property curr_class field_name in
let atts_str = list_map Clang_ast_j.string_of_property_attribute prop_attributes in let atts_str = list_map Clang_ast_j.string_of_property_attribute prop_attributes in
build_sil_field tenv field_name qual_type atts_str build_sil_field tenv field_name type_ptr atts_str
(* Given a list of declarations in an interface returns a list of fields *) (* Given a list of declarations in an interface returns a list of fields *)
let rec get_fields tenv curr_class decl_list = let rec get_fields tenv curr_class decl_list =
let open Clang_ast_t in let open Clang_ast_t in
match decl_list with match decl_list with
| [] -> [] | [] -> []
| ObjCIvarDecl (decl_info, name_info, qual_type, field_decl_info, obj_c_ivar_decl_info) :: decl_list' -> | ObjCIvarDecl (decl_info, name_info, type_ptr, field_decl_info, obj_c_ivar_decl_info) :: decl_list' ->
let fields = get_fields tenv curr_class decl_list' in let fields = get_fields tenv curr_class decl_list' in
(* Doing a post visit here. Adding Ivar after all the declaration have been visited so that *) (* Doing a post visit here. Adding Ivar after all the declaration have been visited so that *)
(* ivar names will be added in the property list. *) (* ivar names will be added in the property list. *)
Printing.log_out " ...Adding Instance Variable '%s' @." name_info.Clang_ast_t.ni_name; Printing.log_out " ...Adding Instance Variable '%s' @." name_info.Clang_ast_t.ni_name;
let (fname, typ, ia) = build_sil_field_property curr_class tenv name_info qual_type None in let (fname, typ, ia) = build_sil_field_property curr_class tenv name_info type_ptr None in
Printing.log_out " ...Resulting sil field: (%s) with attributes:@." ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ)); Printing.log_out " ...Resulting sil field: (%s) with attributes:@." ((Ident.fieldname_to_string fname) ^":"^(Sil.typ_to_string typ));
list_iter (fun (ia', _) -> list_iter (fun (ia', _) ->
list_iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) ia; list_iter (fun a -> Printing.log_out " '%s'@." a) ia'.Sil.parameters) ia;

@ -20,6 +20,6 @@ val get_fields : Sil.tenv -> CContext.curr_class -> Clang_ast_t.decl list -> fie
val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info -> field_type list val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info -> field_type list
val build_sil_field_property : CContext.curr_class -> Sil.tenv -> Clang_ast_t.named_decl_info -> val build_sil_field_property : CContext.curr_class -> Sil.tenv -> Clang_ast_t.named_decl_info ->
Clang_ast_t.qual_type -> Clang_ast_t.property_attribute list option -> field_type Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list option -> field_type
val add_missing_fields : Sil.tenv -> string -> field_type list -> unit val add_missing_fields : Sil.tenv -> string -> field_type list -> unit

@ -31,7 +31,7 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
let should_translate_enum = CLocation.should_translate_enum source_range in let should_translate_enum = CLocation.should_translate_enum source_range in
let open Clang_ast_t in let open Clang_ast_t in
match dec with match dec with
| FunctionDecl(di, name_info, qt, fdecl_info) -> | FunctionDecl(di, name_info, tp, fdecl_info) ->
CMethod_declImpl.function_decl tenv cfg cg namespace dec None CMethod_declImpl.function_decl tenv cfg cg namespace dec None
| TypedefDecl (decl_info, name_info, opt_type, _, typedef_decl_info) -> | TypedefDecl (decl_info, name_info, opt_type, _, typedef_decl_info) ->
Printing.log_out "%s" "Skipping typedef declaration. Will expand the type in its occurrences." Printing.log_out "%s" "Skipping typedef declaration. Will expand the type in its occurrences."
@ -76,7 +76,7 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
let curr_class = let curr_class =
ObjcInterface_decl.interface_impl_declaration tenv name decl_list idi in ObjcInterface_decl.interface_impl_declaration tenv name decl_list idi in
CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list CMethod_declImpl.process_methods tenv cg cfg curr_class namespace decl_list
| CXXMethodDecl(decl_info, name_info, qual_type, function_decl_info) -> | CXXMethodDecl(decl_info, name_info, type_ptr, function_decl_info) ->
(* di_parent_pointer has pointer to lexical context such as class.*) (* di_parent_pointer has pointer to lexical context such as class.*)
(* If it's not defined, then it's the same as parent in AST *) (* If it's not defined, then it's the same as parent in AST *)
let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with let class_decl = match decl_info.Clang_ast_t.di_parent_pointer with

@ -267,8 +267,8 @@ struct
CFrontend_config.pointer_prefix^("INVALID") CFrontend_config.pointer_prefix^("INVALID")
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_qual_type with match info.Clang_ast_t.uttei_type_ptr with
| Some qt -> Some qt | Some tp -> Some tp
| None -> None | None -> None
let is_generated name_info = let is_generated name_info =
@ -312,14 +312,14 @@ struct
| _ -> assert false | _ -> assert false
(*TODO take the attributes into account too. To be done after we get the attribute's arguments. *) (*TODO take the attributes into account too. To be done after we get the attribute's arguments. *)
let is_type_nonnull qt attributes = let is_type_nonnull type_ptr attributes =
let open Clang_ast_t in let open Clang_ast_t in
match get_type qt with match get_type type_ptr with
| Some AttributedType (_, attr_info) -> attr_info.ati_attr_kind = `Nonnull | Some AttributedType (_, attr_info) -> attr_info.ati_attr_kind = `Nonnull
| _ -> false | _ -> false
let string_of_qual_type qt = let string_of_type_ptr type_ptr =
match get_desugared_type qt with match get_desugared_type type_ptr with
| Some typ -> (Clang_ast_proj.get_type_tuple typ).Clang_ast_t.ti_raw | Some typ -> (Clang_ast_proj.get_type_tuple typ).Clang_ast_t.ti_raw
| None -> "" | None -> ""
@ -446,7 +446,7 @@ struct
let prefix = Ast_utils.get_qualifier_string field_qual_name in let prefix = Ast_utils.get_qualifier_string field_qual_name in
Ident.create_fieldname (Mangled.mangled field_name prefix) 0 Ident.create_fieldname (Mangled.mangled field_name prefix) 0
let mk_procname_from_function name function_decl_info_opt qt = let mk_procname_from_function name function_decl_info_opt tp =
let file = let file =
match function_decl_info_opt with match function_decl_info_opt with
| Some (decl_info, function_decl_info) -> | Some (decl_info, function_decl_info) ->
@ -460,7 +460,7 @@ struct
let type_string = let type_string =
match !CFrontend_config.language with match !CFrontend_config.language with
| CFrontend_config.CPP | CFrontend_config.CPP
| CFrontend_config.OBJCPP -> Ast_utils.string_of_qual_type qt | CFrontend_config.OBJCPP -> Ast_utils.string_of_type_ptr tp
| _ -> "" in | _ -> "" in
let mangled = file ^ type_string in let mangled = file ^ type_string in
if String.length mangled == 0 then if String.length mangled == 0 then
@ -473,8 +473,8 @@ struct
let mangled = Procname.mangled_of_objc_method_kind method_kind in let mangled = Procname.mangled_of_objc_method_kind method_kind in
Procname.mangled_c_method class_name method_name mangled Procname.mangled_c_method class_name method_name mangled
let mk_procname_from_cpp_method class_name method_name qt = let mk_procname_from_cpp_method class_name method_name tp =
let type_name = Ast_utils.string_of_qual_type qt in let type_name = Ast_utils.string_of_type_ptr tp in
let type_name_crc = Some (CRC.crc16 type_name) in let type_name_crc = Some (CRC.crc16 type_name) in
Procname.mangled_c_method class_name method_name type_name_crc Procname.mangled_c_method class_name method_name type_name_crc

@ -66,14 +66,14 @@ sig
val is_copy : Clang_ast_t.property_attribute option -> bool val is_copy : Clang_ast_t.property_attribute option -> bool
val is_type_nonnull : Clang_ast_t.qual_type -> Clang_ast_t.attribute list -> bool val is_type_nonnull : Clang_ast_t.type_ptr -> Clang_ast_t.attribute list -> bool
val get_fresh_pointer : unit -> string val get_fresh_pointer : unit -> string
val get_invalid_pointer : unit -> string val get_invalid_pointer : unit -> string
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.qual_type option Clang_ast_t.unary_expr_or_type_trait_expr_info -> Clang_ast_t.type_ptr option
val is_generated : Clang_ast_t.named_decl_info -> bool val is_generated : Clang_ast_t.named_decl_info -> bool
@ -92,7 +92,7 @@ sig
NOTE: this function needs extending to handle objC types *) NOTE: this function needs extending to handle objC types *)
val get_decl_from_typ_ptr : Clang_ast_t.type_ptr -> Clang_ast_t.decl val get_decl_from_typ_ptr : Clang_ast_t.type_ptr -> Clang_ast_t.decl
val string_of_qual_type : Clang_ast_t.qual_type -> string val string_of_type_ptr : Clang_ast_t.type_ptr -> string
val make_name_decl : string -> Clang_ast_t.named_decl_info val make_name_decl : string -> Clang_ast_t.named_decl_info
@ -141,9 +141,9 @@ sig
val mk_procname_from_objc_method : string -> string -> Procname.objc_method_kind -> Procname.t val mk_procname_from_objc_method : string -> string -> Procname.objc_method_kind -> Procname.t
val mk_procname_from_function : string -> (Clang_ast_t.decl_info * Clang_ast_t.function_decl_info) val mk_procname_from_function : string -> (Clang_ast_t.decl_info * Clang_ast_t.function_decl_info)
option -> Clang_ast_t.qual_type -> Procname.t option -> Clang_ast_t.type_ptr -> Procname.t
val mk_procname_from_cpp_method : string -> string -> Clang_ast_t.qual_type -> Procname.t val mk_procname_from_cpp_method : string -> string -> Clang_ast_t.type_ptr -> Procname.t
val mk_class_field_name : Clang_ast_t.named_decl_info -> Ident.fieldname val mk_class_field_name : Clang_ast_t.named_decl_info -> Ident.fieldname

@ -43,9 +43,9 @@ struct
| decl:: rest -> | decl:: rest ->
let rest_assume_calls = add_assume_not_null_calls rest attributes in let rest_assume_calls = add_assume_not_null_calls rest attributes in
(match decl with (match decl with
| Clang_ast_t.ParmVarDecl (decl_info, name, qtype, var_decl_info) | Clang_ast_t.ParmVarDecl (decl_info, name, tp, var_decl_info)
when CFrontend_utils.Ast_utils.is_type_nonnull qtype attributes -> when CFrontend_utils.Ast_utils.is_type_nonnull tp attributes ->
let assume_call = Ast_expressions.create_assume_not_null_call decl_info name qtype in let assume_call = Ast_expressions.create_assume_not_null_call decl_info name tp in
assume_call:: rest_assume_calls assume_call:: rest_assume_calls
| _ -> rest_assume_calls) | _ -> rest_assume_calls)
@ -158,9 +158,9 @@ struct
match ObjcProperty_decl.method_is_property_accesor cls method_name with match ObjcProperty_decl.method_is_property_accesor cls method_name with
| Some (property_name, property_type, is_getter) when | Some (property_name, property_type, is_getter) when
CMethod_trans.should_create_procdesc context.cfg procname true true -> CMethod_trans.should_create_procdesc context.cfg procname true true ->
(match property_type with qt, atts, decl_info, _, _, ivar_opt -> (match property_type with tp, atts, decl_info, _, _, ivar_opt ->
let ivar_name = ObjcProperty_decl.get_ivar_name property_name ivar_opt in let ivar_name = ObjcProperty_decl.get_ivar_name property_name ivar_opt in
let field = CField_decl.build_sil_field_property cls context.tenv ivar_name qt (Some atts) in let field = CField_decl.build_sil_field_property cls context.tenv ivar_name tp (Some atts) in
ignore (CField_decl.add_missing_fields context.tenv class_name [field]); ignore (CField_decl.add_missing_fields context.tenv class_name [field]);
let accessor = let accessor =
if is_getter then if is_getter then

@ -12,8 +12,8 @@
type method_signature = { type method_signature = {
_name : Procname.t; _name : Procname.t;
_args : (string * Clang_ast_t.qual_type * Clang_ast_t.stmt option) list; _args : (string * Clang_ast_t.type_ptr * Clang_ast_t.stmt option) list;
_ret_type : Clang_ast_t.qual_type; _ret_type : Clang_ast_t.type_ptr;
_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;
@ -59,7 +59,7 @@ let ms_to_string ms =
let gen = if ms._is_generated then " (generated)" else "" in let gen = if ms._is_generated then " (generated)" else "" in
"Method " ^ (Procname.to_string ms._name) ^ gen ^ " " ^ "Method " ^ (Procname.to_string ms._name) ^ gen ^ " " ^
Utils.list_to_string Utils.list_to_string
(fun (s1, s2, _) -> s1 ^ ", " ^ (Clang_ast_j.string_of_qual_type s2)) (fun (s1, s2, _) -> s1 ^ ", " ^ (Clang_ast_j.string_of_type_ptr s2))
ms._args ms._args
^ "->" ^ (Clang_ast_j.string_of_qual_type ms._ret_type) ^ " " ^ ^ "->" ^ (Clang_ast_j.string_of_type_ptr ms._ret_type) ^ " " ^
Clang_ast_j.string_of_source_range ms._loc Clang_ast_j.string_of_source_range ms._loc

@ -15,9 +15,9 @@ type method_signature
val ms_get_name : method_signature -> Procname.t val ms_get_name : method_signature -> Procname.t
val ms_get_args : method_signature -> val ms_get_args : method_signature ->
(string * Clang_ast_t.qual_type * Clang_ast_t.stmt option) list (string * Clang_ast_t.type_ptr * Clang_ast_t.stmt option) list
val ms_get_ret_type : method_signature -> Clang_ast_t.qual_type val ms_get_ret_type : method_signature -> Clang_ast_t.type_ptr
val ms_get_attributes : method_signature -> Clang_ast_t.attribute list val ms_get_attributes : method_signature -> Clang_ast_t.attribute list
@ -25,8 +25,8 @@ val ms_get_loc : method_signature -> Clang_ast_t.source_range
val ms_is_instance : method_signature -> bool val ms_is_instance : method_signature -> bool
val make_ms : Procname.t -> (string * Clang_ast_t.qual_type * Clang_ast_t.stmt option) list -> val make_ms : Procname.t -> (string * Clang_ast_t.type_ptr * Clang_ast_t.stmt option) list ->
Clang_ast_t.qual_type -> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> bool -> Clang_ast_t.type_ptr -> Clang_ast_t.attribute list -> Clang_ast_t.source_range -> bool -> bool ->
method_signature method_signature
val replace_name_ms : method_signature -> Procname.t -> method_signature val replace_name_ms : method_signature -> Procname.t -> method_signature

@ -28,10 +28,10 @@ type method_call_type =
| MCStatic | MCStatic
type function_method_decl_info = type function_method_decl_info =
| Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.qual_type | Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.type_ptr
| Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * string * Clang_ast_t.qual_type | Cpp_Meth_decl_info of Clang_ast_t.function_decl_info * string * Clang_ast_t.type_ptr
| ObjC_Meth_decl_info of Clang_ast_t.obj_c_method_decl_info * string | ObjC_Meth_decl_info of Clang_ast_t.obj_c_method_decl_info * string
| Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.qual_type | Block_decl_info of Clang_ast_t.block_decl_info * Clang_ast_t.type_ptr
let is_instance_method function_method_decl_info is_instance = let is_instance_method function_method_decl_info is_instance =
match function_method_decl_info with match function_method_decl_info with
@ -63,9 +63,9 @@ let get_param_decls function_method_decl_info =
let get_parameters function_method_decl_info = let get_parameters function_method_decl_info =
let par_to_ms_par par = let par_to_ms_par par =
match par with match par with
| Clang_ast_t.ParmVarDecl (decl_info, name_info, qtype, var_decl_info) -> | Clang_ast_t.ParmVarDecl (decl_info, name_info, type_ptr, var_decl_info) ->
let name = name_info.Clang_ast_t.ni_name in let name = name_info.Clang_ast_t.ni_name in
(name, qtype, var_decl_info.Clang_ast_t.vdi_init_expr) (name, type_ptr, var_decl_info.Clang_ast_t.vdi_init_expr)
| _ -> assert false in | _ -> assert false in
let pars = list_map par_to_ms_par (get_param_decls function_method_decl_info) in let pars = list_map par_to_ms_par (get_param_decls function_method_decl_info) in
@ -76,31 +76,31 @@ let get_return_type function_method_decl_info =
| Func_decl_info (_, typ) | Func_decl_info (_, typ)
| Cpp_Meth_decl_info (_, _, typ) | Cpp_Meth_decl_info (_, _, typ)
| Block_decl_info (_, typ) -> | Block_decl_info (_, typ) ->
Ast_expressions.create_qual_type_with_just_pointer (CTypes.return_type_of_function_type typ) Ast_expressions.create_type_ptr_with_just_pointer (CTypes.return_type_of_function_type typ)
| ObjC_Meth_decl_info (method_decl_info, _) -> method_decl_info.Clang_ast_t.omdi_result_type | ObjC_Meth_decl_info (method_decl_info, _) -> method_decl_info.Clang_ast_t.omdi_result_type
let build_method_signature decl_info procname function_method_decl_info is_instance is_anonym_block is_generated = let build_method_signature decl_info procname function_method_decl_info is_instance is_anonym_block is_generated =
let source_range = decl_info.Clang_ast_t.di_source_range in let source_range = decl_info.Clang_ast_t.di_source_range in
let qt = get_return_type function_method_decl_info in let tp = get_return_type function_method_decl_info in
let is_instance_method = is_instance_method function_method_decl_info is_instance in let is_instance_method = is_instance_method function_method_decl_info is_instance in
let parameters = get_parameters function_method_decl_info in let parameters = get_parameters function_method_decl_info in
let attributes = decl_info.Clang_ast_t.di_attributes in let attributes = decl_info.Clang_ast_t.di_attributes in
CMethod_signature.make_ms procname parameters qt attributes source_range is_instance_method is_generated CMethod_signature.make_ms procname parameters tp attributes source_range is_instance_method is_generated
let method_signature_of_decl class_name_opt meth_decl block_data_opt = let method_signature_of_decl class_name_opt meth_decl block_data_opt =
let open Clang_ast_t in let open Clang_ast_t in
match meth_decl, block_data_opt, class_name_opt with match meth_decl, block_data_opt, class_name_opt with
| FunctionDecl (decl_info, name_info, qt, fdi), _, _ -> | FunctionDecl (decl_info, name_info, tp, fdi), _, _ ->
let name = name_info.ni_name in let name = name_info.ni_name in
let func_decl = Func_decl_info (fdi, qt) in let func_decl = Func_decl_info (fdi, tp) in
let function_info = Some (decl_info, fdi) in let function_info = Some (decl_info, fdi) in
let procname = General_utils.mk_procname_from_function name function_info qt in let procname = General_utils.mk_procname_from_function name function_info tp in
let ms = build_method_signature decl_info procname func_decl false false false in let ms = build_method_signature decl_info procname func_decl false false false in
ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters
| CXXMethodDecl (decl_info, name_info, qt, fdi), _, Some class_name -> | CXXMethodDecl (decl_info, name_info, tp, fdi), _, Some class_name ->
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in
let procname = General_utils.mk_procname_from_cpp_method class_name method_name qt in let procname = General_utils.mk_procname_from_cpp_method class_name method_name tp in
let method_decl = Cpp_Meth_decl_info (fdi, class_name, qt) in let method_decl = Cpp_Meth_decl_info (fdi, class_name, tp) in
let ms = build_method_signature decl_info procname method_decl false false false in let ms = build_method_signature decl_info procname method_decl false false false in
ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters ms, fdi.Clang_ast_t.fdi_body, fdi.Clang_ast_t.fdi_parameters
| ObjCMethodDecl (decl_info, name_info, mdi), _, Some class_name -> | ObjCMethodDecl (decl_info, name_info, mdi), _, Some class_name ->
@ -113,8 +113,8 @@ let method_signature_of_decl class_name_opt meth_decl block_data_opt =
let ms = build_method_signature decl_info procname method_decl false false is_generated in let ms = build_method_signature decl_info procname method_decl false false is_generated in
ms, mdi.omdi_body, mdi.omdi_parameters ms, mdi.omdi_body, mdi.omdi_parameters
| BlockDecl (decl_info, decl_list, decl_context_info, bdi), | BlockDecl (decl_info, decl_list, decl_context_info, bdi),
Some (qt, is_instance, procname, _, _), _ -> Some (tp, is_instance, procname, _, _), _ ->
let func_decl = Block_decl_info (bdi, qt) in let func_decl = Block_decl_info (bdi, tp) in
let ms = build_method_signature decl_info procname func_decl is_instance true false in let ms = build_method_signature decl_info procname func_decl is_instance true false in
ms, bdi.bdi_body, bdi.bdi_parameters ms, bdi.bdi_body, bdi.bdi_parameters
| _ -> raise Invalid_declaration | _ -> raise Invalid_declaration
@ -152,8 +152,8 @@ let get_class_selector_instance context obj_c_message_expr_info act_params =
let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in
let pointer = obj_c_message_expr_info.Clang_ast_t.omei_decl_pointer in let pointer = obj_c_message_expr_info.Clang_ast_t.omei_decl_pointer in
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 qt -> | `Class tp ->
let sil_type = CTypes_decl.qual_type_to_sil_type context.CContext.tenv qt in let sil_type = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv tp in
((CTypes.classname_of_type sil_type), selector, pointer, MCStatic) ((CTypes.classname_of_type sil_type), selector, pointer, MCStatic)
| `Instance -> | `Instance ->
(match act_params with (match act_params with
@ -173,11 +173,11 @@ let get_formal_parameters tenv ms =
match pl with match pl with
| [] -> [] | [] -> []
| (name, raw_type, _):: pl' -> | (name, raw_type, _):: pl' ->
let qt = let tp =
if (name = CFrontend_config.self && CMethod_signature.ms_is_instance ms) then if (name = CFrontend_config.self && CMethod_signature.ms_is_instance ms) then
(Ast_expressions.create_pointer_type raw_type) (Ast_expressions.create_pointer_type raw_type)
else raw_type in else raw_type in
let typ = CTypes_decl.qual_type_to_sil_type tenv qt in let typ = CTypes_decl.type_ptr_to_sil_type tenv tp in
(name, typ):: defined_parameters pl' in (name, typ):: defined_parameters pl' in
defined_parameters (CMethod_signature.ms_get_args ms) defined_parameters (CMethod_signature.ms_get_args ms)
@ -197,7 +197,7 @@ let captured_vars_from_block_info context cvl =
| cv:: cvl'' -> | cv:: cvl'' ->
(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_qual_type with (match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_type_ptr with
| Some name_info, _ -> | Some name_info, _ ->
let n = name_info.Clang_ast_t.ni_name in let n = name_info.Clang_ast_t.ni_name in
if n = CFrontend_config.self && not context.CContext.is_instance then [] if n = CFrontend_config.self && not context.CContext.is_instance then []
@ -212,7 +212,7 @@ let captured_vars_from_block_info context cvl =
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
CTypes_decl.qual_type_to_sil_type tenv return_type CTypes_decl.type_ptr_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
@ -312,7 +312,7 @@ let create_external_procdesc cfg proc_name is_objc_inst_method type_opt =
} in } in
() ()
let create_procdesc_with_pointer context pointer class_name_opt name qt = let create_procdesc_with_pointer context pointer class_name_opt name tp =
let open CContext in let open CContext in
match method_signature_of_pointer class_name_opt pointer with match method_signature_of_pointer class_name_opt pointer with
| Some callee_ms -> | Some callee_ms ->
@ -322,9 +322,9 @@ let create_procdesc_with_pointer context pointer class_name_opt name qt =
let callee_name = let callee_name =
match class_name_opt with match class_name_opt with
| Some class_name -> | Some class_name ->
General_utils.mk_procname_from_cpp_method class_name name qt General_utils.mk_procname_from_cpp_method class_name name tp
| None -> | None ->
General_utils.mk_procname_from_function name None qt in General_utils.mk_procname_from_function name None tp in
create_external_procdesc context.cfg callee_name false None; create_external_procdesc context.cfg callee_name false None;
callee_name callee_name

@ -38,4 +38,4 @@ val method_signature_of_decl : string option -> Clang_ast_t.decl -> CModule_type
val method_signature_of_pointer : string option -> Clang_ast_t.pointer -> CMethod_signature.method_signature option val method_signature_of_pointer : string option -> Clang_ast_t.pointer -> CMethod_signature.method_signature option
val create_procdesc_with_pointer : CContext.t -> Clang_ast_t.pointer -> string option -> val create_procdesc_with_pointer : CContext.t -> Clang_ast_t.pointer -> string option ->
string -> Clang_ast_t.qual_type -> Procname.t string -> Clang_ast_t.type_ptr -> Procname.t

@ -7,7 +7,7 @@
* of patent rights can be found in the PATENTS file in the same directory. * of patent rights can be found in the PATENTS file in the same directory.
*) *)
type block_data = Clang_ast_t.qual_type * bool * Procname.t * (Mangled.t * Sil.typ * bool) list * CContext.curr_class type block_data = Clang_ast_t.type_ptr * bool * Procname.t * (Mangled.t * Sil.typ * bool) list * CContext.curr_class
module type CTranslation = module type CTranslation =
sig sig

@ -84,7 +84,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 CTypes.is_block_type ei.Clang_ast_t.ei_qual_type -> true when CTypes.is_block_type ei.Clang_ast_t.ei_type_ptr -> 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. *)
@ -224,8 +224,8 @@ struct
let objCSelectorExpr_trans trans_state stmt_info expr_info selector = let objCSelectorExpr_trans trans_state stmt_info expr_info selector =
stringLiteral_trans trans_state stmt_info expr_info selector stringLiteral_trans trans_state stmt_info expr_info selector
let objCEncodeExpr_trans trans_state stmt_info expr_info qual_type = let objCEncodeExpr_trans trans_state stmt_info expr_info type_ptr =
stringLiteral_trans trans_state stmt_info expr_info (Ast_utils.string_of_qual_type qual_type) stringLiteral_trans trans_state stmt_info expr_info (Ast_utils.string_of_type_ptr type_ptr)
let objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref = let objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref =
let name = (match decl_ref.Clang_ast_t.dr_name with let name = (match decl_ref.Clang_ast_t.dr_name with
@ -268,13 +268,13 @@ struct
(* The stmt seems to be always empty *) (* The stmt seems to be always empty *)
let unaryExprOrTypeTraitExpr_trans trans_state stmt_info expr_info unary_expr_or_type_trait_expr_info = let unaryExprOrTypeTraitExpr_trans trans_state stmt_info 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 = CTypes_decl.qual_type_to_sil_type tenv expr_info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.type_ptr_to_sil_type tenv expr_info.Clang_ast_t.ei_type_ptr 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 qt = Ast_utils.type_from_unary_expr_or_type_trait_expr_info unary_expr_or_type_trait_expr_info in let tp = Ast_utils.type_from_unary_expr_or_type_trait_expr_info unary_expr_or_type_trait_expr_info in
let sizeof_typ = let sizeof_typ =
match qt with match tp with
| Some qt -> CTypes_decl.qual_type_to_sil_type tenv qt | Some tp -> CTypes_decl.type_ptr_to_sil_type tenv tp
| None -> typ in (* Some default type since the type is missing *) | None -> typ in (* Some default type since the type is missing *)
{ empty_res_trans with exps = [(Sil.Sizeof(sizeof_typ, Sil.Subtype.exact), sizeof_typ)]} { empty_res_trans with exps = [(Sil.Sizeof(sizeof_typ, Sil.Subtype.exact), sizeof_typ)]}
| k -> Printing.log_stats | k -> Printing.log_stats
@ -294,8 +294,8 @@ struct
Printing.log_out " priority node free = '%s'\n@." Printing.log_out " priority node free = '%s'\n@."
(string_of_bool (PriorityNode.is_priority_free trans_state)); (string_of_bool (PriorityNode.is_priority_free trans_state));
let context = trans_state.context in let context = trans_state.context in
let qt = expr_info.Clang_ast_t.ei_qual_type in let tp = expr_info.Clang_ast_t.ei_type_ptr in
let typ = CTypes_decl.qual_type_to_sil_type context.tenv qt in let typ = CTypes_decl.type_ptr_to_sil_type context.tenv tp in
let name = get_name_decl_ref_exp_info decl_ref_expr_info stmt_info in let name = get_name_decl_ref_exp_info decl_ref_expr_info stmt_info in
let procname = Cfg.Procdesc.get_proc_name context.procdesc in let procname = Cfg.Procdesc.get_proc_name context.procdesc in
let pointer = CTrans_utils.get_decl_pointer decl_ref_expr_info in let pointer = CTrans_utils.get_decl_pointer decl_ref_expr_info in
@ -318,7 +318,7 @@ struct
let pname = let pname =
if CTrans_models.is_modeled_builtin name then if CTrans_models.is_modeled_builtin name then
Procname.from_string_c_fun (CFrontend_config.infer ^ name) Procname.from_string_c_fun (CFrontend_config.infer ^ name)
else CMethod_trans.create_procdesc_with_pointer context pointer None name qt in else CMethod_trans.create_procdesc_with_pointer context pointer None name tp in
let address_of_function = not context.CContext.is_callee_expression in let address_of_function = not context.CContext.is_callee_expression in
(* If we are not translating a callee expression, then the address of the function is being taken.*) (* If we are not translating a callee expression, then the address of the function is being taken.*)
(* As e.g. in fun_ptr = foo; *) (* As e.g. in fun_ptr = foo; *)
@ -419,7 +419,7 @@ struct
let parent_line_number = trans_state.parent_line_number in let parent_line_number = trans_state.parent_line_number in
let succ_nodes = trans_state.succ_nodes in let succ_nodes = trans_state.succ_nodes in
let sil_loc = CLocation.get_sil_location stmt_info parent_line_number context in let sil_loc = CLocation.get_sil_location stmt_info parent_line_number context in
let typ = CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
(match stmt_list with (match stmt_list with
| [s1; ImplicitCastExpr (stmt, [CompoundLiteralExpr (cle_stmt_info, stmts, expr_info)], _, cast_expr_info)] -> | [s1; ImplicitCastExpr (stmt, [CompoundLiteralExpr (cle_stmt_info, stmts, expr_info)], _, cast_expr_info)] ->
let di, line_number = get_decl_ref_info s1 parent_line_number in let di, line_number = get_decl_ref_info s1 parent_line_number in
@ -737,9 +737,9 @@ struct
let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in let procname = Cfg.Procdesc.get_proc_name trans_state.context.CContext.procdesc in
let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in
CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar trans_state.context; CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar trans_state.context;
let transformed_stmt, qt = let transformed_stmt, tp =
Ast_expressions.translate_dispatch_function (Sil.pvar_to_string pvar) stmt_info stmt_list ei n in Ast_expressions.translate_dispatch_function (Sil.pvar_to_string pvar) stmt_info stmt_list ei n in
let typ = CTypes_decl.qual_type_to_sil_type trans_state.context.CContext.tenv qt in let typ = CTypes_decl.type_ptr_to_sil_type trans_state.context.CContext.tenv tp in
let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in
let res_state = instruction trans_state transformed_stmt in let res_state = instruction trans_state transformed_stmt in
(* Add declare locals to the first node *) (* Add declare locals to the first node *)
@ -761,9 +761,9 @@ struct
let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in let pvar = CFrontend_utils.General_utils.get_next_block_pvar procname in
let transformed_stmt, vars_to_register = let transformed_stmt, vars_to_register =
Ast_expressions.translate_block_enumerate (Sil.pvar_to_string pvar) stmt_info stmt_list ei in Ast_expressions.translate_block_enumerate (Sil.pvar_to_string pvar) stmt_info stmt_list ei in
let pvars_types = list_map (fun (v, pointer, qt) -> let pvars_types = list_map (fun (v, pointer, tp) ->
let pvar = Sil.mk_pvar (Mangled.from_string v) procname in let pvar = Sil.mk_pvar (Mangled.from_string v) procname in
let typ = CTypes_decl.qual_type_to_sil_type trans_state.context.CContext.tenv qt in let typ = CTypes_decl.type_ptr_to_sil_type trans_state.context.CContext.tenv tp in
CContext.LocalVars.add_pointer_var pointer pvar trans_state.context; CContext.LocalVars.add_pointer_var pointer pvar trans_state.context;
(pvar, typ)) vars_to_register in (pvar, typ)) vars_to_register in
let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in let loc = CLocation.get_sil_location stmt_info trans_state.parent_line_number trans_state.context in
@ -843,7 +843,7 @@ struct
(match stmt_list with (match stmt_list with
| [cond; exp1; exp2] -> | [cond; exp1; exp2] ->
let typ = let typ =
CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
let join_node = compute_join_node typ in let join_node = compute_join_node typ in
let pvar = mk_temp_var (Cfg.Node.get_id join_node) in let pvar = mk_temp_var (Cfg.Node.get_id join_node) in
let continuation' = mk_cond_continuation trans_state.continuation in let continuation' = mk_cond_continuation trans_state.continuation in
@ -1213,7 +1213,7 @@ struct
let sil_loc = CLocation.get_sil_location stmt_info pln context in let sil_loc = CLocation.get_sil_location stmt_info pln context in
let line_number = CLocation.get_line stmt_info pln in let line_number = CLocation.get_line stmt_info pln in
let sil_typ = let sil_typ =
CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
(match stmt_list with (match stmt_list with
| [s1; s2] -> | [s1; s2] ->
let trans_state' = { trans_state_pri with succ_nodes = []; parent_line_number = line_number } in let trans_state' = { trans_state_pri with succ_nodes = []; parent_line_number = line_number } in
@ -1298,7 +1298,7 @@ struct
list_map (fun (e, t) -> list_flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) list_map (fun (e, t) -> list_flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types)
| _ -> [ [(e, typ)] ] in | _ -> [ [(e, typ)] ] 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 var_type = CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in let var_type = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
let pvar = CContext.LocalVars.find_var_with_pointer context di_pointer in let pvar = CContext.LocalVars.find_var_with_pointer context di_pointer in
let lh = list_flatten (collect_left_hand_exprs (Sil.Lvar pvar) var_type Utils.StringSet.empty) in let lh = list_flatten (collect_left_hand_exprs (Sil.Lvar pvar) var_type Utils.StringSet.empty) in
let rh = list_flatten (list_map (collect_right_hand_exprs trans_state_pri) stmts ) in let rh = list_flatten (list_map (collect_right_hand_exprs trans_state_pri) stmts ) in
@ -1350,7 +1350,7 @@ struct
let open Clang_ast_t in let open Clang_ast_t in
let context = trans_state.context in let context = trans_state.context in
let pln = trans_state.parent_line_number in let pln = trans_state.parent_line_number in
let do_var_dec (di, var_name, qtype, vdi) next_node = let do_var_dec (di, var_name, type_ptr, vdi) next_node =
match vdi.Clang_ast_t.vdi_init_expr with match vdi.Clang_ast_t.vdi_init_expr with
| None -> { empty_res_trans with root_nodes = next_node } (* Nothing to do if no init expression *) | None -> { empty_res_trans with root_nodes = next_node } (* Nothing to do if no init expression *)
| Some (ImplicitValueInitExpr (_, stmt_list, _)) -> | Some (ImplicitValueInitExpr (_, stmt_list, _)) ->
@ -1416,10 +1416,10 @@ struct
} in } 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, qt, vdi) :: var_decls' -> | VarDecl (di, n, tp, 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, qt, vdi) res_trans_vd.root_nodes in let res_trans_tmp = do_var_dec (di, n, tp, vdi) res_trans_vd.root_nodes in
{ root_nodes = res_trans_tmp.root_nodes; leaf_nodes = []; { root_nodes = res_trans_tmp.root_nodes; leaf_nodes = [];
ids = res_trans_tmp.ids @ res_trans_vd.ids; ids = res_trans_tmp.ids @ res_trans_vd.ids;
instrs = res_trans_tmp.instrs @ res_trans_vd.instrs; instrs = res_trans_tmp.instrs @ res_trans_vd.instrs;
@ -1505,7 +1505,7 @@ struct
let line_number = CLocation.get_line stmt_info pln in let line_number = CLocation.get_line stmt_info pln in
let trans_state' = { trans_state with parent_line_number = line_number } in let trans_state' = { trans_state with parent_line_number = line_number } in
let res_trans_stmt = instruction trans_state' stmt in let res_trans_stmt = instruction trans_state' stmt in
let typ = CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr 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 cast_ids, cast_inst, cast_exp = cast_operation context cast_kind res_trans_stmt.exps typ sil_loc is_objc_bridged in let cast_ids, cast_inst, cast_exp = cast_operation context cast_kind res_trans_stmt.exps typ sil_loc is_objc_bridged in
@ -1521,10 +1521,10 @@ struct
let field_name = match decl_ref.Clang_ast_t.dr_name with let field_name = match decl_ref.Clang_ast_t.dr_name with
| Some s -> s | Some s -> s
| _ -> assert false in | _ -> assert false in
let field_qt = match decl_ref.Clang_ast_t.dr_qual_type with let field_tp = match decl_ref.Clang_ast_t.dr_type_ptr with
| Some t -> t | Some t -> t
| _ -> assert false in | _ -> assert false in
let field_typ = CTypes_decl.qual_type_to_sil_type context.CContext.tenv field_qt in let field_typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv field_tp in
Printing.log_out "!!!!! Dealing with field '%s' @." field_name.Clang_ast_t.ni_name; Printing.log_out "!!!!! Dealing with field '%s' @." field_name.Clang_ast_t.ni_name;
let exp_stmt = extract_stmt_from_singleton stmt_list let exp_stmt = extract_stmt_from_singleton stmt_list
"WARNING: in MemberExpr there must be only one stmt defining its expression.\n" in "WARNING: in MemberExpr there must be only one stmt defining its expression.\n" in
@ -1546,7 +1546,7 @@ struct
let class_name = match class_typ with Sil.Tptr (t, _) | t -> CTypes.classname_of_type t in let class_name = match class_typ with Sil.Tptr (t, _) | t -> CTypes.classname_of_type t in
let pointer = decl_ref.Clang_ast_t.dr_decl_pointer in let pointer = decl_ref.Clang_ast_t.dr_decl_pointer in
let pname = CMethod_trans.create_procdesc_with_pointer context pointer (Some class_name) let pname = CMethod_trans.create_procdesc_with_pointer context pointer (Some class_name)
field_name.Clang_ast_t.ni_name field_qt in field_name.Clang_ast_t.ni_name field_tp in
let method_exp = (Sil.Const (Sil.Cfun pname), field_typ) in let method_exp = (Sil.Const (Sil.Cfun pname), field_typ) in
Cfg.set_procname_priority context.CContext.cfg pname; Cfg.set_procname_priority context.CContext.cfg pname;
{ result_trans_exp_stmt with exps = [method_exp; (obj_sil, class_typ)] } { result_trans_exp_stmt with exps = [method_exp; (obj_sil, class_typ)] }
@ -1572,7 +1572,7 @@ struct
let res_trans_stmt = instruction trans_state' stmt in let res_trans_stmt = instruction trans_state' stmt in
(* Assumption: the operand does not create a cfg node*) (* Assumption: the operand does not create a cfg node*)
let (sil_e', _) = extract_exp_from_list res_trans_stmt.exps "\nWARNING: Missing operand in unary operator. NEED FIXING.\n" in let (sil_e', _) = extract_exp_from_list res_trans_stmt.exps "\nWARNING: Missing operand in unary operator. NEED FIXING.\n" in
let ret_typ = CTypes_decl.qual_type_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_qual_type in let ret_typ = CTypes_decl.type_ptr_to_sil_type context.CContext.tenv expr_info.Clang_ast_t.ei_type_ptr in
let ids_op, exp_op, instr_op = let ids_op, exp_op, instr_op =
CArithmetic_trans.unary_operation_instruction unary_operator_info sil_e' ret_typ sil_loc in CArithmetic_trans.unary_operation_instruction unary_operator_info sil_e' ret_typ sil_loc in
let node_kind = Cfg.Node.Stmt_node "UnaryOperator" in let node_kind = Cfg.Node.Stmt_node "UnaryOperator" in
@ -1648,13 +1648,13 @@ struct
instruction trans_state' stmt instruction trans_state' stmt
and objCBoxedExpr_trans trans_state info sel stmt_info stmts = and objCBoxedExpr_trans trans_state info sel stmt_info stmts =
let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
let obj_c_message_expr_info = Ast_expressions.make_obj_c_message_expr_info_class sel typ in let obj_c_message_expr_info = Ast_expressions.make_obj_c_message_expr_info_class sel typ in
let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in
instruction trans_state message_stmt instruction trans_state message_stmt
and objCArrayLiteral_trans trans_state info stmt_info stmts = and objCArrayLiteral_trans trans_state info stmt_info stmts =
let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
let obj_c_message_expr_info = let obj_c_message_expr_info =
Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.array_with_objects_count_m typ in Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.array_with_objects_count_m typ in
let stmts = stmts @ [Ast_expressions.create_nil stmt_info] in let stmts = stmts @ [Ast_expressions.create_nil stmt_info] in
@ -1662,7 +1662,7 @@ struct
instruction trans_state message_stmt instruction trans_state message_stmt
and objCDictionaryLiteral_trans trans_state info stmt_info stmts = and objCDictionaryLiteral_trans trans_state info stmt_info stmts =
let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
let obj_c_message_expr_info = let obj_c_message_expr_info =
Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.dict_with_objects_and_keys_m typ in Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.dict_with_objects_and_keys_m typ in
let stmts = General_utils.swap_elements_list stmts in let stmts = General_utils.swap_elements_list stmts in
@ -1673,7 +1673,7 @@ 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 `ArrayToPointerDecay] in
let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_qual_type in let typ = CTypes_decl.class_from_pointer_type trans_state.context.CContext.tenv info.Clang_ast_t.ei_type_ptr in
let obj_c_message_expr_info = let obj_c_message_expr_info =
Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.string_with_utf8_m typ in Ast_expressions.make_obj_c_message_expr_info_class CFrontend_config.string_with_utf8_m typ in
let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in let message_stmt = Clang_ast_t.ObjCMessageExpr (stmt_info, stmts, info, obj_c_message_expr_info) in
@ -1733,9 +1733,9 @@ struct
match decl with match decl with
| Clang_ast_t.BlockDecl (decl_info, decl_list, decl_context_info, block_decl_info) -> | Clang_ast_t.BlockDecl (decl_info, decl_list, decl_context_info, block_decl_info) ->
let open CContext in let open CContext in
let qual_type = expr_info.Clang_ast_t.ei_qual_type in let type_ptr = expr_info.Clang_ast_t.ei_type_ptr in
let block_pname = CFrontend_utils.General_utils.mk_fresh_block_procname procname in let block_pname = CFrontend_utils.General_utils.mk_fresh_block_procname procname in
let typ = CTypes_decl.qual_type_to_sil_type context.tenv qual_type in let typ = CTypes_decl.type_ptr_to_sil_type context.tenv type_ptr 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;
@ -1749,7 +1749,7 @@ struct
let all_captured_vars = captured_vars @ static_vars in let all_captured_vars = captured_vars @ static_vars in
let ids_instrs = list_map assign_captured_var all_captured_vars in let ids_instrs = list_map assign_captured_var all_captured_vars in
let ids, instrs = list_split ids_instrs in let ids, instrs = list_split ids_instrs in
let block_data = (qual_type, context.is_instance, block_pname, all_captured_vars, context.curr_class) in let block_data = (type_ptr, context.is_instance, block_pname, all_captured_vars, context.curr_class) in
M.function_decl context.tenv context.cfg context.cg context.namespace decl (Some block_data); M.function_decl context.tenv context.cfg context.cg context.namespace decl (Some block_data);
Cfg.set_procname_priority context.cfg block_pname; Cfg.set_procname_priority context.cfg block_pname;
let captured_exps = list_map (fun id -> Sil.Var id) ids in let captured_exps = list_map (fun id -> Sil.Var id) ids in
@ -1904,8 +1904,8 @@ struct
| ObjCSelectorExpr(stmt_info, stmt_list, expr_info, selector) -> | ObjCSelectorExpr(stmt_info, stmt_list, expr_info, selector) ->
objCSelectorExpr_trans trans_state stmt_info expr_info selector objCSelectorExpr_trans trans_state stmt_info expr_info selector
| ObjCEncodeExpr(stmt_info, stmt_list, expr_info, qual_type) -> | ObjCEncodeExpr(stmt_info, stmt_list, expr_info, type_ptr) ->
objCEncodeExpr_trans trans_state stmt_info expr_info qual_type objCEncodeExpr_trans trans_state stmt_info expr_info type_ptr
| ObjCProtocolExpr(stmt_info, stmt_list, expr_info, decl_ref) -> | ObjCProtocolExpr(stmt_info, stmt_list, expr_info, decl_ref) ->
objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref objCProtocolExpr_trans trans_state stmt_info expr_info decl_ref

@ -37,7 +37,7 @@ let is_alloc_model typ funct =
let rec get_func_type_from_stmt stmt = let rec get_func_type_from_stmt stmt =
match stmt with match stmt with
| Clang_ast_t.DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) -> | Clang_ast_t.DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
Some expr_info.Clang_ast_t.ei_qual_type Some expr_info.Clang_ast_t.ei_type_ptr
| _ -> | _ ->
match CFrontend_utils.Ast_utils.get_stmts_from_stmt stmt with match CFrontend_utils.Ast_utils.get_stmts_from_stmt stmt with
| stmt:: rest -> get_func_type_from_stmt stmt | stmt:: rest -> get_func_type_from_stmt stmt
@ -100,7 +100,7 @@ let is_toll_free_bridging pn_opt =
let builtin_predefined_model fun_stmt sil_fe = let builtin_predefined_model fun_stmt sil_fe =
match get_func_type_from_stmt fun_stmt with match get_func_type_from_stmt fun_stmt with
| Some typ -> | Some typ ->
let typ = Ast_utils.string_of_qual_type typ in let typ = Ast_utils.string_of_type_ptr typ in
(match sil_fe with (match sil_fe with
| Sil.Const (Sil.Cfun pn) when Specs.summary_exists pn -> sil_fe, false | Sil.Const (Sil.Cfun pn) when Specs.summary_exists pn -> sil_fe, false
| Sil.Const (Sil.Cfun pn) when is_retain_predefined_model typ (Procname.to_string pn) -> | Sil.Const (Sil.Cfun pn) when is_retain_predefined_model typ (Procname.to_string pn) ->

@ -520,20 +520,20 @@ let extract_id_from_singleton id_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_qual_type with | Some d -> (match d.Clang_ast_t.dr_type_ptr 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_qual_type | CallExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type | MemberExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr
| ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_qual_type | ParenExpr (_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type | ArraySubscriptExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_qual_type | ObjCIvarRefExpr (_, _, ei, _) -> ei.Clang_ast_t.ei_type_ptr
| ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_qual_type | ObjCMessageExpr (_, _, ei, _ ) -> ei.Clang_ast_t.ei_type_ptr
| PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_qual_type | PseudoObjectExpr(_, _, ei) -> ei.Clang_ast_t.ei_type_ptr
| CStyleCastExpr(_, stmt_list, _, _, _) | CStyleCastExpr(_, stmt_list, _, _, _)
| UnaryOperator(_, stmt_list, _, _) | UnaryOperator(_, stmt_list, _, _)
| ImplicitCastExpr(_, stmt_list, _, _) -> | ImplicitCastExpr(_, stmt_list, _, _) ->
@ -658,7 +658,7 @@ let rec compute_autorelease_pool_vars context stmts =
(* 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 CTypes_decl.qual_type_to_sil_type tenv ei.Clang_ast_t.ei_qual_type, uoi.Clang_ast_t.uoi_kind with match CTypes_decl.type_ptr_to_sil_type tenv ei.Clang_ast_t.ei_type_ptr, uoi.Clang_ast_t.uoi_kind with
| Sil.Tint Sil.IInt,`LNot -> true | Sil.Tint Sil.IInt,`LNot -> true
| _, _ -> false | _, _ -> false

@ -79,7 +79,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.qual_type val get_type_from_exp_stmt : Clang_ast_t.stmt -> Clang_ast_t.type_ptr
val cast_operation : val cast_operation :
CContext.t -> Clang_ast_t.cast_kind -> (Sil.exp * Sil.typ) list -> Sil.typ -> Location.t -> CContext.t -> Clang_ast_t.cast_kind -> (Sil.exp * Sil.typ) list -> Sil.typ -> Location.t ->

@ -9,7 +9,7 @@
open CFrontend_utils open CFrontend_utils
let custom_qual_type_to_sil_type type_pointer = let custom_type_ptr_to_sil_type type_pointer =
if Utils.string_is_prefix "custom" type_pointer then if Utils.string_is_prefix "custom" type_pointer then
let typ = let typ =
(match CTypes.get_name_from_type_pointer type_pointer with (match CTypes.get_name_from_type_pointer type_pointer with
@ -74,7 +74,7 @@ let pointer_attribute_of_objc_attribute attr_info =
| `OCL_Autoreleasing -> Sil.Pk_objc_autoreleasing | `OCL_Autoreleasing -> Sil.Pk_objc_autoreleasing
let rec build_array_type translate_decl tenv type_ptr n = let rec build_array_type translate_decl tenv type_ptr n =
let array_type = qual_type_ptr_to_sil_type translate_decl tenv type_ptr in let array_type = type_ptr_ptr_to_sil_type translate_decl tenv type_ptr in
let exp = Sil.exp_int (Sil.Int.of_int64 (Int64.of_int n)) in let exp = Sil.exp_int (Sil.Int.of_int64 (Int64.of_int n)) in
Sil.Tarray (array_type, exp) Sil.Tarray (array_type, exp)
@ -83,9 +83,9 @@ and sil_type_of_attr_type translate_decl tenv type_info attr_info =
| Some type_ptr -> | Some type_ptr ->
(match Ast_utils.get_type type_ptr with (match Ast_utils.get_type type_ptr with
| Some Clang_ast_t.ObjCObjectPointerType (type_info', type_ptr') -> | Some Clang_ast_t.ObjCObjectPointerType (type_info', type_ptr') ->
let typ = qual_type_ptr_to_sil_type translate_decl tenv type_ptr' in let typ = type_ptr_ptr_to_sil_type translate_decl tenv type_ptr' in
Sil.Tptr (typ, pointer_attribute_of_objc_attribute attr_info) Sil.Tptr (typ, pointer_attribute_of_objc_attribute attr_info)
| _ -> qual_type_ptr_to_sil_type translate_decl tenv type_ptr) | _ -> type_ptr_ptr_to_sil_type translate_decl tenv type_ptr)
| None -> Sil.Tvoid | None -> Sil.Tvoid
and sil_type_of_c_type translate_decl tenv c_type = and sil_type_of_c_type translate_decl tenv c_type =
@ -96,14 +96,14 @@ and sil_type_of_c_type translate_decl tenv c_type =
sil_type_of_builtin_type_kind builtin_type_kind sil_type_of_builtin_type_kind builtin_type_kind
| PointerType (type_info, type_ptr) | PointerType (type_info, type_ptr)
| ObjCObjectPointerType (type_info, type_ptr) -> | ObjCObjectPointerType (type_info, type_ptr) ->
let typ = qual_type_ptr_to_sil_type translate_decl tenv type_ptr in let typ = type_ptr_ptr_to_sil_type translate_decl tenv type_ptr in
if Sil.typ_equal typ (get_builtin_objc_type `ObjCClass) then if Sil.typ_equal typ (get_builtin_objc_type `ObjCClass) then
typ typ
else Sil.Tptr (typ, Sil.Pk_pointer) else Sil.Tptr (typ, Sil.Pk_pointer)
| ObjCObjectType (type_info, objc_object_type_info) -> | ObjCObjectType (type_info, objc_object_type_info) ->
qual_type_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type type_ptr_ptr_to_sil_type translate_decl tenv objc_object_type_info.Clang_ast_t.base_type
| BlockPointerType (type_info, type_ptr) -> | BlockPointerType (type_info, type_ptr) ->
let typ = qual_type_ptr_to_sil_type translate_decl tenv type_ptr in let typ = type_ptr_ptr_to_sil_type translate_decl tenv type_ptr in
Sil.Tptr (typ, Sil.Pk_pointer) Sil.Tptr (typ, Sil.Pk_pointer)
| IncompleteArrayType (type_info, type_ptr) | IncompleteArrayType (type_info, type_ptr)
| DependentSizedArrayType (type_info, type_ptr) | DependentSizedArrayType (type_info, type_ptr)
@ -115,27 +115,27 @@ and sil_type_of_c_type translate_decl tenv c_type =
| FunctionNoProtoType (type_info, function_type_info) -> | FunctionNoProtoType (type_info, function_type_info) ->
Sil.Tfun false Sil.Tfun false
| ParenType (type_info, type_ptr) -> | ParenType (type_info, type_ptr) ->
qual_type_ptr_to_sil_type translate_decl tenv type_ptr type_ptr_ptr_to_sil_type translate_decl tenv type_ptr
| DecayedType (type_info, type_ptr) -> | DecayedType (type_info, type_ptr) ->
qual_type_ptr_to_sil_type translate_decl tenv type_ptr type_ptr_ptr_to_sil_type translate_decl tenv type_ptr
| RecordType (type_info, pointer) | RecordType (type_info, pointer)
| EnumType (type_info, pointer) -> | EnumType (type_info, 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
Some type_ptr -> qual_type_ptr_to_sil_type translate_decl tenv type_ptr Some type_ptr -> type_ptr_ptr_to_sil_type translate_decl tenv type_ptr
| None -> Sil.Tvoid) | None -> Sil.Tvoid)
| ObjCInterfaceType (type_info, pointer) -> | ObjCInterfaceType (type_info, pointer) ->
decl_ptr_to_sil_type translate_decl tenv pointer decl_ptr_to_sil_type translate_decl tenv pointer
| LValueReferenceType (type_info, type_ptr) -> | LValueReferenceType (type_info, type_ptr) ->
let typ = qual_type_ptr_to_sil_type translate_decl tenv type_ptr in let typ = type_ptr_ptr_to_sil_type translate_decl tenv type_ptr in
Sil.Tptr (typ, Sil.Pk_reference) Sil.Tptr (typ, Sil.Pk_reference)
| AttributedType (type_info, attr_info) -> | AttributedType (type_info, attr_info) ->
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
| Some typ -> qual_type_ptr_to_sil_type translate_decl tenv typ | Some typ -> type_ptr_ptr_to_sil_type translate_decl tenv typ
| None -> Sil.Tvoid | None -> Sil.Tvoid
and decl_ptr_to_sil_type translate_decl tenv decl_ptr = and decl_ptr_to_sil_type translate_decl tenv decl_ptr =
@ -158,7 +158,7 @@ and decl_ptr_to_sil_type translate_decl tenv decl_ptr =
(Clang_ast_j.string_of_pointer decl_ptr); (Clang_ast_j.string_of_pointer decl_ptr);
Sil.Tvoid Sil.Tvoid
and qual_type_ptr_to_sil_type translate_decl tenv type_ptr = and type_ptr_ptr_to_sil_type translate_decl tenv type_ptr =
try try
Clang_ast_main.PointerMap.find type_ptr !CFrontend_config.sil_types_map Clang_ast_main.PointerMap.find type_ptr !CFrontend_config.sil_types_map
with Not_found -> with Not_found ->
@ -169,8 +169,8 @@ and qual_type_ptr_to_sil_type translate_decl tenv type_ptr =
sil_type sil_type
| _ -> Sil.Tvoid | _ -> Sil.Tvoid
and qual_type_to_sil_type translate_decl tenv qt = and type_ptr_to_sil_type translate_decl tenv tp =
let type_ptr = qt in let type_ptr = tp in
match custom_qual_type_to_sil_type type_ptr with match custom_type_ptr_to_sil_type type_ptr with
| Some typ -> typ | Some typ -> typ
| None -> qual_type_ptr_to_sil_type translate_decl tenv type_ptr | None -> type_ptr_ptr_to_sil_type translate_decl tenv type_ptr

@ -13,5 +13,5 @@ val get_builtin_objc_type : [< `ObjCClass | `ObjCId ] -> Sil.typ
val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Sil.typ val sil_type_of_builtin_type_kind : Clang_ast_t.builtin_type_kind -> Sil.typ
val qual_type_to_sil_type : (Sil.tenv -> string option -> Clang_ast_t.decl -> Sil.typ) -> val type_ptr_to_sil_type : (Sil.tenv -> string option -> Clang_ast_t.decl -> Sil.typ) ->
Sil.tenv -> Clang_ast_t.qual_type -> Sil.typ Sil.tenv -> Clang_ast_t.type_ptr -> Sil.typ

@ -14,7 +14,7 @@ open CFrontend_utils
module L = Logging module L = Logging
let get_type_from_expr_info ei = let get_type_from_expr_info ei =
ei.Clang_ast_t.ei_qual_type ei.Clang_ast_t.ei_type_ptr
let lookup_var_type context pvar = let lookup_var_type context pvar =
let formals = Cfg.Procdesc.get_formals context.CContext.procdesc in let formals = Cfg.Procdesc.get_formals context.CContext.procdesc in
@ -121,12 +121,12 @@ let rec return_type_of_function_type_ptr type_ptr =
(Clang_ast_j.string_of_pointer type_ptr); (Clang_ast_j.string_of_pointer type_ptr);
"" ""
let return_type_of_function_type qt = let return_type_of_function_type tp =
return_type_of_function_type_ptr qt return_type_of_function_type_ptr tp
let is_block_type qt = let is_block_type tp =
let open Clang_ast_t in let open Clang_ast_t in
match Ast_utils.get_desugared_type qt with match Ast_utils.get_desugared_type tp with
| Some BlockPointerType _ -> true | Some BlockPointerType _ -> true
| _ -> false | _ -> false

@ -29,9 +29,9 @@ val remove_pointer_to_typ : Sil.typ -> Sil.typ
val is_class : Sil.typ -> bool val is_class : Sil.typ -> bool
val return_type_of_function_type : Clang_ast_t.qual_type -> Clang_ast_t.pointer val return_type_of_function_type : Clang_ast_t.type_ptr -> Clang_ast_t.pointer
val is_block_type : Clang_ast_t.qual_type -> bool val is_block_type : Clang_ast_t.type_ptr -> bool
val expand_structured_type : Sil.tenv -> Sil.typ -> Sil.typ val expand_structured_type : Sil.tenv -> Sil.typ -> Sil.typ

@ -36,15 +36,15 @@ let add_predefined_objc_types tenv =
let add_predefined_basic_types tenv = let add_predefined_basic_types tenv =
let open Ast_expressions in let open Ast_expressions in
let open Clang_ast_t in let open Clang_ast_t in
let add_basic_type qt basic_type_kind = let add_basic_type tp basic_type_kind =
let sil_type = CType_to_sil_type.sil_type_of_builtin_type_kind basic_type_kind in let sil_type = CType_to_sil_type.sil_type_of_builtin_type_kind basic_type_kind in
Ast_utils.update_sil_types_map qt sil_type in Ast_utils.update_sil_types_map tp sil_type in
let add_pointer_type qt sil_type = let add_pointer_type tp sil_type =
let pointer_type = CTypes.add_pointer_to_typ sil_type in let pointer_type = CTypes.add_pointer_to_typ sil_type in
Ast_utils.update_sil_types_map qt pointer_type in Ast_utils.update_sil_types_map tp pointer_type in
let add_function_type qt return_type = let add_function_type tp return_type =
(* We translate function types as the return type of the function *) (* We translate function types as the return type of the function *)
Ast_utils.update_sil_types_map qt return_type in Ast_utils.update_sil_types_map tp return_type in
let sil_void_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Void in let sil_void_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Void in
let sil_char_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Char_S in let sil_char_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Char_S in
let sil_nsarray_type = Sil.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl) in let sil_nsarray_type = Sil.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl) in
@ -109,10 +109,10 @@ let get_method_decls parent decl_list =
let get_class_methods tenv class_name namespace decl_list = let get_class_methods tenv class_name namespace decl_list =
let process_method_decl = function let process_method_decl = function
| Clang_ast_t.CXXMethodDecl (decl_info, name_info, qt, function_decl_info) -> | Clang_ast_t.CXXMethodDecl (decl_info, name_info, tp, function_decl_info) ->
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Declaring method '%s'.\n" method_name; Printing.log_out " ...Declaring method '%s'.\n" method_name;
let method_proc = General_utils.mk_procname_from_cpp_method class_name method_name qt in let method_proc = General_utils.mk_procname_from_cpp_method class_name method_name tp in
Some method_proc Some method_proc
| _ -> None in | _ -> None in
(* poor mans list_filter_map *) (* poor mans list_filter_map *)
@ -141,9 +141,9 @@ let add_struct_to_tenv tenv typ =
let rec get_struct_fields tenv record_name namespace decl_list = let rec get_struct_fields tenv record_name namespace decl_list =
let open Clang_ast_t in let open Clang_ast_t in
let do_one_decl decl = match decl with let do_one_decl decl = match decl with
| FieldDecl (_, name_info, qual_type, _) -> | FieldDecl (_, name_info, type_ptr, _) ->
let id = General_utils.mk_class_field_name name_info in let id = General_utils.mk_class_field_name name_info in
let typ = qual_type_to_sil_type tenv qual_type in let typ = type_ptr_to_sil_type tenv type_ptr 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)]
| CXXRecordDecl (decl_info, _, _, _, _, _, _, _) | CXXRecordDecl (decl_info, _, _, _, _, _, _, _)
@ -188,29 +188,29 @@ and add_types_from_decl_to_tenv tenv namespace decl =
add_struct_to_tenv tenv typ; add_struct_to_tenv tenv typ;
typ typ
and qual_type_to_sil_type tenv qt = and type_ptr_to_sil_type tenv tp =
CType_to_sil_type.qual_type_to_sil_type add_types_from_decl_to_tenv tenv qt CType_to_sil_type.type_ptr_to_sil_type add_types_from_decl_to_tenv tenv tp
let type_name_to_sil_type tenv name = let type_name_to_sil_type tenv name =
qual_type_to_sil_type tenv (Ast_expressions.create_class_type name) type_ptr_to_sil_type tenv (Ast_expressions.create_class_type name)
let get_type_from_expr_info ei tenv = let get_type_from_expr_info ei tenv =
let qt = ei.Clang_ast_t.ei_qual_type in let tp = ei.Clang_ast_t.ei_type_ptr in
qual_type_to_sil_type tenv qt type_ptr_to_sil_type tenv tp
let class_from_pointer_type tenv qual_type = let class_from_pointer_type tenv type_ptr =
match qual_type_to_sil_type tenv qual_type with match type_ptr_to_sil_type tenv type_ptr with
| Sil.Tptr( Sil.Tvar (Sil.TN_typedef name), _) -> Mangled.to_string name | Sil.Tptr( Sil.Tvar (Sil.TN_typedef name), _) -> Mangled.to_string name
| Sil.Tptr( Sil.Tvar (Sil.TN_csu (_, name)), _) -> Mangled.to_string name | Sil.Tptr( Sil.Tvar (Sil.TN_csu (_, name)), _) -> Mangled.to_string name
| _ -> 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 qt = let tp =
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 qt -> qt | `Class tp -> tp
| _ -> expr_info.Clang_ast_t.ei_qual_type in | _ -> expr_info.Clang_ast_t.ei_type_ptr in
qual_type_to_sil_type tenv qt type_ptr_to_sil_type tenv tp
let get_type_curr_class tenv curr_class_opt = let get_type_curr_class tenv curr_class_opt =
let name = CContext.get_curr_class_name curr_class_opt in let name = CContext.get_curr_class_name curr_class_opt in

@ -23,9 +23,9 @@ val add_types_from_decl_to_tenv : Sil.tenv -> string option -> Clang_ast_t.decl
(* and Class, which is a pointer to objc_class. *) (* and Class, which is a pointer to objc_class. *)
val add_predefined_types : Sil.tenv -> unit val add_predefined_types : Sil.tenv -> unit
val qual_type_to_sil_type : Sil.tenv -> Clang_ast_t.qual_type -> Sil.typ val type_ptr_to_sil_type : Sil.tenv -> Clang_ast_t.type_ptr -> Sil.typ
val class_from_pointer_type : Sil.tenv -> Clang_ast_t.qual_type -> string val class_from_pointer_type : Sil.tenv -> Clang_ast_t.type_ptr -> string
val get_class_type_np : Sil.tenv -> Clang_ast_t.expr_info -> val get_class_type_np : Sil.tenv -> Clang_ast_t.expr_info ->
Clang_ast_t.obj_c_message_expr_info -> Sil.typ Clang_ast_t.obj_c_message_expr_info -> Sil.typ

@ -17,7 +17,7 @@ module L = Logging
(* For a variable declaration it return/construct the type *) (* For a variable declaration it return/construct the type *)
let get_var_type tenv name t = let get_var_type tenv name t =
let typ = CTypes_decl.qual_type_to_sil_type tenv t in let typ = CTypes_decl.type_ptr_to_sil_type tenv t in
Printing.log_out " Getting/Defining type for variable '%s'" name; Printing.log_out " Getting/Defining type for variable '%s'" name;
Printing.log_out " as sil type '%s'\n" (Sil.typ_to_string typ); Printing.log_out " as sil type '%s'\n" (Sil.typ_to_string typ);
typ typ
@ -144,10 +144,10 @@ and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit =
let do_one_decl decl = let do_one_decl decl =
let open Clang_ast_t in let open Clang_ast_t in
match decl with match decl with
| VarDecl (decl_info, name_info, qual_type, var_decl_info) -> | VarDecl (decl_info, name_info, type_ptr, var_decl_info) ->
Printing.log_out "Collecting variables, passing from VarDecl '%s'\n" decl_info.Clang_ast_t.di_pointer; Printing.log_out "Collecting variables, passing from VarDecl '%s'\n" decl_info.Clang_ast_t.di_pointer;
let name = name_info.Clang_ast_t.ni_name in let name = name_info.Clang_ast_t.ni_name in
let typ = get_var_type context.CContext.tenv name qual_type in let typ = get_var_type context.CContext.tenv name type_ptr in
(match var_decl_info.Clang_ast_t.vdi_storage_class with (match var_decl_info.Clang_ast_t.vdi_storage_class with
| Some "static" -> | Some "static" ->
let pname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in let pname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in

@ -13,5 +13,5 @@
val get_fun_locals : CContext.t -> Clang_ast_t.stmt list -> unit val get_fun_locals : CContext.t -> Clang_ast_t.stmt list -> unit
val global_var_decl : Sil.tenv -> string option -> Clang_ast_t.decl_info -> string -> val global_var_decl : Sil.tenv -> string option -> Clang_ast_t.decl_info -> string ->
Clang_ast_t.qual_type -> unit Clang_ast_t.type_ptr -> unit

@ -26,8 +26,8 @@ type prop_getter_setter = string * (Clang_ast_t.decl * bool) option
(** For each property, we save the getter and the setter method declarations (no implementation). *) (** For each property, we save the getter and the setter method declarations (no implementation). *)
(** A property type is a tuple: *) (** A property type is a tuple: *)
(** (qual_type, property attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar name) *) (** (type_ptr, property attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar name) *)
type property_type = Clang_ast_t.qual_type * Clang_ast_t.property_attribute list * type property_type = Clang_ast_t.type_ptr * Clang_ast_t.property_attribute list *
Clang_ast_t.decl_info * prop_getter_setter * prop_getter_setter * Clang_ast_t.decl_info * prop_getter_setter * prop_getter_setter *
Clang_ast_t.named_decl_info option Clang_ast_t.named_decl_info option
@ -54,7 +54,7 @@ sig
val replace_property : property_key -> property_type -> unit val replace_property : property_key -> property_type -> unit
val add_property : property_key -> Clang_ast_t.qual_type -> Clang_ast_t.property_attribute list -> val add_property : property_key -> Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list ->
Clang_ast_t.decl_info -> unit Clang_ast_t.decl_info -> unit
val print_property_table : unit -> unit val print_property_table : unit -> unit
@ -121,7 +121,7 @@ struct
PropertyTableHash.replace property_table property PropertyTableHash.replace property_table property
let print_property_table () = let print_property_table () =
let print_item key (qt, attributes, decl_info, getter, setter, ivar) = let print_item key (tp, attributes, decl_info, getter, setter, ivar) =
let getter_str = let getter_str =
match getter with match getter with
| getter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined1) -> | getter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined1) ->
@ -153,12 +153,12 @@ struct
| Some name -> name.Clang_ast_t.ni_name | Some name -> name.Clang_ast_t.ni_name
| None -> "set" ^ (String.capitalize prop_name.ni_name) ^ ":" | None -> "set" ^ (String.capitalize prop_name.ni_name) ^ ":"
let add_property (curr_class, property_name) qt attributes decl_info = let add_property (curr_class, property_name) tp attributes decl_info =
let key = (curr_class, property_name) in let key = (curr_class, property_name) in
let getter_name = get_getter_name property_name attributes in let getter_name = get_getter_name property_name attributes in
let setter_name = get_setter_name property_name attributes in let setter_name = get_setter_name property_name attributes in
PropertyTableHash.add property_table key PropertyTableHash.add property_table key
(qt, attributes, decl_info, (getter_name, None), (setter_name, None), None) (tp, attributes, decl_info, (getter_name, None), (setter_name, None), None)
end end
let reset_property_table = Property.reset_property_table let reset_property_table = Property.reset_property_table
@ -181,14 +181,14 @@ let upgrade_property_accessor property_key property_type meth_decl new_defined i
| Some (method_decl, was_defined) -> new_defined || was_defined | Some (method_decl, was_defined) -> new_defined || was_defined
| None -> new_defined in | None -> new_defined in
match property_type with match property_type with
| qt, attributes, decl_info, (gname, getter), (sname, setter), ivar -> | tp, attributes, decl_info, (gname, getter), (sname, setter), ivar ->
if is_getter then if is_getter then
let defined = is_defined getter in let defined = is_defined getter in
Property.replace_property property_key Property.replace_property property_key
(qt, attributes, decl_info, (gname, Some (meth_decl, defined)), (sname, setter), ivar) (tp, attributes, decl_info, (gname, Some (meth_decl, defined)), (sname, setter), ivar)
else let defined = is_defined setter in else let defined = is_defined setter in
Property.replace_property property_key Property.replace_property property_key
(qt, attributes, decl_info, (gname, getter), (sname, Some (meth_decl, defined)), ivar) (tp, attributes, decl_info, (gname, getter), (sname, Some (meth_decl, defined)), ivar)
let check_for_property curr_class method_name meth_decl body = let check_for_property curr_class method_name meth_decl body =
let defined = Option.is_some body in let defined = Option.is_some body in
@ -224,26 +224,26 @@ let prepare_dynamic_property curr_class decl_info property_impl_decl_info =
let pname = Ast_utils.property_name property_impl_decl_info in let pname = Ast_utils.property_name property_impl_decl_info in
let prop_name = pname.Clang_ast_t.ni_name in let prop_name = pname.Clang_ast_t.ni_name in
let res = (try let res = (try
let qt', atts, di, getter, setter, _ = Property.find_property curr_class pname in let tp', atts, di, getter, setter, _ = Property.find_property curr_class pname in
let ivar = (match property_impl_decl_info.Clang_ast_t.opidi_ivar_decl with let ivar = (match property_impl_decl_info.Clang_ast_t.opidi_ivar_decl with
| Some dr -> (match dr.Clang_ast_t.dr_name with | Some dr -> (match dr.Clang_ast_t.dr_name with
| Some name_info -> name_info | Some name_info -> name_info
| None -> assert false) | None -> assert false)
| None -> Ast_utils.generated_ivar_name pname) in | None -> Ast_utils.generated_ivar_name pname) in
(* update property info with proper ivar name *) (* update property info with proper ivar name *)
Property.replace_property (curr_class, pname) (qt', atts, di, getter, setter, Some ivar); Property.replace_property (curr_class, pname) (tp', atts, di, getter, setter, Some ivar);
Printing.log_out "Updated property table by adding ivar name for property '%s'\n" Printing.log_out "Updated property table by adding ivar name for property '%s'\n"
prop_name; prop_name;
Some (qt', ivar) Some (tp', ivar)
with Not_found -> with Not_found ->
L.err "Property '%s' not found in the table. Ivar not updated.@." prop_name; L.err "Property '%s' not found in the table. Ivar not updated.@." prop_name;
None) in None) in
match property_impl_decl_info.Clang_ast_t.opidi_implementation, res with match property_impl_decl_info.Clang_ast_t.opidi_implementation, res with
| `Dynamic, Some (qt, ivar) -> | `Dynamic, Some (tp, ivar) ->
(* For Dynamic property we need to create the ObjCIvarDecl which specifies*) (* For Dynamic property we need to create the ObjCIvarDecl which specifies*)
(* the field of the property. In case of Dynamic this is not in the AST.*) (* the field of the property. In case of Dynamic this is not in the AST.*)
(* Once created the ObjCIvarDecl then we treat the property as synthesized *) (* Once created the ObjCIvarDecl then we treat the property as synthesized *)
[Ast_expressions.make_objc_ivar_decl decl_info qt property_impl_decl_info ivar] [Ast_expressions.make_objc_ivar_decl decl_info tp property_impl_decl_info ivar]
| _ -> | _ ->
(* No names of fields/method to collect from ObjCPropertyImplDecl when Synthesized *) (* No names of fields/method to collect from ObjCPropertyImplDecl when Synthesized *)
[] []
@ -270,7 +270,7 @@ let get_ivar_name prop_name ivar_opt =
let make_getter curr_class prop_name prop_type = let make_getter curr_class prop_name prop_type =
match prop_type with match prop_type with
| qt, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt -> | tp, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt ->
let ivar_name = get_ivar_name prop_name ivar_opt in let ivar_name = get_ivar_name prop_name ivar_opt in
let open Clang_ast_t in let open Clang_ast_t in
match getter with match getter with
@ -284,44 +284,44 @@ let make_getter curr_class prop_name prop_type =
let generated_name_info = create_generated_method_name name_info in let generated_name_info = create_generated_method_name name_info in
Property.replace_property Property.replace_property
(curr_class, prop_name) (curr_class, prop_name)
(qt, attributes, decl_info, (tp, attributes, decl_info,
(getter_name, Some (ObjCMethodDecl(di, name_info, mdi), true)), (setter_name, setter), Some ivar_name); (getter_name, Some (ObjCMethodDecl(di, name_info, mdi), true)), (setter_name, setter), Some ivar_name);
[ObjCMethodDecl(dummy_info, generated_name_info, mdi')] [ObjCMethodDecl(dummy_info, generated_name_info, mdi')]
| _ -> [] | _ -> []
let make_setter curr_class prop_name prop_type = let make_setter curr_class prop_name prop_type =
match prop_type with match prop_type with
| qt, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt -> | tp, attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar_opt ->
let ivar_name = get_ivar_name prop_name ivar_opt in let ivar_name = get_ivar_name prop_name ivar_opt in
let open Clang_ast_t in let open Clang_ast_t in
match setter with match setter with
| Some (ObjCMethodDecl(di, name, mdi), _) when not (is_property_read_only attributes) -> | Some (ObjCMethodDecl(di, name, mdi), _) when not (is_property_read_only attributes) ->
let dummy_info = Ast_expressions.dummy_decl_info_in_curr_file di in let dummy_info = Ast_expressions.dummy_decl_info_in_curr_file di in
let param_name, qt_param = (match mdi.Clang_ast_t.omdi_parameters with let param_name, tp_param = (match mdi.Clang_ast_t.omdi_parameters with
| [ParmVarDecl(_, name_info, qt_param, _)] -> name_info, qt_param | [ParmVarDecl(_, name_info, tp_param, _)] -> name_info, tp_param
| _ -> assert false) in | _ -> assert false) in
let is_hidden = false in let is_hidden = false in
let decl_ptr = Ast_utils.get_invalid_pointer () in let decl_ptr = Ast_utils.get_invalid_pointer () in
let drti_decl_ref' = let drti_decl_ref' =
Ast_expressions.make_decl_ref_qt (`ParmVar) decl_ptr param_name is_hidden qt_param in Ast_expressions.make_decl_ref_tp (`ParmVar) decl_ptr param_name is_hidden tp_param in
let decl_ref_expr_info' = Ast_expressions.make_decl_ref_expr_info drti_decl_ref' in let decl_ref_expr_info' = Ast_expressions.make_decl_ref_expr_info drti_decl_ref' in
let expr_info = Ast_expressions.make_expr_info qt_param in let expr_info = Ast_expressions.make_expr_info tp_param in
let stmt_info = Ast_expressions.make_stmt_info dummy_info in let stmt_info = Ast_expressions.make_stmt_info dummy_info in
let rhs_exp = Ast_expressions.make_cast_expr qt_param di decl_ref_expr_info' `ObjCProperty in let rhs_exp = Ast_expressions.make_cast_expr tp_param di decl_ref_expr_info' `ObjCProperty in
let lhs_exp = Ast_expressions.make_self_field let lhs_exp = Ast_expressions.make_self_field
(CContext.get_curr_class_name curr_class) di qt_param ivar_name in (CContext.get_curr_class_name curr_class) di tp_param ivar_name in
let boi = { Clang_ast_t.boi_kind = `Assign } in let boi = { Clang_ast_t.boi_kind = `Assign } in
let setter = Ast_expressions.make_binary_stmt lhs_exp rhs_exp stmt_info expr_info boi in let setter = Ast_expressions.make_binary_stmt lhs_exp rhs_exp stmt_info expr_info boi in
let memory_management_attribute = (get_memory_management_attribute attributes) in let memory_management_attribute = (get_memory_management_attribute attributes) in
let code = let code =
if Ast_utils.is_retain memory_management_attribute then if Ast_utils.is_retain memory_management_attribute then
let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, qt_param, decl_ptr) `ParmVar stmt_info in let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, tp_param, decl_ptr) `ParmVar stmt_info in
let retain_call = Ast_expressions.make_message_expr qt_param CFrontend_config.retain param_decl stmt_info true in let retain_call = Ast_expressions.make_message_expr tp_param CFrontend_config.retain param_decl stmt_info true in
let release_call = Ast_expressions.make_message_expr qt_param CFrontend_config.release lhs_exp stmt_info true in let release_call = Ast_expressions.make_message_expr tp_param CFrontend_config.release lhs_exp stmt_info true in
[retain_call; release_call; setter] [retain_call; release_call; setter]
else if Ast_utils.is_copy memory_management_attribute then else if Ast_utils.is_copy memory_management_attribute then
let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, qt_param, decl_ptr) `ParmVar stmt_info in let param_decl = Ast_expressions.make_decl_ref_exp_var (param_name, tp_param, decl_ptr) `ParmVar stmt_info in
let copy_call = Ast_expressions.make_message_expr qt_param CFrontend_config.copy param_decl stmt_info true in let copy_call = Ast_expressions.make_message_expr tp_param CFrontend_config.copy param_decl stmt_info true in
let setter = Ast_expressions.make_binary_stmt lhs_exp copy_call stmt_info expr_info boi in let setter = Ast_expressions.make_binary_stmt lhs_exp copy_call stmt_info expr_info boi in
[setter] [setter]
else [setter] in else [setter] in
@ -330,7 +330,7 @@ let make_setter curr_class prop_name prop_type =
let name_generated = create_generated_method_name name in let name_generated = create_generated_method_name name in
Property.replace_property Property.replace_property
(curr_class, prop_name) (curr_class, prop_name)
(qt, attributes, decl_info, (tp, attributes, decl_info,
(getter_name, getter), (getter_name, getter),
(setter_name, Some (ObjCMethodDecl(di, name, mdi), true)), Some ivar_name); (setter_name, Some (ObjCMethodDecl(di, name, mdi), true)), Some ivar_name);
[ObjCMethodDecl(dummy_info, name_generated, mdi')] [ObjCMethodDecl(dummy_info, name_generated, mdi')]
@ -362,7 +362,7 @@ let add_properties_to_table curr_class decl_list =
let pname = name_info.Clang_ast_t.ni_name in let pname = name_info.Clang_ast_t.ni_name in
Printing.log_out "ADDING: ObjCPropertyDecl for property '%s' " pname; Printing.log_out "ADDING: ObjCPropertyDecl for property '%s' " pname;
Printing.log_out " pointer= '%s' \n" decl_info.Clang_ast_t.di_pointer; Printing.log_out " pointer= '%s' \n" decl_info.Clang_ast_t.di_pointer;
Property.add_property (curr_class, name_info) pdi.Clang_ast_t.opdi_qual_type Property.add_property (curr_class, name_info) pdi.Clang_ast_t.opdi_type_ptr
pdi.Clang_ast_t.opdi_property_attributes decl_info; pdi.Clang_ast_t.opdi_property_attributes decl_info;
| _ -> () in | _ -> () in
list_iter add_property_to_table decl_list list_iter add_property_to_table decl_list

@ -11,8 +11,8 @@ type prop_getter_setter = string * (Clang_ast_t.decl * bool) option
(** For each property, we save the getter and the setter method declarations (no implementation). *) (** For each property, we save the getter and the setter method declarations (no implementation). *)
(** A property type is a tuple: *) (** A property type is a tuple: *)
(** (qual_type, property attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar name ) *) (** (type_ptr, property attributes, decl_info, (getter_name, getter), (setter_name, setter), ivar name ) *)
type property_type = Clang_ast_t.qual_type * Clang_ast_t.property_attribute list * type property_type = Clang_ast_t.type_ptr * Clang_ast_t.property_attribute list *
Clang_ast_t.decl_info * prop_getter_setter * prop_getter_setter * Clang_ast_t.decl_info * prop_getter_setter * prop_getter_setter *
Clang_ast_t.named_decl_info option Clang_ast_t.named_decl_info option
@ -36,7 +36,7 @@ sig
val replace_property : property_key -> property_type -> unit val replace_property : property_key -> property_type -> unit
val add_property : property_key -> Clang_ast_t.qual_type -> Clang_ast_t.property_attribute list -> val add_property : property_key -> Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list ->
Clang_ast_t.decl_info -> unit Clang_ast_t.decl_info -> unit
val print_property_table : unit -> unit val print_property_table : unit -> unit

Loading…
Cancel
Save