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

[clang] unopen some modules

Browse Source 
Summary:
Use local open instead of open for modules, except utility ones.
master
Jules Villard 9 years ago
parent 4a55382345
commit cc70507552
19 changed files with 776 additions and 710 deletions
Show Stats Download Patch File Download Diff File

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

@ -7,86 +7,81 @@
* 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.
*) *)
open Clang_ast_t
open CFrontend_utils open CFrontend_utils
(** This module creates extra ast constructs that are needed for the translation *) (** This module creates extra ast constructs that are needed for the translation *)
let dummy_source_range () = let dummy_source_range () =
let dummy_source_loc = { let dummy_source_loc = {
sl_file = None; Clang_ast_t.sl_file = None;
sl_line = None; sl_line = None;
sl_column = None sl_column = None;
} in } in
(dummy_source_loc, dummy_source_loc) (dummy_source_loc, dummy_source_loc)
let dummy_stmt_info () = let dummy_stmt_info () = {
{
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer (); Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = dummy_source_range () si_source_range = dummy_source_range ();
} }
(* given a stmt_info return the same stmt_info with a fresh pointer *) (* given a stmt_info return the same stmt_info with a fresh pointer *)
let fresh_stmt_info stmt_info = let fresh_stmt_info stmt_info =
{ stmt_info with Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer () } { stmt_info with Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer () }
let dummy_decl_info decl_info = let dummy_decl_info decl_info = {
{
decl_info with decl_info with
Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer (); Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.di_source_range = dummy_source_range (); di_source_range = dummy_source_range ();
} }
let dummy_decl_info_in_curr_file decl_info = let dummy_decl_info_in_curr_file decl_info =
let source_loc = { let source_loc = {
sl_file = Some (DB.source_file_to_abs_path !CLocation.current_source_file); Clang_ast_t.sl_file = Some (DB.source_file_to_abs_path !CLocation.current_source_file);
sl_line = None; sl_line = None;
sl_column = None sl_column = None;
} in { } in {
decl_info with decl_info with
Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer (); Clang_ast_t.di_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.di_source_range = di_source_range =
if !CFrontend_config.testing_mode then if !CFrontend_config.testing_mode then
decl_info.Clang_ast_t.di_source_range decl_info.Clang_ast_t.di_source_range
else (source_loc, source_loc) else (source_loc, source_loc);
} }
let empty_decl_info = { let empty_decl_info = {
Clang_ast_t.di_pointer = ""; Clang_ast_t.di_pointer = "";
Clang_ast_t.di_parent_pointer = None; di_parent_pointer = None;
Clang_ast_t.di_previous_decl = `None; di_previous_decl = `None;
Clang_ast_t.di_source_range = dummy_source_range (); di_source_range = dummy_source_range ();
Clang_ast_t.di_owning_module = None; di_owning_module = None;
Clang_ast_t.di_is_hidden = false; di_is_hidden = false;
Clang_ast_t.di_is_implicit = false; di_is_implicit = false;
Clang_ast_t.di_is_used = true; di_is_used = true;
Clang_ast_t.di_is_this_declaration_referenced = true; di_is_this_declaration_referenced = true;
Clang_ast_t.di_is_invalid_decl = false; di_is_invalid_decl = false;
Clang_ast_t.di_attributes = []; di_attributes = [];
Clang_ast_t.di_full_comment = None; di_full_comment = None;
} }
let empty_var_decl_info = { let empty_var_decl_info = {
Clang_ast_t.vdi_storage_class = None; Clang_ast_t.vdi_storage_class = None;
Clang_ast_t.vdi_tls_kind =`Tls_none; vdi_tls_kind =`Tls_none;
Clang_ast_t.vdi_is_module_private = false; vdi_is_module_private = false;
Clang_ast_t.vdi_is_nrvo_variable = false; vdi_is_nrvo_variable = false;
Clang_ast_t.vdi_init_expr = None; vdi_init_expr = None;
} }
let stmt_info_with_fresh_pointer stmt_info = let stmt_info_with_fresh_pointer stmt_info = {
{
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer (); Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = stmt_info.si_source_range si_source_range = stmt_info.Clang_ast_t.si_source_range;
} }
let create_qual_type s = let create_qual_type s = {
{
Clang_ast_t.qt_raw = s; Clang_ast_t.qt_raw = s;
Clang_ast_t.qt_desugared = Some s; qt_desugared = Some s;
(* pointer needs to be set when we start using these, non trivial to do though *) (* pointer needs to be set when we start using these, non trivial to do though *)
Clang_ast_t.qt_type_ptr = Ast_utils.get_invalid_pointer () qt_type_ptr = Ast_utils.get_invalid_pointer ();
} }
let create_pointer_type s = let create_pointer_type s =
create_qual_type (s^" *") create_qual_type (s^" *")
@ -100,7 +95,11 @@ let create_id_type () = create_qual_type "id"
let create_char_type () = create_qual_type "char *" let create_char_type () = create_qual_type "char *"
(* pointer needs to be set when we start using these, non trivial to do though *) (* pointer needs to be set when we start using these, non trivial to do though *)
let create_BOOL_type () = { qt_raw = "BOOL"; qt_desugared = Some("signed char"); qt_type_ptr = Ast_utils.get_invalid_pointer () } let create_BOOL_type () = {
Clang_ast_t.qt_raw = "BOOL";
qt_desugared = Some ("signed char");
qt_type_ptr = Ast_utils.get_invalid_pointer ();
}
let create_void_unsigned_long_type () = create_qual_type "void *(unsigned long)" let create_void_unsigned_long_type () = create_qual_type "void *(unsigned long)"
@ -112,47 +111,47 @@ 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_qual_type = create_int_type ();
Clang_ast_t.ei_value_kind = `RValue; ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary ei_object_kind = `Ordinary;
} in } in
let integer_literal_info = { let integer_literal_info = {
Clang_ast_t.ili_is_signed = true; Clang_ast_t.ili_is_signed = true;
Clang_ast_t.ili_bitwidth = 32; ili_bitwidth = 32;
Clang_ast_t.ili_value = n ili_value = n;
} in } in
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 qt =
let expr_info = { let expr_info = {
Clang_ast_t.ei_qual_type = create_void_type (); Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `RValue; ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary ei_object_kind = `Ordinary;
} in } in
let cast_expr = { let cast_expr = {
Clang_ast_t.cei_cast_kind = `NullToPointer; Clang_ast_t.cei_cast_kind = `NullToPointer;
Clang_ast_t.cei_base_path = [] cei_base_path = [];
} in } in
CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, qt) Clang_ast_t.CStyleCastExpr (stmt_info, stmts, expr_info, cast_expr, qt)
let create_parent_expr stmt_info stmts = let create_parent_expr stmt_info stmts =
let expr_info = { let expr_info = {
Clang_ast_t.ei_qual_type = create_void_type (); Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `RValue; ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary ei_object_kind = `Ordinary;
} in } in
ParenExpr (stmt_info, stmts, expr_info) Clang_ast_t.ParenExpr (stmt_info, stmts, expr_info)
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_qual_type = typ;
Clang_ast_t.ei_value_kind = `RValue; ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary ei_object_kind = `Ordinary;
} in } in
let cast_expr_info = { let cast_expr_info = {
Clang_ast_t.cei_cast_kind = cast_kind; Clang_ast_t.cei_cast_kind = cast_kind;
Clang_ast_t.cei_base_path = [] cei_base_path = [];
} in } in
ImplicitCastExpr (stmt_info, stmts, expr_info, cast_expr_info) Clang_ast_t.ImplicitCastExpr (stmt_info, stmts, expr_info, cast_expr_info)
let create_nil stmt_info = let create_nil stmt_info =
let integer_literal = create_integer_literal stmt_info "0" in let integer_literal = create_integer_literal stmt_info "0" in
@ -164,15 +163,18 @@ let create_nil stmt_info =
let dummy_stmt () = let dummy_stmt () =
let pointer = Ast_utils.get_fresh_pointer () in let pointer = Ast_utils.get_fresh_pointer () in
let source_range = dummy_source_range () in let source_range = dummy_source_range () in
NullStmt({ Clang_ast_t.si_pointer = pointer; Clang_ast_t.si_source_range = source_range } ,[]) Clang_ast_t.NullStmt({ Clang_ast_t.si_pointer = pointer; si_source_range = source_range } ,[])
let make_stmt_info di = let make_stmt_info di = {
{ Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer; Clang_ast_t.si_source_range = di.Clang_ast_t.di_source_range } Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range;
}
let make_expr_info qt vk objc_kind = { let make_expr_info qt vk objc_kind = {
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = vk; ei_value_kind = vk;
Clang_ast_t.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 qt objc_kind =
make_expr_info qt `LValue objc_kind make_expr_info qt `LValue objc_kind
@ -180,47 +182,41 @@ let make_expr_info_with_objc_kind qt objc_kind =
let make_lvalue_obc_prop_expr_info qt = let make_lvalue_obc_prop_expr_info qt =
make_expr_info qt `LValue `ObjCProperty make_expr_info qt `LValue `ObjCProperty
let make_method_decl_info mdi body = { let make_method_decl_info mdi body =
Clang_ast_t.omdi_is_instance_method = mdi.Clang_ast_t.omdi_is_instance_method; { mdi with Clang_ast_t.omdi_body = Some body; }
Clang_ast_t.omdi_result_type = mdi.Clang_ast_t.omdi_result_type;
Clang_ast_t.omdi_parameters = mdi.Clang_ast_t.omdi_parameters;
Clang_ast_t.omdi_is_variadic = mdi.Clang_ast_t.omdi_is_variadic;
Clang_ast_t.omdi_body = Some body; }
let make_decl_ref_exp stmt_info expr_info drei = let make_decl_ref_exp stmt_info expr_info drei =
let stmt_info = { let stmt_info = {
Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer (); Clang_ast_t.si_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.si_source_range = stmt_info.Clang_ast_t.si_source_range si_source_range = stmt_info.Clang_ast_t.si_source_range
} in } in
DeclRefExpr(stmt_info, [], expr_info, drei) Clang_ast_t.DeclRefExpr(stmt_info, [], expr_info, drei)
let make_obj_c_message_expr_info_instance sel = let make_obj_c_message_expr_info_instance sel = {
{
Clang_ast_t.omei_selector = sel; Clang_ast_t.omei_selector = sel;
Clang_ast_t.omei_receiver_kind = `Instance; omei_receiver_kind = `Instance;
Clang_ast_t.omei_is_definition_found = false; omei_is_definition_found = false;
Clang_ast_t.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 qt = {
{ Clang_ast_t.omei_selector = selector;
omei_selector = selector;
omei_receiver_kind = `Class (create_qual_type qt); omei_receiver_kind = `Class (create_qual_type qt);
Clang_ast_t.omei_is_definition_found = false; omei_is_definition_found = false;
Clang_ast_t.omei_decl_pointer = None (* TODO look into it *) omei_decl_pointer = None (* TODO look into it *)
} }
let make_name_decl name = { let make_name_decl name = {
Clang_ast_t.ni_name = name; Clang_ast_t.ni_name = name;
Clang_ast_t.ni_qual_name = [name]; ni_qual_name = [name];
} }
let make_decl_ref k decl_ptr name is_hidden qt_opt = { let make_decl_ref k decl_ptr name is_hidden qt_opt = {
Clang_ast_t.dr_kind = k; Clang_ast_t.dr_kind = k;
Clang_ast_t.dr_decl_pointer = decl_ptr; dr_decl_pointer = decl_ptr;
Clang_ast_t.dr_name = Some (make_name_decl name); dr_name = Some (make_name_decl name);
Clang_ast_t.dr_is_hidden = is_hidden ; dr_is_hidden = is_hidden ;
Clang_ast_t.dr_qual_type = qt_opt dr_qual_type = qt_opt
} }
let make_decl_ref_qt k decl_ptr name is_hidden qt = let make_decl_ref_qt k decl_ptr name is_hidden qt =
@ -234,21 +230,21 @@ let make_decl_ref_invalid k name is_hidden qt =
let make_decl_ref_self ptr qt = { let make_decl_ref_self ptr qt = {
Clang_ast_t.dr_kind = `ImplicitParam; Clang_ast_t.dr_kind = `ImplicitParam;
Clang_ast_t.dr_decl_pointer = ptr; dr_decl_pointer = ptr;
Clang_ast_t.dr_name = Some (make_name_decl "self"); dr_name = Some (make_name_decl "self");
Clang_ast_t.dr_is_hidden = false ; dr_is_hidden = false ;
Clang_ast_t.dr_qual_type = Some qt dr_qual_type = Some qt
} }
let make_decl_ref_expr_info decl_ref = { let make_decl_ref_expr_info decl_ref = {
Clang_ast_t.drti_decl_ref = Some decl_ref; Clang_ast_t.drti_decl_ref = Some decl_ref;
Clang_ast_t.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 qt = {
Clang_ast_t.ovrei_decl_ref = make_decl_ref_qt k ptr n false qt; Clang_ast_t.ovrei_decl_ref = make_decl_ref_qt k ptr n false qt;
Clang_ast_t.ovrei_pointer = Ast_utils.get_fresh_pointer (); ovrei_pointer = Ast_utils.get_fresh_pointer ();
Clang_ast_t.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 *)
@ -258,9 +254,10 @@ let make_cast_expr qt di decl_ref_expr_info objc_kind =
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 = {
Clang_ast_t.cei_cast_kind = `LValueToRValue; Clang_ast_t.cei_cast_kind = `LValueToRValue;
Clang_ast_t.cei_base_path = [] cei_base_path = [];
} in } in
let cast_exp_rhs = ImplicitCastExpr(stmt_info, [decl_ref_exp], expr_info, cast_expr) in let cast_exp_rhs =
Clang_ast_t.ImplicitCastExpr(stmt_info, [decl_ref_exp], expr_info, cast_expr) in
cast_exp_rhs cast_exp_rhs
(* Build AST expression self.field_name as `LValue *) (* Build AST expression self.field_name as `LValue *)
@ -268,9 +265,10 @@ let make_self_field class_type di qt field_name =
let qt_class = create_qual_type class_type in let qt_class = create_qual_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 qt `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.di_pointer qt_class)) `ObjCProperty 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 obj_c_ivar_ref_expr_info = make_obj_c_ivar_ref_expr_info (`ObjCIvar) di.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 qt in
let ivar_ref_exp = ObjCIvarRefExpr(stmt_info, [cast_exp], expr_info, obj_c_ivar_ref_expr_info) in let ivar_ref_exp =
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. *)
@ -278,42 +276,42 @@ let make_deref_self_field class_decl_opt di qt 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 qt field_name in
let expr_info' = make_expr_info_with_objc_kind qt `ObjCProperty in let expr_info' = make_expr_info_with_objc_kind qt `ObjCProperty in
let cast_exp_info = let cast_exp_info = {
{
Clang_ast_t.cei_cast_kind = `LValueToRValue; Clang_ast_t.cei_cast_kind = `LValueToRValue;
Clang_ast_t.cei_base_path = [] cei_base_path = [];
} in } in
let cast_exp' = ImplicitCastExpr(stmt_info, [ivar_ref_exp], expr_info', cast_exp_info) in let cast_exp' =
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 qt 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;
Clang_ast_t.fldi_is_module_private = true; fldi_is_module_private = true;
Clang_ast_t.fldi_init_expr = None; fldi_init_expr = None;
Clang_ast_t.fldi_bit_width_expr = None } in fldi_bit_width_expr = None;
} in
let obj_c_ivar_decl_info = { let obj_c_ivar_decl_info = {
Clang_ast_t.ovdi_is_synthesize = true; (* NOTE: We set true here because we use this definition to synthesize the getter/setter*) 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_access_control = `Private } in ovdi_access_control = `Private;
ObjCIvarDecl(decl_info, make_name_decl ivar_name, qt, field_decl_info, obj_c_ivar_decl_info) } in
Clang_ast_t.ObjCIvarDecl(decl_info, make_name_decl ivar_name, qt, field_decl_info, obj_c_ivar_decl_info)
let make_expr_info qt = let make_expr_info qt = {
{
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = `LValue; ei_value_kind = `LValue;
Clang_ast_t.ei_object_kind = `ObjCProperty ei_object_kind = `ObjCProperty
} }
let make_general_expr_info qt vk ok = let make_general_expr_info qt vk ok = {
{
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = vk; ei_value_kind = vk;
Clang_ast_t.ei_object_kind = ok ei_object_kind = ok
} }
let make_ObjCBoolLiteralExpr stmt_info value = let make_ObjCBoolLiteralExpr stmt_info value =
let ei = make_expr_info (create_BOOL_type ()) in let ei = make_expr_info (create_BOOL_type ()) in
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_qt, 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
@ -330,28 +328,30 @@ let make_message_expr param_qt selector decl_ref_exp stmt_info add_cast =
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_qt `ObjCProperty in
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 =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in let stmt_info = stmt_info_with_fresh_pointer stmt_info in
CompoundStmt (stmt_info, stmts) Clang_ast_t.CompoundStmt (stmt_info, stmts)
let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi = let make_binary_stmt stmt1 stmt2 stmt_info expr_info boi =
let stmt_info = stmt_info_with_fresh_pointer stmt_info in let stmt_info = stmt_info_with_fresh_pointer stmt_info in
BinaryOperator(stmt_info, [stmt1; stmt2], expr_info, boi) Clang_ast_t.BinaryOperator(stmt_info, [stmt1; stmt2], expr_info, boi)
let make_next_object_exp stmt_info item items = let make_next_object_exp stmt_info item items =
let var_decl_ref, var_type = let var_decl_ref, var_type =
match item with match item with
| DeclStmt (stmt_info, _, [VarDecl(di, name_info, var_type, _)]) -> | Clang_ast_t.DeclStmt (stmt_info, _, [Clang_ast_t.VarDecl(di, name_info, var_type, _)]) ->
let var_name = name_info.Clang_ast_t.ni_name in let var_name = name_info.Clang_ast_t.ni_name in
let decl_ptr = di.Clang_ast_t.di_pointer in let decl_ptr = di.Clang_ast_t.di_pointer in
let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type in let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type in
let stmt_info_var = { let stmt_info_var = {
si_pointer = di.Clang_ast_t.di_pointer; Clang_ast_t.si_pointer = di.Clang_ast_t.di_pointer;
si_source_range = di.Clang_ast_t.di_source_range si_source_range = di.Clang_ast_t.di_source_range
} in } in
DeclRefExpr(stmt_info_var, [], (make_expr_info_with_objc_kind var_type `ObjCProperty), (make_decl_ref_expr_info decl_ref)), let expr_info = make_expr_info_with_objc_kind var_type `ObjCProperty in
let decl_ref_expr_info = make_decl_ref_expr_info decl_ref in
Clang_ast_t.DeclRefExpr (stmt_info_var, [], expr_info, decl_ref_expr_info),
var_type var_type
| _ -> assert false in | _ -> assert false in
let message_call = make_message_expr (create_qual_type CFrontend_config.id_cl) let message_call = make_message_expr (create_qual_type CFrontend_config.id_cl)
@ -360,11 +360,11 @@ let make_next_object_exp stmt_info item items =
make_binary_stmt var_decl_ref message_call stmt_info (make_expr_info_with_objc_kind var_type `ObjCProperty) boi make_binary_stmt var_decl_ref message_call stmt_info (make_expr_info_with_objc_kind var_type `ObjCProperty) boi
let empty_var_decl = { let empty_var_decl = {
vdi_storage_class = None; Clang_ast_t.vdi_storage_class = None;
vdi_tls_kind =`Tls_none; vdi_tls_kind =`Tls_none;
vdi_is_module_private = false; vdi_is_module_private = false;
vdi_is_nrvo_variable = false; vdi_is_nrvo_variable = false;
vdi_init_expr = None vdi_init_expr = None;
} }
(* dispatch_once(v,block_def) is transformed as: *) (* dispatch_once(v,block_def) is transformed as: *)
@ -374,9 +374,10 @@ let translate_dispatch_function block_name stmt_info stmt_list ei n =
try Utils.list_nth stmt_list (n + 1) try Utils.list_nth stmt_list (n + 1)
with Not_found -> assert false in with Not_found -> assert false in
let block_name_info = make_name_decl block_name in let block_name_info = make_name_decl block_name 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.Clang_ast_t.ei_qual_type in let qt = bei.ei_qual_type 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
@ -403,12 +404,13 @@ let make_DeclStmt stmt_info di qt vname iexp =
let ie = create_implicit_cast_expr stmt_info [iexp'] qt `IntegralCast in let ie = create_implicit_cast_expr stmt_info [iexp'] qt `IntegralCast in
Some ie, [ie] Some ie, [ie]
| None -> None, [] in | None -> None, [] in
let var_decl = VarDecl(di, vname, qt, { 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
DeclStmt(stmt_info, init_expr_l, [var_decl]) let var_decl = Clang_ast_t.VarDecl (di, vname, qt, var_decl_info) in
Clang_ast_t.DeclStmt (stmt_info, init_expr_l, [var_decl])
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
OpaqueValueExpr(si, [], ei, opaque_value_expr_info) Clang_ast_t.OpaqueValueExpr (si, [], ei, opaque_value_expr_info)
let pseudo_object_qt () = let pseudo_object_qt () =
create_qual_type CFrontend_config.pseudo_object_type create_qual_type CFrontend_config.pseudo_object_type
@ -416,34 +418,34 @@ let pseudo_object_qt () =
(* 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 qt_m o_cast_decl_ref_exp mname =
match o_cast_decl_ref_exp with match o_cast_decl_ref_exp with
| 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_qt ()) 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 si.si_pointer CFrontend_config.count false); `PropertyRef (make_decl_ref_no_qt `ObjCProperty si.Clang_ast_t.si_pointer CFrontend_config.count false);
Clang_ast_t.oprei_is_super_receiver = false; oprei_is_super_receiver = false;
Clang_ast_t.oprei_is_messaging_getter = true; oprei_is_messaging_getter = true;
Clang_ast_t.oprei_is_messaging_setter = false; oprei_is_messaging_setter = false;
} in } in
let opre = 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 qt_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 qt_m `LValue `Ordinary in
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 qt parameters =
let expr_info_call = { let expr_info_call = {
Clang_ast_t.ei_qual_type = create_void_type (); Clang_ast_t.ei_qual_type = create_void_type ();
Clang_ast_t.ei_value_kind = `XValue; ei_value_kind = `XValue;
Clang_ast_t.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 qt `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in
let decl_ref_info = make_decl_ref_expr_info decl_ref in let decl_ref_info = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = 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] qt `FunctionToPointerDecay in
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 *)
(* [a enumerateObjectsUsingBlock:^(id object, NSUInteger idx, BOOL * stop) { *) (* [a enumerateObjectsUsingBlock:^(id object, NSUInteger idx, BOOL * stop) { *)
@ -472,18 +474,18 @@ 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
| [] -> [] | [] -> []
| ParmVarDecl(di, name, qt, _):: lp' -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) :: 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, qt):: 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
| ParmVarDecl(di_idx, name_idx, qt_idx, _) -> | Clang_ast_t.ParmVarDecl (di_idx, name_idx, qt_idx, _) ->
let zero = create_integer_literal stmt_info "0" in let zero = create_integer_literal stmt_info "0" in
(* qt_idx idx = 0; *) (* qt_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 qt_idx name_idx (Some zero) in
let idx_ei = make_expr_info qt_idx in let idx_ei = make_expr_info qt_idx in
let idx_decl_ref = make_decl_ref_qt `Var di_idx.di_pointer name_idx.Clang_ast_t.ni_name false qt_idx in let idx_decl_ref = make_decl_ref_qt `Var di_idx.Clang_ast_t.di_pointer name_idx.Clang_ast_t.ni_name false qt_idx in
let idx_drei = make_decl_ref_expr_info idx_decl_ref in let idx_drei = make_decl_ref_expr_info idx_decl_ref in
let idx_decl_ref_exp = make_decl_ref_exp stmt_info idx_ei idx_drei in let idx_decl_ref_exp = make_decl_ref_exp stmt_info idx_ei idx_drei in
let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp] qt_idx `LValueToRValue in let idx_cast = create_implicit_cast_expr (fresh_stmt_info stmt_info) [idx_decl_ref_exp] qt_idx `LValueToRValue in
@ -499,12 +501,13 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* 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
| ParmVarDecl(di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let qt_fun = create_void_unsigned_long_type () in let qt_fun = create_void_unsigned_long_type () in
let parameter = UnaryExprOrTypeTraitExpr((fresh_stmt_info stmt_info), [], let parameter = Clang_ast_t.UnaryExprOrTypeTraitExpr
((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 = Some (create_BOOL_type ()) }) in { Clang_ast_t.uttei_kind = `SizeOf; Clang_ast_t.uttei_qual_type = Some (create_BOOL_type ()) }) in
let malloc = create_call (fresh_stmt_info stmt_info) di.di_pointer CFrontend_config.malloc qt_fun [parameter] in let malloc = create_call (fresh_stmt_info stmt_info) di.Clang_ast_t.di_pointer CFrontend_config.malloc qt_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] qt `BitCast in
make_DeclStmt (fresh_stmt_info stmt_info) di qt name (Some init_exp) make_DeclStmt (fresh_stmt_info stmt_info) di qt name (Some init_exp)
| _ -> assert false in | _ -> assert false in
@ -512,44 +515,49 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
(* BOOL *stop =NO; *) (* BOOL *stop =NO; *)
let stop_equal_no pstop = let stop_equal_no pstop =
match pstop with match pstop with
| ParmVarDecl(di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
let cast = cast_expr decl_ref qt in let cast = cast_expr decl_ref qt in
let lhs = UnaryOperator((fresh_stmt_info stmt_info), [cast], ei, { 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 bool_NO = make_ObjCBoolLiteralExpr stmt_info 0 in let bool_NO = make_ObjCBoolLiteralExpr stmt_info 0 in
BinaryOperator((fresh_stmt_info stmt_info), [lhs; bool_NO], ei, { boi_kind = `Assign }) let assign = { Clang_ast_t.boi_kind = `Assign } in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [lhs; bool_NO], ei, assign)
| _ -> assert false in | _ -> assert false in
(* build statement free(stop); *) (* build statement free(stop); *)
let free_stop pstop = let free_stop pstop =
match pstop with match pstop with
| ParmVarDecl(di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let qt_fun = create_void_void_type () in let qt_fun = create_void_void_type () in
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
let cast = cast_expr decl_ref qt in let cast = cast_expr decl_ref qt in
let parameter = let parameter =
create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] (create_void_type ()) `BitCast in create_implicit_cast_expr (fresh_stmt_info stmt_info) [cast] (create_void_type ()) `BitCast in
create_call (fresh_stmt_info stmt_info) di.di_pointer CFrontend_config.free qt_fun [parameter] create_call (fresh_stmt_info stmt_info) di.Clang_ast_t.di_pointer CFrontend_config.free qt_fun [parameter]
| _ -> assert false in | _ -> assert false in
(* idx<a.count *) (* idx<a.count *)
let bin_op pidx array_decl_ref_exp = let bin_op pidx array_decl_ref_exp =
let idx_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_qt = build_idx_decl pidx in
let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in let rhs = build_PseudoObjectExpr idx_qt array_decl_ref_exp CFrontend_config.count in
BinaryOperator((fresh_stmt_info stmt_info), [idx_cast; rhs], make_expr_info (create_int_type ()), { boi_kind = `LT }) in let lt = { Clang_ast_t.boi_kind = `LT } in
Clang_ast_t.BinaryOperator (fresh_stmt_info stmt_info, [idx_cast; rhs], make_expr_info (create_int_type ()), lt) in
(* idx++ *) (* idx++ *)
let un_op idx_decl_ref_expr qt_idx = let un_op idx_decl_ref_expr qt_idx =
let idx_ei = make_expr_info qt_idx in let idx_ei = make_expr_info qt_idx in
UnaryOperator((fresh_stmt_info stmt_info), [idx_decl_ref_expr], idx_ei, { 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
let get_ei_from_cast cast = let get_ei_from_cast cast =
match cast with match cast with
| ImplicitCastExpr(_, _, ei, _) -> ei | Clang_ast_t.ImplicitCastExpr (_, _, ei, _) -> 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 qt_idx =
let open Clang_ast_t in
match pobj with match pobj with
| ParmVarDecl(di_obj, name_obj, qt_obj, _) -> | ParmVarDecl(di_obj, name_obj, qt_obj, _) ->
let poe_ei = make_general_expr_info qt_obj `LValue `Ordinary in let poe_ei = make_general_expr_info qt_obj `LValue `Ordinary in
@ -557,15 +565,15 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
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_qt ()),
{ osrei_kind =`ArraySubscript; osrei_getter = None; osrei_setter = None; }) in { osrei_kind =`ArraySubscript; osrei_getter = None; osrei_setter = None; }) in
let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config.object_at_indexed_subscript_m in let obj_c_message_expr_info = make_obj_c_message_expr_info_instance CFrontend_config.object_at_indexed_subscript_m in
let ome = ObjCMessageExpr((fresh_stmt_info stmt_info), [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in let ome = ObjCMessageExpr (fresh_stmt_info stmt_info, [ove_array; ove_idx], poe_ei, obj_c_message_expr_info) in
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, qt_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 *)
@ -573,47 +581,47 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
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_qual_type CFrontend_config.ns_array_ptr in let qt = create_qual_type CFrontend_config.ns_array_ptr in
(* init should be ImplicitCastExpr of array a *) (* init should be ImplicitCastExpr of array a *)
let vdi = { empty_var_decl_info with vdi_init_expr = Some (init) } in let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (init) } in
let var_decl = VarDecl(di, make_name_decl CFrontend_config.objects, qt, vdi) in let var_decl = Clang_ast_t.VarDecl (di, make_name_decl CFrontend_config.objects, qt, vdi) in
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, qt)] in
let make_object_cast_decl_ref_expr objects = let make_object_cast_decl_ref_expr objects =
match objects with match objects with
| DeclStmt(si, _, [VarDecl(di, name, qt, vdi)]) -> | Clang_ast_t.DeclStmt (si, _, [Clang_ast_t.VarDecl (di, name, qt, vdi)]) ->
let decl_ref = make_decl_ref_qt `Var si.si_pointer name.Clang_ast_t.ni_name false qt in let decl_ref = make_decl_ref_qt `Var si.Clang_ast_t.si_pointer name.Clang_ast_t.ni_name false qt in
cast_expr decl_ref qt cast_expr decl_ref qt
| _ -> 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
| ParmVarDecl(di, name, qt, _) -> | Clang_ast_t.ParmVarDecl (di, name, qt, _) ->
let decl_ref = make_decl_ref_qt `Var di.di_pointer name.Clang_ast_t.ni_name false qt in let decl_ref = make_decl_ref_qt `Var di.Clang_ast_t.di_pointer name.Clang_ast_t.ni_name false qt in
cast_expr decl_ref qt cast_expr decl_ref qt
| _ -> assert false in | _ -> assert false in
let make_block_decl be = let make_block_decl be =
match be with match be with
| 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 vdi_init_expr = Some (be) } in let vdi = { empty_var_decl_info with Clang_ast_t.vdi_init_expr = Some (be) } in
let var_decl = VarDecl(di, make_name_decl block_name, bei.Clang_ast_t.ei_qual_type, vdi) in let var_decl = Clang_ast_t.VarDecl (di, make_name_decl block_name, bei.Clang_ast_t.ei_qual_type, vdi) in
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_qual_type)]
| _ -> assert false in | _ -> assert false in
let make_block_call block_qt object_cast idx_cast stop_cast = let make_block_call block_qt object_cast idx_cast stop_cast =
let decl_ref = make_decl_ref_invalid `Var block_name false block_qt in let decl_ref = make_decl_ref_invalid `Var block_name false block_qt in
let fun_cast = cast_expr decl_ref block_qt in let fun_cast = cast_expr decl_ref block_qt in
let ei_call = make_expr_info (create_void_type ()) in let ei_call = make_expr_info (create_void_type ()) in
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_qt = create_BOOL_type () in
let ei = make_expr_info bool_qt in let ei = make_expr_info bool_qt in
let unary_op = UnaryOperator((fresh_stmt_info stmt_info), [stop_cast], ei, { 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_qt `LValueToRValue in
let break_stmt = BreakStmt((fresh_stmt_info stmt_info),[]) in let break_stmt = Clang_ast_t.BreakStmt (fresh_stmt_info stmt_info, []) in
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_qt =
match params with match params with
@ -632,37 +640,37 @@ let translate_block_enumerate block_name stmt_info stmt_list ei =
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;
ForStmt(stmt_info, [idx_decl_stmt; dummy_stmt (); guard; incr; Clang_ast_t.ForStmt (stmt_info, [idx_decl_stmt; dummy_stmt (); guard; incr;
CompoundStmt(stmt_info, [obj_assignment; call_block; if_stop])]); free_stop], op Clang_ast_t.CompoundStmt(stmt_info, [obj_assignment; call_block; if_stop])]); free_stop], op
| _ -> assert false in | _ -> assert false in
let open Clang_ast_t in
match stmt_list with match stmt_list with
| [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.Clang_ast_t.bdi_parameters in let vars_to_register = get_name_pointers bdi.bdi_parameters in
let translated_stmt, op = translate bdi.Clang_ast_t.bdi_parameters s block_decl bei.Clang_ast_t.ei_qual_type in let translated_stmt, op = translate bdi.bdi_parameters s block_decl bei.ei_qual_type in
CompoundStmt(stmt_info, translated_stmt), vars_to_register@op@bv CompoundStmt (stmt_info, translated_stmt), vars_to_register @ op @ bv
| _ -> (* When it is not the method we expect with only one parameter, we don't translate *) | _ -> (* When it is not the method we expect with only one parameter, we don't translate *)
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);
CompoundStmt(stmt_info, stmt_list), [] CompoundStmt (stmt_info, stmt_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 *)
let trans_negation_with_conditional stmt_info expr_info stmt_list = let trans_negation_with_conditional stmt_info expr_info stmt_list =
let stmt_list_cond = stmt_list @ [create_integer_literal 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
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 qt parameters =
let expr_info_call = { let expr_info_call = {
Clang_ast_t.ei_qual_type = qt; Clang_ast_t.ei_qual_type = qt;
Clang_ast_t.ei_value_kind = `XValue; ei_value_kind = `XValue;
Clang_ast_t.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 qt `Ordinary in
let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in let decl_ref = make_decl_ref_qt `Function decl_pointer function_name false qt in
let decl_ref_info = make_decl_ref_expr_info decl_ref in let decl_ref_info = make_decl_ref_expr_info decl_ref in
let decl_ref_exp = 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
CallExpr(stmt_info, decl_ref_exp:: parameters, expr_info_call) Clang_ast_t.CallExpr (stmt_info, decl_ref_exp:: parameters, expr_info_call)
let create_assume_not_null_call decl_info var_name var_type = 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
@ -671,15 +679,15 @@ let create_assume_not_null_call decl_info var_name var_type =
let decl_ref = make_decl_ref_qt `Var decl_ptr var_name false var_type in let decl_ref = make_decl_ref_qt `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 = 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_qual_type = var_type;
Clang_ast_t.ei_value_kind = `RValue; ei_value_kind = `RValue;
Clang_ast_t.ei_object_kind = `Ordinary ei_object_kind = `Ordinary
} in } in
let cast_info_call = { cei_cast_kind = `LValueToRValue; cei_base_path = [] } in let cast_info_call = { Clang_ast_t.cei_cast_kind = `LValueToRValue; cei_base_path = [] } in
let decl_ref_exp_cast = ImplicitCastExpr(stmt_info, [var_decl_ref], expr_info, cast_info_call) in let decl_ref_exp_cast = Clang_ast_t.ImplicitCastExpr (stmt_info, [var_decl_ref], expr_info, cast_info_call) in
let null_expr = create_integer_literal stmt_info "0" in let null_expr = create_integer_literal stmt_info "0" in
let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info (make_lvalue_obc_prop_expr_info var_type) boi in let bin_op = make_binary_stmt decl_ref_exp_cast null_expr stmt_info (make_lvalue_obc_prop_expr_info var_type) boi in
let parameters = [bin_op] in let parameters = [bin_op] in

47
infer/src/clang/cAstProcessor.ml
Unescape View File

@ -12,14 +12,15 @@
w.r.t. the previous one. This module processes the AST and makes locations explicit. *) w.r.t. the previous one. This module processes the AST and makes locations explicit. *)
open Utils open Utils
open Clang_ast_j
module L = Logging module L = Logging
module F = Format module F = Format
(** Get the sub-declarations of the current declaration. *) (** Get the sub-declarations of the current declaration. *)
let decl_get_sub_decls decl = match decl with let decl_get_sub_decls decl =
let open Clang_ast_t in
match decl with
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _) | CXXRecordDecl (_, _, _, _, decl_list, _, _, _)
| RecordDecl (_, _, _, _, decl_list, _, _) | RecordDecl (_, _, _, _, decl_list, _, _)
| ObjCInterfaceDecl (_, _, decl_list, _, _) | ObjCInterfaceDecl (_, _, decl_list, _, _)
@ -36,7 +37,9 @@ let decl_get_sub_decls decl = match decl with
(** Set the sub-declarations of the current declaration. *) (** Set the sub-declarations of the current declaration. *)
let decl_set_sub_decls decl decl_list' = match decl with let decl_set_sub_decls decl decl_list' =
let open Clang_ast_t in
match decl with
| CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info, cxx_record_info) -> | CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info, cxx_record_info) ->
CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list', decl_context_info, record_decl_info, cxx_record_info) CXXRecordDecl (decl_info, name, opt_type, type_ptr, decl_list', decl_context_info, record_decl_info, cxx_record_info)
| RecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info) -> | RecordDecl (decl_info, name, opt_type, type_ptr, decl_list, decl_context_info, record_decl_info) ->
@ -63,13 +66,13 @@ let decl_set_sub_decls decl decl_list' = match decl with
(** Pretty print a source location. *) (** Pretty print a source location. *)
let pp_source_loc fmt source_loc = let pp_source_loc fmt source_loc =
let file = match source_loc.sl_file with let file = match source_loc.Clang_ast_t.sl_file with
| Some file -> file | Some file -> file
| None -> "None" in | None -> "None" in
let line = match source_loc.sl_line with let line = match source_loc.Clang_ast_t.sl_line with
| Some n -> string_of_int n | Some n -> string_of_int n
| None -> "None" in | None -> "None" in
let column = match source_loc.sl_column with let column = match source_loc.Clang_ast_t.sl_column with
| Some n -> string_of_int n | Some n -> string_of_int n
| None -> "None" in | None -> "None" in
if file = "None" && line = "None" && column = "None" if file = "None" && line = "None" && column = "None"
@ -89,16 +92,17 @@ let pp_ast_decl fmt ast_decl =
let stmt_str = Clang_ast_proj.get_stmt_kind_string stmt in let stmt_str = Clang_ast_proj.get_stmt_kind_string stmt in
let stmt_info, stmt_list = Clang_ast_proj.get_stmt_tuple stmt in let stmt_info, stmt_list = Clang_ast_proj.get_stmt_tuple stmt in
let decl_list = match stmt with let decl_list = match stmt with
| DeclStmt (_, _, decl_list) -> decl_list | Clang_ast_t.DeclStmt (_, _, decl_list) -> decl_list
| _ -> [] in | _ -> [] in
F.fprintf fmt "%s%s %a@\n" F.fprintf fmt "%s%s %a@\n"
prefix prefix
stmt_str stmt_str
pp_source_range stmt_info.si_source_range; pp_source_range stmt_info.Clang_ast_t.si_source_range;
list_iter (dump_stmt prefix1) stmt_list; list_iter (dump_stmt prefix1) stmt_list;
list_iter (dump_decl prefix1) decl_list list_iter (dump_decl prefix1) decl_list
and dump_decl prefix decl = and dump_decl prefix decl =
let prefix1 = prefix ^ " " in let prefix1 = prefix ^ " " in
let open Clang_ast_t in
match decl with match decl with
| FunctionDecl (decl_info, name, qt, fdecl_info) -> | FunctionDecl (decl_info, name, qt, fdecl_info) ->
F.fprintf fmt "%sFunctionDecl %s %a@\n" F.fprintf fmt "%sFunctionDecl %s %a@\n"
@ -131,7 +135,7 @@ let pp_ast_decl fmt ast_decl =
let decl_str = Clang_ast_proj.get_decl_kind_string ast_decl in let decl_str = Clang_ast_proj.get_decl_kind_string ast_decl in
match ast_decl with match ast_decl with
| TranslationUnitDecl (_, decl_list, _, _) -> | Clang_ast_t.TranslationUnitDecl (_, decl_list, _, _) ->
F.fprintf fmt "%s (%d declarations)@\n" decl_str (list_length decl_list); F.fprintf fmt "%s (%d declarations)@\n" decl_str (list_length decl_list);
list_iter (dump_decl "") decl_list list_iter (dump_decl "") decl_list
| _ -> | _ ->
@ -147,17 +151,17 @@ module LocComposer : sig
val create : unit -> status val create : unit -> status
(** Compose a new source_range to the current one. *) (** Compose a new source_range to the current one. *)
val compose : status -> source_range -> source_range val compose : status -> Clang_ast_t.source_range -> Clang_ast_t.source_range
(** Set the current file if specified in the source_range. (** Set the current file if specified in the source_range.
The composer will not descend into file included from the current one. The composer will not descend into file included from the current one.
For locations in included files, it will return instead the last known For locations in included files, it will return instead the last known
location of the current file. *) location of the current file. *)
val set_current_file : status -> source_range -> unit val set_current_file : status -> Clang_ast_t.source_range -> unit
end = struct end = struct
type status = type status =
{ mutable curr_file: string option; { mutable curr_file: string option;
mutable curr_source_range: source_range; mutable curr_source_range: Clang_ast_t.source_range;
mutable in_curr_file : bool } mutable in_curr_file : bool }
let empty_sloc = { Clang_ast_t.sl_file = None; sl_line = None; sl_column = None } let empty_sloc = { Clang_ast_t.sl_file = None; sl_line = None; sl_column = None }
@ -168,7 +172,7 @@ end = struct
in_curr_file = true; } in_curr_file = true; }
let set_current_file st (sloc1, sloc2) = let set_current_file st (sloc1, sloc2) =
match sloc1.sl_file, sloc2.sl_file with match sloc1.Clang_ast_t.sl_file, sloc2.Clang_ast_t.sl_file with
| _, Some fname | _, Some fname
| Some fname, None -> | Some fname, None ->
st.curr_file <- Some fname; st.curr_file <- Some fname;
@ -176,7 +180,7 @@ end = struct
| _ -> | _ ->
() ()
let sloc_is_current_file st sloc = match st.curr_file, sloc.sl_file with let sloc_is_current_file st sloc = match st.curr_file, sloc.Clang_ast_t.sl_file with
| Some curr_f, Some f -> | Some curr_f, Some f ->
Some (f = curr_f) Some (f = curr_f)
| None, _ -> None | None, _ -> None
@ -195,6 +199,7 @@ end = struct
then then
let update x_opt y_opt = let update x_opt y_opt =
if y_opt <> None then y_opt else x_opt in if y_opt <> None then y_opt else x_opt in
let open Clang_ast_t in
{ sl_file = update old_sloc.sl_file new_sloc.sl_file; { sl_file = update old_sloc.sl_file new_sloc.sl_file;
sl_line = update old_sloc.sl_line new_sloc.sl_line; sl_line = update old_sloc.sl_line new_sloc.sl_line;
sl_column = update old_sloc.sl_column new_sloc.sl_column } sl_column = update old_sloc.sl_column new_sloc.sl_column }
@ -220,11 +225,13 @@ end
(** Apply a location composer to the locations in a statement. *) (** Apply a location composer to the locations in a statement. *)
let rec stmt_process_locs loc_composer stmt = let rec stmt_process_locs loc_composer stmt =
let update (stmt_info, stmt_list) = let update (stmt_info, stmt_list) =
let range' = LocComposer.compose loc_composer stmt_info.Clang_ast_t.si_source_range in
let stmt_info' = let stmt_info' =
{ stmt_info with { stmt_info with
si_source_range = LocComposer.compose loc_composer stmt_info.si_source_range } in Clang_ast_t.si_source_range = range' } in
let stmt_list' = list_map (stmt_process_locs loc_composer) stmt_list in let stmt_list' = list_map (stmt_process_locs loc_composer) stmt_list in
(stmt_info', stmt_list') in (stmt_info', stmt_list') in
let open Clang_ast_t in
match Clang_ast_proj.update_stmt_tuple update stmt with match Clang_ast_proj.update_stmt_tuple update stmt with
| DeclStmt (stmt_info, stmt_list, decl_list) -> | DeclStmt (stmt_info, stmt_list, decl_list) ->
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
@ -236,12 +243,14 @@ let rec stmt_process_locs loc_composer stmt =
and decl_process_locs loc_composer decl = and decl_process_locs loc_composer decl =
let decl' = let decl' =
let update decl_info = let update decl_info =
let range' = LocComposer.compose loc_composer decl_info.Clang_ast_t.di_source_range in
{ decl_info with { decl_info with
di_source_range = LocComposer.compose loc_composer decl_info.di_source_range } in Clang_ast_t.di_source_range = range' } in
let decl_list = decl_get_sub_decls decl in let decl_list = decl_get_sub_decls decl in
let decl1 = Clang_ast_proj.update_decl_tuple update decl in let decl1 = Clang_ast_proj.update_decl_tuple update decl in
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 get_updated_fun_decl (decl_info', name, qt, fdecl_info) = let get_updated_fun_decl (decl_info', name, qt, 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
@ -280,13 +289,13 @@ let ast_decl_process_locs loc_composer ast_decl =
let toplevel_decl_process_locs decl = let toplevel_decl_process_locs decl =
let decl_info = Clang_ast_proj.get_decl_tuple decl in let decl_info = Clang_ast_proj.get_decl_tuple decl in
LocComposer.set_current_file loc_composer decl_info.di_source_range; LocComposer.set_current_file loc_composer decl_info.Clang_ast_t.di_source_range;
decl_process_locs loc_composer decl in decl_process_locs loc_composer decl in
match ast_decl with match ast_decl with
| TranslationUnitDecl (decl_info, decl_list, decl_context_info, type_list) -> | Clang_ast_t.TranslationUnitDecl (decl_info, decl_list, decl_context_info, type_list) ->
let decl_list' = list_map toplevel_decl_process_locs decl_list in let decl_list' = list_map toplevel_decl_process_locs decl_list in
TranslationUnitDecl (decl_info, decl_list', decl_context_info, type_list) Clang_ast_t.TranslationUnitDecl (decl_info, decl_list', decl_context_info, type_list)
| _ -> | _ ->
assert false assert false

1
infer/src/clang/cContext.mli
Unescape View File

@ -76,4 +76,3 @@ val create_context : Sil.tenv -> Cg.t -> Cfg.cfg -> Cfg.Procdesc.t ->
string option -> curr_class -> bool -> (Mangled.t * Sil.typ * bool) list -> bool -> t string option -> curr_class -> bool -> (Mangled.t * Sil.typ * bool) list -> bool -> t
val create_curr_class : Sil.tenv -> string -> curr_class val create_curr_class : Sil.tenv -> string -> curr_class

3
infer/src/clang/cEnum_decl.ml
Unescape View File

@ -11,7 +11,6 @@
(** translating the code and adding it to a fake procdesc *) (** translating the code and adding it to a fake procdesc *)
open CFrontend_utils open CFrontend_utils
open Clang_ast_t
let create_empty_procdesc () = let create_empty_procdesc () =
let procname = Procname.from_string_c_fun "__INFER_$GLOBAL_VAR_env" in let procname = Procname.from_string_c_fun "__INFER_$GLOBAL_VAR_env" in
@ -49,7 +48,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
| [] -> [] | [] -> []
| EnumConstantDecl(decl_info, name_info, qual_type, enum_constant_decl_info) :: decl_list' -> | Clang_ast_t.EnumConstantDecl (decl_info, name_info, qual_type, 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));

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

@ -11,8 +11,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CFrontend_utils.General_utils
open Clang_ast_t
module L = Logging module L = Logging
@ -24,7 +22,7 @@ let rec get_fields_super_classes tenv super_class =
| None -> [] | None -> []
| Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) -> | Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) ->
let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Sil.Class, sc)) in let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Sil.Class, sc)) in
append_no_duplicates_fields fields sc_fields General_utils.append_no_duplicates_fields fields sc_fields
| Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields | Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields
| Some _ -> [] | Some _ -> []
@ -55,7 +53,7 @@ let build_sil_field tenv class_name field_name qual_type prop_atts =
| 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 = mk_class_field_name class_name field_name in let fname = General_utils.mk_class_field_name class_name field_name in
let typ = CTypes_decl.qual_type_to_sil_type tenv qual_type in let typ = CTypes_decl.qual_type_to_sil_type tenv qual_type in
let item_annotations = match prop_atts with let item_annotations = match prop_atts with
| [] -> | [] ->
@ -90,28 +88,25 @@ let build_sil_field_property curr_class tenv field_name qual_type prop_attribute
(* 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
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, qual_type, 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
let field_name = name_info.Clang_ast_t.ni_name in let field_name = name_info.Clang_ast_t.ni_name 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' @." field_name; Printing.log_out " ...Adding Instance Variable '%s' @." field_name;
let (fname, typ, ia) = build_sil_field_property curr_class tenv field_name qual_type None in let (fname, typ, ia) = build_sil_field_property curr_class tenv field_name qual_type 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;
(fname, typ, ia):: fields (fname, typ, ia):: fields
| ObjCPropertyImplDecl (decl_info, property_impl_decl_info):: decl_list' ->
| ObjCPropertyImplDecl(decl_info, property_impl_decl_info):: decl_list' ->
let property_fields_decl = let property_fields_decl =
ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in ObjcProperty_decl.prepare_dynamic_property curr_class decl_info property_impl_decl_info in
get_fields tenv curr_class (property_fields_decl @ decl_list') get_fields tenv curr_class (property_fields_decl @ decl_list')
| _ :: decl_list' -> get_fields tenv curr_class decl_list'
| (d : Clang_ast_t.decl):: decl_list' ->
get_fields tenv curr_class decl_list'
(* Add potential extra fields defined only in the implementation of the class *) (* Add potential extra fields defined only in the implementation of the class *)
(* to the info given in the interface. Update the tenv accordingly. *) (* to the info given in the interface. Update the tenv accordingly. *)
@ -120,7 +115,7 @@ let add_missing_fields tenv class_name fields =
let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in
match Sil.tenv_lookup tenv class_tn_name with match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) -> | Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) ->
let new_fields = append_no_duplicates_fields fields intf_fields in let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in
let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in
let class_type_info = let class_type_info =
Sil.Tstruct ( Sil.Tstruct (

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

@ -18,7 +18,6 @@ module L = Logging
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CGen_trans open CGen_trans
open Clang_ast_t
(* Translate one global declaration *) (* Translate one global declaration *)
let rec translate_one_declaration tenv cg cfg namespace parent_dec dec = let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
@ -27,6 +26,7 @@ let rec translate_one_declaration tenv cg cfg namespace parent_dec dec =
CLocation.update_curr_file info; CLocation.update_curr_file info;
let source_range = info.Clang_ast_t.di_source_range in let source_range = info.Clang_ast_t.di_source_range in
let should_translate_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
match dec with match dec with
| FunctionDecl(di, name_info, qt, fdecl_info) -> | FunctionDecl(di, name_info, qt, fdecl_info) ->
CMethod_declImpl.function_decl tenv cfg cg namespace dec None CContext.ContextNoCls CMethod_declImpl.function_decl tenv cfg cg namespace dec None CContext.ContextNoCls

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

@ -11,7 +11,6 @@
(** for transformations of ast nodes and general utility functions such as functions on lists *) (** for transformations of ast nodes and general utility functions such as functions on lists *)
open Utils open Utils
open Clang_ast_t
module L = Logging module L = Logging
module F = Format module F = Format
@ -130,10 +129,11 @@ struct
"<\"" ^ name ^ "\"> '" ^ info.Clang_ast_t.si_pointer ^ "'" "<\"" ^ name ^ "\"> '" ^ info.Clang_ast_t.si_pointer ^ "'"
let get_stmts_from_stmt stmt = let get_stmts_from_stmt stmt =
let open Clang_ast_t in
match stmt with match stmt with
| OpaqueValueExpr(_, lstmt, _, opaque_value_expr_info) -> | OpaqueValueExpr (_, lstmt, _, opaque_value_expr_info) ->
(match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with (match opaque_value_expr_info.Clang_ast_t.ovei_source_expr with
| Some stmt -> lstmt@[stmt] | Some stmt -> lstmt @ [stmt]
| _ -> lstmt) | _ -> lstmt)
(* given that this has not been translated, looking up for variables *) (* given that this has not been translated, looking up for variables *)
(* inside leads to inconsistencies *) (* inside leads to inconsistencies *)
@ -249,7 +249,7 @@ 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.uttei_qual_type with match info.Clang_ast_t.uttei_qual_type with
| Some qt -> Some qt | Some qt -> Some qt
| None -> None | None -> None

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

@ -9,7 +9,6 @@
(** Module for utility functions for the whole frontend. Includes functions for printing, *) (** Module for utility functions for the whole frontend. Includes functions for printing, *)
(** for transformations of ast nodes and general utility functions such as functions on lists *) (** for transformations of ast nodes and general utility functions such as functions on lists *)
open Clang_ast_t
module Printing : module Printing :
sig sig
@ -49,15 +48,15 @@ sig
val property_name : Clang_ast_t.obj_c_property_impl_decl_info -> string val property_name : Clang_ast_t.obj_c_property_impl_decl_info -> string
val property_attribute_compare : property_attribute -> property_attribute -> int val property_attribute_compare : Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> int
val generated_ivar_name : string -> string val generated_ivar_name : string -> string
val property_attribute_eq : property_attribute -> property_attribute -> bool val property_attribute_eq : Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> bool
val getter_attribute_opt : property_attribute list -> string option val getter_attribute_opt : Clang_ast_t.property_attribute list -> string option
val setter_attribute_opt : property_attribute list -> string option val setter_attribute_opt : Clang_ast_t.property_attribute list -> string option
val get_memory_management_attributes : unit -> Clang_ast_t.property_attribute list val get_memory_management_attributes : unit -> Clang_ast_t.property_attribute list

14
infer/src/clang/cMain.ml
Unescape View File

@ -13,8 +13,6 @@
module L = Logging module L = Logging
open Clang_ast_j
open CFrontend_config
open CFrontend_utils open CFrontend_utils
let arg_desc = let arg_desc =
@ -27,7 +25,7 @@ let arg_desc =
(filter Utils.base_arg_desc) @ (filter Utils.base_arg_desc) @
[ [
"-c", "-c",
Arg.String (fun cfile -> source_file := Some cfile), Arg.String (fun cfile -> CFrontend_config.source_file := Some cfile),
Some "cfile", Some "cfile",
"C File to translate"; "C File to translate";
"-x", "-x",
@ -35,7 +33,7 @@ let arg_desc =
Some "cfile", Some "cfile",
"Language (c, objective-c, c++, objc-++)"; "Language (c, objective-c, c++, objc-++)";
"-ast", "-ast",
Arg.String (fun file -> ast_file := Some file), Arg.String (fun file -> CFrontend_config.ast_file := Some file),
Some "file", Some "file",
"AST file for the translation"; "AST file for the translation";
"-dotty_cfg_libs", "-dotty_cfg_libs",
@ -121,11 +119,11 @@ let do_run source_path ast_path =
raise exc raise exc
let _ = let _ =
Config.print_types:= true; Config.print_types := true;
if Option.is_none !source_file then if Option.is_none !CFrontend_config.source_file then
(Printing.log_err "Incorrect command line arguments\n"; (Printing.log_err "Incorrect command line arguments\n";
print_usage_exit ()) print_usage_exit ())
else else
match !source_file with match !CFrontend_config.source_file with
| Some path -> do_run path !ast_file | Some path -> do_run path !CFrontend_config.ast_file
| None -> assert false | None -> assert false

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

@ -11,8 +11,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open Clang_ast_t
open CContext
module L = Logging module L = Logging
@ -46,7 +44,7 @@ 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
| ParmVarDecl(decl_info, name_info, qtype, var_decl_info) | Clang_ast_t.ParmVarDecl(decl_info, name_info, qtype, var_decl_info)
when CFrontend_utils.Ast_utils.is_type_nonnull qtype attributes -> when CFrontend_utils.Ast_utils.is_type_nonnull qtype attributes ->
let name = name_info.Clang_ast_t.ni_name in let name = name_info.Clang_ast_t.ni_name in
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 qtype in
@ -129,6 +127,7 @@ struct
| None -> () | None -> ()
let rec process_one_method_decl tenv cg cfg curr_class namespace dec = let rec process_one_method_decl tenv cg cfg curr_class namespace dec =
let open Clang_ast_t in
match dec with match dec with
| CXXMethodDecl _ -> | CXXMethodDecl _ ->
process_method_decl tenv cg cfg namespace curr_class dec ~is_objc:false process_method_decl tenv cg cfg namespace curr_class dec ~is_objc:false
@ -150,6 +149,7 @@ struct
let process_getter_setter context procname = let process_getter_setter context procname =
let class_name = Procname.c_get_class procname in let class_name = Procname.c_get_class procname in
let open CContext in
let cls = CContext.create_curr_class context.tenv class_name in let cls = CContext.create_curr_class context.tenv class_name in
let method_name = Procname.c_get_method procname in let method_name = Procname.c_get_method procname in
match ObjcProperty_decl.method_is_property_accesor cls method_name with match ObjcProperty_decl.method_is_property_accesor cls method_name with

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

@ -12,8 +12,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CContext
open Clang_ast_t
module L = Logging module L = Logging
@ -59,11 +57,11 @@ 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
| ParmVarDecl(decl_info, name_info, qtype, var_decl_info) -> | Clang_ast_t.ParmVarDecl (decl_info, name_info, qtype, var_decl_info) ->
let name = name_info.Clang_ast_t.ni_name in let name = name_info.Clang_ast_t.ni_name in
Printing.log_out "Adding param '%s' " name; Printing.log_out "Adding param '%s' " name;
Printing.log_out "with pointer %s@." decl_info.Clang_ast_t.di_pointer; Printing.log_out "with pointer %s@." decl_info.Clang_ast_t.di_pointer;
(name, CTypes.get_type qtype, var_decl_info.vdi_init_expr) (name, CTypes.get_type qtype, 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
@ -87,14 +85,15 @@ let build_method_signature decl_info procname function_method_decl_info is_insta
CMethod_signature.make_ms procname parameters qt attributes source_range is_instance_method is_generated CMethod_signature.make_ms procname parameters qt attributes source_range is_instance_method is_generated
let method_signature_of_decl curr_class meth_decl block_data_opt = let method_signature_of_decl curr_class meth_decl block_data_opt =
let open Clang_ast_t in
match meth_decl, block_data_opt with match meth_decl, block_data_opt with
| FunctionDecl(decl_info, name_info, qt, fdi), _ -> | FunctionDecl (decl_info, name_info, qt, fdi), _ ->
let name = name_info.Clang_ast_t.ni_name in let name = name_info.ni_name in
let func_decl = Func_decl_info (fdi, CTypes.get_type qt) in let func_decl = Func_decl_info (fdi, CTypes.get_type qt) in
let procname = General_utils.mk_procname_from_function name (CTypes.get_type qt) in let procname = General_utils.mk_procname_from_function name (CTypes.get_type qt) 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), _ -> | CXXMethodDecl (decl_info, name_info, qt, fdi), _ ->
let class_name = CContext.get_curr_class_name curr_class in let class_name = CContext.get_curr_class_name curr_class in
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in
let typ = CTypes.get_type qt in let typ = CTypes.get_type qt in
@ -102,20 +101,21 @@ let method_signature_of_decl curr_class meth_decl block_data_opt =
let method_decl = Cpp_Meth_decl_info (fdi, class_name, typ) in let method_decl = Cpp_Meth_decl_info (fdi, class_name, typ) 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), _ -> | ObjCMethodDecl (decl_info, name_info, mdi), _ ->
let class_name = CContext.get_curr_class_name curr_class in let class_name = CContext.get_curr_class_name curr_class in
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.ni_name in
let is_instance = mdi.Clang_ast_t.omdi_is_instance_method in let is_instance = mdi.omdi_is_instance_method in
let method_kind = Procname.objc_method_kind_of_bool is_instance in let method_kind = Procname.objc_method_kind_of_bool is_instance in
let procname = General_utils.mk_procname_from_objc_method class_name method_name method_kind in let procname = General_utils.mk_procname_from_objc_method class_name method_name method_kind in
let method_decl = ObjC_Meth_decl_info (mdi, class_name) in let method_decl = ObjC_Meth_decl_info (mdi, class_name) in
let is_generated = Ast_utils.is_generated name_info in let is_generated = Ast_utils.is_generated name_info in
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.Clang_ast_t.omdi_body, mdi.Clang_ast_t.omdi_parameters ms, mdi.omdi_body, mdi.omdi_parameters
| BlockDecl(decl_info, decl_list, decl_context_info, bdi), Some (qt, is_instance, procname, _) -> | BlockDecl (decl_info, decl_list, decl_context_info, bdi),
Some (qt, is_instance, procname, _) ->
let func_decl = Block_decl_info (bdi, CTypes.get_type qt) in let func_decl = Block_decl_info (bdi, CTypes.get_type qt) 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.Clang_ast_t.bdi_body, bdi.Clang_ast_t.bdi_parameters ms, bdi.bdi_body, bdi.bdi_parameters
|_ -> assert false |_ -> assert false
let get_superclass_curr_class context = let get_superclass_curr_class context =
@ -187,12 +187,12 @@ let captured_vars_from_block_info context cvl =
(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_qual_type 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.is_instance then [] if n = CFrontend_config.self && not context.CContext.is_instance then []
else else
(let procdesc_formals = Cfg.Procdesc.get_formals context.procdesc in (let procdesc_formals = Cfg.Procdesc.get_formals context.CContext.procdesc in
(Printing.log_err "formals are %s@." (Utils.list_to_string (fun (x, _) -> x) procdesc_formals)); (Printing.log_err "formals are %s@." (Utils.list_to_string (fun (x, _) -> x) procdesc_formals));
let formals = list_map formal2captured procdesc_formals in let formals = list_map formal2captured procdesc_formals in
[find (context.local_vars @ formals) n]) [find (context.CContext.local_vars @ formals) n])
| _ -> assert false) | _ -> assert false)
| None -> []) :: f cvl'' in | None -> []) :: f cvl'' in
list_flatten (f cvl) list_flatten (f cvl)

415
infer/src/clang/cTrans.ml
View File

File diff suppressed because it is too large Load Diff

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

@ -9,9 +9,7 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open Clang_ast_t
open Objc_models open Objc_models
open CFrontend_config
let is_cf_non_null_alloc funct = let is_cf_non_null_alloc funct =
match funct with match funct with
@ -38,8 +36,8 @@ 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
| 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.ei_qual_type Some expr_info.Clang_ast_t.ei_qual_type
| _ -> | _ ->
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
@ -134,29 +132,34 @@ let get_predefined_ms_method condition class_name method_name method_kind mk_pro
else None else None
let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname = let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname =
let condition = class_name = nsstring_cl && method_name = string_with_utf8_m in let condition =
class_name = CFrontend_config.nsstring_cl
&& method_name = CFrontend_config.string_with_utf8_m in
get_predefined_ms_method condition class_name method_name Procname.Class_objc_method get_predefined_ms_method condition class_name method_name Procname.Class_objc_method
mk_procname [("x", "char *", None)] id_cl [] None mk_procname [("x", "char *", None)] CFrontend_config.id_cl [] None
let get_predefined_ms_retain_release class_name method_name mk_procname = let get_predefined_ms_retain_release class_name method_name mk_procname =
let condition = is_retain_or_release method_name in let condition = is_retain_or_release method_name in
let return_type = let return_type =
if is_retain_method method_name || is_autorelease_method method_name if is_retain_method method_name || is_autorelease_method method_name
then id_cl else void in then CFrontend_config.id_cl else CFrontend_config.void in
get_predefined_ms_method condition nsobject_cl method_name Procname.Instance_objc_method get_predefined_ms_method condition CFrontend_config.nsobject_cl method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)] return_type [] (get_builtinname method_name) mk_procname [(CFrontend_config.self, class_name, None)] return_type [] (get_builtinname method_name)
let get_predefined_ms_autoreleasepool_init class_name method_name mk_procname = let get_predefined_ms_autoreleasepool_init class_name method_name mk_procname =
let condition = (method_name = init) && (class_name = nsautorelease_pool_cl) in let condition =
method_name = CFrontend_config.init
&& class_name = CFrontend_config.nsautorelease_pool_cl in
get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)] void [] None mk_procname [(CFrontend_config.self, class_name, None)] CFrontend_config.void [] None
let get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname = let get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname =
let condition = (method_name = release || method_name = drain) && let condition =
(class_name = nsautorelease_pool_cl) in (method_name = CFrontend_config.release || method_name = CFrontend_config.drain)
&& class_name = CFrontend_config.nsautorelease_pool_cl in
get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method get_predefined_ms_method condition class_name method_name Procname.Instance_objc_method
mk_procname [(self, class_name, None)] mk_procname [(CFrontend_config.self, class_name, None)]
void [] (Some SymExec.ModelBuiltins.__objc_release_autorelease_pool) CFrontend_config.void [] (Some SymExec.ModelBuiltins.__objc_release_autorelease_pool)
let get_predefined_model_method_signature class_name method_name mk_procname = let get_predefined_model_method_signature class_name method_name mk_procname =
match get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname with match get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname with

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

@ -11,8 +11,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CContext
open Clang_ast_t
module L = Logging module L = Logging
@ -279,7 +277,7 @@ let create_alloc_instrs context sil_loc function_type fname =
| Sil.Tptr (styp, Sil.Pk_objc_weak) | Sil.Tptr (styp, Sil.Pk_objc_weak)
| Sil.Tptr (styp, Sil.Pk_objc_unsafe_unretained) | Sil.Tptr (styp, Sil.Pk_objc_unsafe_unretained)
| Sil.Tptr (styp, Sil.Pk_objc_autoreleasing) -> | Sil.Tptr (styp, Sil.Pk_objc_autoreleasing) ->
function_type, CTypes_decl.expand_structured_type context.tenv styp function_type, CTypes_decl.expand_structured_type context.CContext.tenv styp
| _ -> Sil.Tptr (function_type, Sil.Pk_pointer), function_type in | _ -> Sil.Tptr (function_type, Sil.Pk_pointer), function_type in
let sizeof_exp = Sil.Sizeof (function_type_np, Sil.Subtype.exact) in let sizeof_exp = Sil.Sizeof (function_type_np, Sil.Subtype.exact) in
let exp = (sizeof_exp, function_type) in let exp = (sizeof_exp, function_type) in
@ -306,7 +304,7 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
let is_instance = true in let is_instance = true in
let call_flags = { Sil.cf_virtual = is_instance; Sil.cf_noreturn = false; Sil.cf_is_objc_block = false; } in let call_flags = { Sil.cf_virtual = is_instance; Sil.cf_noreturn = false; Sil.cf_is_objc_block = false; } in
let pname = General_utils.mk_procname_from_objc_method cls_name CFrontend_config.init Procname.Instance_objc_method in let pname = General_utils.mk_procname_from_objc_method cls_name CFrontend_config.init Procname.Instance_objc_method in
CMethod_trans.create_external_procdesc trans_state.context.cfg pname is_instance None; CMethod_trans.create_external_procdesc trans_state.context.CContext.cfg pname is_instance None;
let args = [(Sil.Var alloc_ret_id, alloc_ret_type)] in let args = [(Sil.Var alloc_ret_id, alloc_ret_type)] in
let init_stmt_call = Sil.Call([init_ret_id], (Sil.Const (Sil.Cfun pname)), args, loc, call_flags) in let init_stmt_call = Sil.Call([init_ret_id], (Sil.Const (Sil.Cfun pname)), args, loc, call_flags) in
let instrs = [alloc_stmt_call; init_stmt_call] in let instrs = [alloc_stmt_call; init_stmt_call] in
@ -317,7 +315,7 @@ let objc_new_trans trans_state loc stmt_info cls_name function_type =
{ res_trans with exps = [(Sil.Var init_ret_id, alloc_ret_type)]} { res_trans with exps = [(Sil.Var init_ret_id, alloc_ret_type)]}
let new_or_alloc_trans trans_state loc stmt_info class_name selector = let new_or_alloc_trans trans_state loc stmt_info class_name selector =
let function_type = CTypes_decl.type_name_to_sil_type trans_state.context.tenv class_name in let function_type = CTypes_decl.type_name_to_sil_type trans_state.context.CContext.tenv class_name in
if selector = CFrontend_config.alloc then if selector = CFrontend_config.alloc then
alloc_trans trans_state loc stmt_info function_type true alloc_trans trans_state loc stmt_info function_type true
else if selector = CFrontend_config.new_str then else if selector = CFrontend_config.new_str then
@ -335,7 +333,7 @@ let cpp_new_trans trans_state sil_loc stmt_info function_type =
let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc = let create_cast_instrs context exp cast_from_typ cast_to_typ sil_loc =
let ret_id = Ident.create_fresh Ident.knormal in let ret_id = Ident.create_fresh Ident.knormal in
let cast_typ_no_pointer = let cast_typ_no_pointer =
CTypes_decl.expand_structured_type context.tenv (CTypes.remove_pointer_to_typ cast_to_typ) in CTypes_decl.expand_structured_type context.CContext.tenv (CTypes.remove_pointer_to_typ cast_to_typ) in
let sizeof_exp = Sil.Sizeof (cast_typ_no_pointer, Sil.Subtype.exact) in let sizeof_exp = Sil.Sizeof (cast_typ_no_pointer, Sil.Subtype.exact) in
let pname = SymExec.ModelBuiltins.__objc_cast in let pname = SymExec.ModelBuiltins.__objc_cast in
let args = [(exp, cast_from_typ); (sizeof_exp, Sil.Tvoid)] in let args = [(exp, cast_from_typ); (sizeof_exp, Sil.Tvoid)] in
@ -490,12 +488,12 @@ let extract_item_from_option op warning_string =
let is_member_exp stmt = let is_member_exp stmt =
match stmt with match stmt with
| MemberExpr _ -> true | Clang_ast_t.MemberExpr _ -> true
| _ -> false | _ -> false
let is_enumeration_constant stmt = let is_enumeration_constant stmt =
match stmt with match stmt with
| DeclRefExpr(_, _, _, drei) -> | Clang_ast_t.DeclRefExpr(_, _, _, drei) ->
(match drei.Clang_ast_t.drti_decl_ref with (match drei.Clang_ast_t.drti_decl_ref with
| Some d -> (match d.Clang_ast_t.dr_kind with | Some d -> (match d.Clang_ast_t.dr_kind with
| `EnumConstant -> true | `EnumConstant -> true
@ -505,7 +503,7 @@ let is_enumeration_constant stmt =
let is_null_stmt s = let is_null_stmt s =
match s with match s with
| NullStmt _ -> true | Clang_ast_t.NullStmt _ -> true
| _ -> false | _ -> false
let dummy_id () = let dummy_id () =
@ -524,6 +522,7 @@ let rec get_type_from_exp_stmt stmt =
| Some n -> n | Some n -> n
| _ -> assert false ) | _ -> assert false )
| _ -> assert false in | _ -> assert false 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_qual_type
@ -551,7 +550,7 @@ struct
if is_superinstance mei then if is_superinstance mei then
let typ, self_expr, id, ins = let typ, self_expr, id, ins =
let t' = CTypes.add_pointer_to_typ let t' = CTypes.add_pointer_to_typ
(CTypes_decl.get_type_curr_class context.tenv context.curr_class) in (CTypes_decl.get_type_curr_class context.CContext.tenv context.CContext.curr_class) in
let e = Sil.Lvar (Sil.mk_pvar (Mangled.from_string CFrontend_config.self) procname) in let e = Sil.Lvar (Sil.mk_pvar (Mangled.from_string CFrontend_config.self) procname) in
let id = Ident.create_fresh Ident.knormal in let id = Ident.create_fresh Ident.knormal in
t', Sil.Var id, [id], [Sil.Letderef (id, e, t', loc)] in t', Sil.Var id, [id], [Sil.Letderef (id, e, t', loc)] in
@ -600,7 +599,7 @@ let is_owning_name n =
let rec is_owning_method s = let rec is_owning_method s =
match s with match s with
| ObjCMessageExpr(_, _ , _, mei) -> | Clang_ast_t.ObjCMessageExpr(_, _ , _, mei) ->
is_owning_name mei.Clang_ast_t.omei_selector is_owning_name mei.Clang_ast_t.omei_selector
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with | _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false | [] -> false
@ -608,14 +607,14 @@ let rec is_owning_method s =
let rec is_method_call s = let rec is_method_call s =
match s with match s with
| ObjCMessageExpr(_, _ , _, mei) -> true | Clang_ast_t.ObjCMessageExpr (_, _ , _, mei) -> true
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with | _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false | [] -> false
| s'':: _ -> is_method_call s'') | s'':: _ -> is_method_call s'')
let rec get_decl_ref_info s parent_line_number = let rec get_decl_ref_info s parent_line_number =
match s with match s with
| 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) ->
let line_number = CLocation.get_line stmt_info parent_line_number in let line_number = CLocation.get_line stmt_info parent_line_number in
stmt_info.Clang_ast_t.si_pointer, line_number stmt_info.Clang_ast_t.si_pointer, line_number
| _ -> (match Clang_ast_proj.get_stmt_tuple s with | _ -> (match Clang_ast_proj.get_stmt_tuple s with
@ -626,18 +625,18 @@ let rec get_decl_ref_info s parent_line_number =
let rec contains_opaque_value_expr s = let rec contains_opaque_value_expr s =
match s with match s with
| OpaqueValueExpr (_, _, _, _) -> true | Clang_ast_t.OpaqueValueExpr _ -> true
| _ -> (match snd (Clang_ast_proj.get_stmt_tuple s) with | _ -> match snd (Clang_ast_proj.get_stmt_tuple s) with
| [] -> false | [] -> false
| s'':: _ -> contains_opaque_value_expr s'') | s'':: _ -> contains_opaque_value_expr s''
let rec compute_autorelease_pool_vars context stmts = let rec compute_autorelease_pool_vars context stmts =
match stmts with match stmts with
| [] -> [] | [] -> []
| DeclRefExpr(si, sl, ei, drei):: stmts' -> | Clang_ast_t.DeclRefExpr (si, sl, ei, drei):: stmts' ->
let name = get_name_decl_ref_exp_info drei si in let name = get_name_decl_ref_exp_info drei si in
let procname = Cfg.Procdesc.get_proc_name context.procdesc in let procname = Cfg.Procdesc.get_proc_name context.CContext.procdesc in
let local_vars = Cfg.Procdesc.get_locals context.procdesc in let local_vars = Cfg.Procdesc.get_locals context.CContext.procdesc in
let mname = try let mname = try
list_filter (fun (m, t) -> Mangled.to_string m = name) local_vars list_filter (fun (m, t) -> Mangled.to_string m = name) local_vars
with _ -> [] in with _ -> [] in
@ -646,9 +645,9 @@ let rec compute_autorelease_pool_vars context stmts =
CFrontend_utils.General_utils.append_no_duplicated_pvars CFrontend_utils.General_utils.append_no_duplicated_pvars
[(Sil.Lvar (Sil.mk_pvar m procname), t)] (compute_autorelease_pool_vars context stmts') [(Sil.Lvar (Sil.mk_pvar m procname), t)] (compute_autorelease_pool_vars context stmts')
| _ -> compute_autorelease_pool_vars context stmts') | _ -> compute_autorelease_pool_vars context stmts')
| s:: stmts' -> | s :: stmts' ->
let sl = snd(Clang_ast_proj.get_stmt_tuple s) in let sl = snd(Clang_ast_proj.get_stmt_tuple s) in
compute_autorelease_pool_vars context (sl@stmts') compute_autorelease_pool_vars context (sl @ 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 =
@ -658,6 +657,7 @@ let is_logical_negation_of_int tenv ei uoi =
(* Checks if stmt_list is a call to a special dispatch function *) (* Checks if stmt_list is a call to a special dispatch function *)
let is_dispatch_function stmt_list = let is_dispatch_function stmt_list =
let open Clang_ast_t in
match stmt_list with match stmt_list with
| ImplicitCastExpr(_,[DeclRefExpr(_, _, _, di)], _, _):: stmts -> | ImplicitCastExpr(_,[DeclRefExpr(_, _, _, di)], _, _):: stmts ->
(match di.Clang_ast_t.drti_decl_ref with (match di.Clang_ast_t.drti_decl_ref with
@ -690,7 +690,7 @@ let assign_default_params params_stmt callee_pname_opt ~is_cxx_method =
let params_args = list_combine params_stmt args in let params_args = list_combine params_stmt args in
let replace_default_arg param = let replace_default_arg param =
match param with match param with
| CXXDefaultArgExpr(_, _, _), (_, _, Some default_instr) -> default_instr | Clang_ast_t.CXXDefaultArgExpr _, (_, _, Some default_instr) -> default_instr
| instr, _ -> instr in | instr, _ -> instr in
list_map replace_default_arg params_args list_map replace_default_arg params_args
with with

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

@ -10,9 +10,7 @@
(** Utility module for retrieving types *) (** Utility module for retrieving types *)
open Utils open Utils
open Clang_ast_t
open CFrontend_utils open CFrontend_utils
open CFrontend_utils.General_utils
module L = Logging module L = Logging
let get_function_return_type s = let get_function_return_type s =
@ -66,13 +64,14 @@ let lookup_var_type context pvar =
(* Extract the type out of a statement. This is useful when the statement *) (* Extract the type out of a statement. This is useful when the statement *)
(* denotes actually an expression *) (* denotes actually an expression *)
let extract_type_from_stmt s = let extract_type_from_stmt s =
let open Clang_ast_t in
match s with match s with
| BinaryConditionalOperator(_, _, expr_info) | ConditionalOperator(_, _, expr_info) | BinaryConditionalOperator (_, _, expr_info) | ConditionalOperator (_, _, expr_info)
| AddrLabelExpr(_, _, expr_info, _) | ArraySubscriptExpr(_, _, expr_info) | AddrLabelExpr (_, _, expr_info, _) | ArraySubscriptExpr (_, _, expr_info)
| ArrayTypeTraitExpr(_, _, expr_info) | AsTypeExpr(_, _, expr_info) | ArrayTypeTraitExpr (_, _, expr_info) | AsTypeExpr (_, _, expr_info)
| AtomicExpr(_, _, expr_info) | BinaryOperator(_, _, expr_info, _) | AtomicExpr (_, _, expr_info) | BinaryOperator (_, _, expr_info, _)
| CompoundAssignOperator(_, _, expr_info, _, _) | CompoundAssignOperator (_, _, expr_info, _, _)
| BlockExpr(_, _, expr_info, _) | CXXBindTemporaryExpr (_, _ , expr_info, _) | BlockExpr (_, _, expr_info, _) | CXXBindTemporaryExpr (_, _ , expr_info, _)
| CXXBoolLiteralExpr (_, _, expr_info, _) | CXXConstructExpr (_, _, expr_info, _) | CXXBoolLiteralExpr (_, _, expr_info, _) | CXXConstructExpr (_, _, expr_info, _)
| CXXTemporaryObjectExpr (_, _, expr_info, _) | CXXDefaultArgExpr (_, _, expr_info) | CXXTemporaryObjectExpr (_, _, expr_info, _) | CXXDefaultArgExpr (_, _, expr_info)
| CXXDefaultInitExpr (_, _, expr_info) | CXXDeleteExpr (_, _, expr_info, _) | CXXDefaultInitExpr (_, _, expr_info) | CXXDeleteExpr (_, _, expr_info, _)
@ -136,7 +135,7 @@ let cut_struct_union s =
match buf with match buf with
| "struct":: l (*-> Printing.string_from_list l *) | "struct":: l (*-> Printing.string_from_list l *)
| "class":: l | "class":: l
| "union":: l -> string_from_list l | "union":: l -> General_utils.string_from_list l
| _ -> s | _ -> s
let get_name_from_struct s = let get_name_from_struct s =

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

@ -10,9 +10,7 @@
(** Processes types and record declarations by adding them to the tenv *) (** Processes types and record declarations by adding them to the tenv *)
open Utils open Utils
open Clang_ast_t
open CFrontend_utils open CFrontend_utils
open CFrontend_utils.General_utils
module L = Logging module L = Logging
exception Typename_not_found exception Typename_not_found
@ -86,10 +84,10 @@ let string_type_to_sil_type tenv s =
let s = (match Str.split (Str.regexp "[ \t]+") s with let s = (match Str.split (Str.regexp "[ \t]+") s with
| "struct"::"(anonymous":: "struct":: s' -> | "struct"::"(anonymous":: "struct":: s' ->
(*Printing.log_out " ...Getting rid of the extra 'struct' word@."; *) (*Printing.log_out " ...Getting rid of the extra 'struct' word@."; *)
string_from_list ("struct"::"(anonymous":: s') General_utils.string_from_list ("struct"::"(anonymous":: s')
| "union"::"(anonymous":: "union":: s' -> | "union"::"(anonymous":: "union":: s' ->
(*Printing.log_out " ...Getting rid of the extra 'union' word@."; *) (*Printing.log_out " ...Getting rid of the extra 'union' word@."; *)
string_from_list ("union"::"(anonymous":: s') General_utils.string_from_list ("union"::"(anonymous":: s')
| _ -> s) in | _ -> s) in
let lexbuf = Lexing.from_string s in let lexbuf = Lexing.from_string s in
let t = let t =
@ -140,6 +138,7 @@ let get_record_name opt_type = match opt_type with
let get_method_decls parent decl_list = let get_method_decls parent decl_list =
let open Clang_ast_t in
let rec traverse_decl parent decl = match decl with let rec traverse_decl parent decl = match decl with
| CXXMethodDecl _ -> [(parent, decl)] | CXXMethodDecl _ -> [(parent, decl)]
| CXXRecordDecl (_, _, _, _, decl_list', _, _, _) | CXXRecordDecl (_, _, _, _, decl_list', _, _, _)
@ -195,12 +194,13 @@ and do_typedef_declaration tenv namespace decl_info name opt_type typedef_decl_i
Sil.tenv_add tenv typename typ Sil.tenv_add tenv typename typ
and get_struct_fields tenv record_name namespace decl_list = and get_struct_fields tenv record_name namespace decl_list =
let open Clang_ast_t in
match decl_list with match decl_list with
| [] -> [] | [] -> []
| FieldDecl(decl_info, name_info, qual_type, field_decl_info):: decl_list' -> | FieldDecl(decl_info, name_info, qual_type, field_decl_info):: decl_list' ->
let field_name = name_info.Clang_ast_t.ni_name in let field_name = name_info.Clang_ast_t.ni_name in
Printing.log_out " ...Defining field '%s'.\n" field_name; Printing.log_out " ...Defining field '%s'.\n" field_name;
let id = mk_class_field_name record_name field_name in let id = General_utils.mk_class_field_name record_name field_name in
let typ = qual_type_to_sil_type tenv qual_type in let typ = qual_type_to_sil_type tenv qual_type 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):: get_struct_fields tenv record_name namespace decl_list' (id, typ, annotation_items):: get_struct_fields tenv record_name namespace decl_list'
@ -215,10 +215,10 @@ and get_struct_fields tenv record_name namespace decl_list =
and get_class_methods tenv class_name namespace decl_list = and get_class_methods tenv class_name namespace decl_list =
let process_method_decl = function let process_method_decl = function
| CXXMethodDecl (decl_info, name_info, qual_type, function_decl_info) -> | Clang_ast_t.CXXMethodDecl (decl_info, name_info, qual_type, function_decl_info) ->
let method_name = name_info.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 = mk_procname_from_cpp_method class_name method_name (CTypes.get_type qual_type) in let method_proc = General_utils.mk_procname_from_cpp_method class_name method_name (CTypes.get_type qual_type) in
Some method_proc Some method_proc
| _ -> None in | _ -> None in
(* poor mans list_filter_map *) (* poor mans list_filter_map *)
@ -241,7 +241,7 @@ and get_declaration_type tenv namespace decl_info n opt_type decl_list decl_cont
Printing.log_out "Record Declaration '%s' defined as struct\n" n; Printing.log_out "Record Declaration '%s' defined as struct\n" n;
let non_static_fields = get_struct_fields tenv name_str namespace decl_list in let non_static_fields = get_struct_fields tenv name_str namespace decl_list in
let non_static_fields = if CTrans_models.is_objc_memory_model_controlled n then let non_static_fields = if CTrans_models.is_objc_memory_model_controlled n then
append_no_duplicates_fields [Sil.objc_ref_counter_field] non_static_fields General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] non_static_fields
else non_static_fields in else non_static_fields in
let non_static_fields = CFrontend_utils.General_utils.sort_fields non_static_fields in let non_static_fields = CFrontend_utils.General_utils.sort_fields non_static_fields in
let static_fields = [] in (* Warning for the moment we do not treat static field. *) let static_fields = [] in (* Warning for the moment we do not treat static field. *)
@ -264,6 +264,7 @@ and add_late_defined_record tenv namespace typename =
Printing.log_out "!!!! Calling late-defined record '%s'\n" (Sil.typename_to_string typename) ; Printing.log_out "!!!! Calling late-defined record '%s'\n" (Sil.typename_to_string typename) ;
match typename with match typename with
| Sil.TN_csu(Sil.Struct, name) | Sil.TN_csu(Sil.Union, name) -> | Sil.TN_csu(Sil.Struct, name) | Sil.TN_csu(Sil.Union, name) ->
let open Clang_ast_t in
let rec scan decls = let rec scan decls =
match decls with match decls with
| [] -> false | [] -> false
@ -300,6 +301,7 @@ and add_late_defined_typedef tenv namespace typename =
match typename with match typename with
| Sil.TN_typedef name -> | Sil.TN_typedef name ->
let rec scan decls = let rec scan decls =
let open Clang_ast_t in
match decls with match decls with
| [] -> false | [] -> false
| TypedefDecl (decl_info, name_info, opt_type, _, tdi) :: decls' -> | TypedefDecl (decl_info, name_info, opt_type, _, tdi) :: decls' ->

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

@ -12,7 +12,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open Clang_ast_t
module L = Logging module L = Logging
@ -43,7 +42,8 @@ let rec lookup_ahead_for_vardecl context pointer var_name kind decl_list =
match decl_list with match decl_list with
| [] -> Printing.log_out " Failing when looking ahead for variable '%s'\n" var_name; | [] -> Printing.log_out " Failing when looking ahead for variable '%s'\n" var_name;
assert false (* nothing has been found ahead, maybe something bad in the AST *) assert false (* nothing has been found ahead, maybe something bad in the AST *)
| VarDecl(decl_info, var_info, t, _) :: rest when var_name = var_info.Clang_ast_t.ni_name -> | Clang_ast_t.VarDecl (decl_info, var_info, t, _) :: rest
when var_name = var_info.Clang_ast_t.ni_name ->
let var_name' = var_info.Clang_ast_t.ni_name in let var_name' = var_info.Clang_ast_t.ni_name in
if global_to_be_added decl_info then ( if global_to_be_added decl_info then (
let tenv = CContext.get_tenv context in let tenv = CContext.get_tenv context in
@ -103,11 +103,12 @@ let lookup_var stmt_info context pointer var_name kind =
(* in the reference instructions, all the variable names are also saved in a map from pointers *) (* in the reference instructions, all the variable names are also saved in a map from pointers *)
(* to variable names to be used in the translation of the method's body. *) (* to variable names to be used in the translation of the method's body. *)
let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit = let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit =
let open Clang_ast_t in
match stmt with match stmt with
| DeclStmt(_, lstmt, decl_list) -> | DeclStmt (_, lstmt, decl_list) ->
get_variables_decls context decl_list; get_variables_decls context decl_list;
get_fun_locals context lstmt; get_fun_locals context lstmt;
| DeclRefExpr(stmt_info, stmt_list, expr_info, decl_ref_expr_info) -> | DeclRefExpr (stmt_info, stmt_list, expr_info, decl_ref_expr_info) ->
(* Notice that DeclRefExpr is the reference to a declared var/function/enum... *) (* Notice that DeclRefExpr is the reference to a declared var/function/enum... *)
(* so no declaration here *) (* so no declaration here *)
Printing.log_out "Collecting variables, passing from DeclRefExpr '%s'\n" Printing.log_out "Collecting variables, passing from DeclRefExpr '%s'\n"
@ -119,11 +120,11 @@ let rec get_variables_stmt context (stmt : Clang_ast_t.stmt) : unit =
| _ -> | _ ->
let pvar = lookup_var stmt_info context stmt_info.Clang_ast_t.si_pointer var_name kind in let pvar = lookup_var stmt_info context stmt_info.Clang_ast_t.si_pointer var_name kind in
CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar context) CContext.LocalVars.add_pointer_var stmt_info.Clang_ast_t.si_pointer pvar context)
| CompoundStmt(stmt_info, lstmt) -> | CompoundStmt (stmt_info, lstmt) ->
Printing.log_out "Collecting variables, passing from CompoundStmt '%s'\n" Printing.log_out "Collecting variables, passing from CompoundStmt '%s'\n"
stmt_info.Clang_ast_t.si_pointer; stmt_info.Clang_ast_t.si_pointer;
CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt
| ForStmt(stmt_info, lstmt) -> | ForStmt (stmt_info, lstmt) ->
Printing.log_out "Collecting variables, passing from ForStmt '%s'\n" Printing.log_out "Collecting variables, passing from ForStmt '%s'\n"
stmt_info.Clang_ast_t.si_pointer; stmt_info.Clang_ast_t.si_pointer;
CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt CContext.LocalVars.enter_and_leave_scope context get_fun_locals lstmt
@ -141,6 +142,7 @@ and get_fun_locals context (stmts : Clang_ast_t.stmt list) : unit =
(* Collects the local of a function. *) (* Collects the local of a function. *)
and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit = 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
match decl with match decl with
| VarDecl (decl_info, name_info, qual_type, var_decl_info) -> | VarDecl (decl_info, name_info, qual_type, 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;
@ -156,8 +158,8 @@ and get_variables_decls context (decl_list : Clang_ast_t.decl list) : unit =
| _ -> | _ ->
CContext.LocalVars.add_local_var context name typ decl_info.Clang_ast_t.di_pointer CContext.LocalVars.add_local_var context name typ decl_info.Clang_ast_t.di_pointer
(CFrontend_utils.General_utils.is_static_var var_decl_info)) (CFrontend_utils.General_utils.is_static_var var_decl_info))
| CXXRecordDecl(di, n_info, ot, _, dl, dci, rdi, _) | CXXRecordDecl (di, n_info, ot, _, dl, dci, rdi, _)
| RecordDecl(di, n_info, ot, _, dl, dci, rdi) -> | RecordDecl (di, n_info, ot, _, dl, dci, rdi) ->
let typ = CTypes_decl.get_declaration_type context.CContext.tenv context.CContext.namespace let typ = CTypes_decl.get_declaration_type context.CContext.tenv context.CContext.namespace
di n_info.Clang_ast_t.ni_name ot dl dci rdi in di n_info.Clang_ast_t.ni_name ot dl dci rdi in
CTypes_decl.add_struct_to_tenv context.CContext.tenv typ CTypes_decl.add_struct_to_tenv context.CContext.tenv typ

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

@ -16,8 +16,6 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CFrontend_utils.General_utils
open Clang_ast_t
module L = Logging module L = Logging
@ -108,14 +106,14 @@ let add_class_to_tenv tenv class_name decl_list obj_c_interface_decl_info =
let fields, superclasses, methods = let fields, superclasses, methods =
match Sil.tenv_lookup tenv interface_name with match Sil.tenv_lookup tenv interface_name with
| Some Sil.Tstruct(saved_fields, _, _, _, saved_superclasses, saved_methods, _) -> | Some Sil.Tstruct(saved_fields, _, _, _, saved_superclasses, saved_methods, _) ->
append_no_duplicates_fields fields saved_fields, General_utils.append_no_duplicates_fields fields saved_fields,
append_no_duplicates_csu superclasses saved_superclasses, General_utils.append_no_duplicates_csu superclasses saved_superclasses,
append_no_duplicates_methods methods saved_methods General_utils.append_no_duplicates_methods methods saved_methods
| _ -> fields, superclasses, methods in | _ -> fields, superclasses, methods in
let fields = append_no_duplicates_fields fields fields_sc in let fields = General_utils.append_no_duplicates_fields fields fields_sc in
(* We add the special hidden counter_field for implementing reference counting *) (* We add the special hidden counter_field for implementing reference counting *)
let fields = append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in let fields = General_utils.append_no_duplicates_fields [Sil.objc_ref_counter_field] fields in
let fields = CFrontend_utils.General_utils.sort_fields fields in let fields = General_utils.sort_fields fields in
Printing.log_out "Class %s field:\n" class_name; Printing.log_out "Class %s field:\n" class_name;
list_iter (fun (fn, ft, _) -> list_iter (fun (fn, ft, _) ->
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
@ -162,13 +160,14 @@ let interface_impl_declaration tenv class_name decl_list idi =
(* ...Full definition of the interface I *) (* ...Full definition of the interface I *)
let lookup_late_defined_interface tenv cname = let lookup_late_defined_interface tenv cname =
let rec scan decls = let rec scan decls =
let open Clang_ast_t in
match decls with match decls with
| [] -> () | [] -> ()
| ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info) | ObjCInterfaceDecl (decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
:: decls' :: decls'
when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname -> when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname ->
scan decls' scan decls'
| ObjCInterfaceDecl(decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info) | ObjCInterfaceDecl (decl_info, name_info, decl_list, decl_context_info, obj_c_interface_decl_info)
:: decls' :: decls'
when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname -> when (Mangled.from_string name_info.Clang_ast_t.ni_name) = cname ->
(* Assumption: here we assume that the first interface declaration with non empty set of fields is the *) (* Assumption: here we assume that the first interface declaration with non empty set of fields is the *)

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

@ -17,8 +17,7 @@
open Utils open Utils
open CFrontend_utils open CFrontend_utils
open CFrontend_config
open Clang_ast_t
module L = Logging module L = Logging
open CContext open CContext
@ -122,11 +121,11 @@ struct
let print_item key (qt, attributes, decl_info, getter, setter, ivar) = let print_item key (qt, attributes, decl_info, getter, setter, ivar) =
let getter_str = let getter_str =
match getter with match getter with
| getter_name, Some (ObjCMethodDecl(_, _, _), defined1) -> | getter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined1) ->
getter_name getter_name
| _ -> "" in | _ -> "" in
let setter_str = match setter with let setter_str = match setter with
| setter_name, Some (ObjCMethodDecl(_, _, _), defined2) -> | setter_name, Some (Clang_ast_t.ObjCMethodDecl _, defined2) ->
setter_name setter_name
| _ -> "" in | _ -> "" in
Logging.out "Property item %s accessors %s and %s \n" Logging.out "Property item %s accessors %s and %s \n"
@ -254,7 +253,7 @@ let get_memory_management_attribute attributes =
with Not_found -> None with Not_found -> None
let create_generated_method_name name_info = let create_generated_method_name name_info =
{ ni_name = name_info.Clang_ast_t.ni_name; { Clang_ast_t.ni_name = name_info.Clang_ast_t.ni_name;
ni_qual_name = CFrontend_config.generated_suffix:: name_info.Clang_ast_t.ni_qual_name; ni_qual_name = CFrontend_config.generated_suffix:: name_info.Clang_ast_t.ni_qual_name;
} }
@ -267,6 +266,7 @@ 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 -> | qt, 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
match getter with match getter with
| Some (ObjCMethodDecl(di, name_info, mdi), _) -> | Some (ObjCMethodDecl(di, name_info, mdi), _) ->
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
@ -286,6 +286,7 @@ 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 -> | qt, 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
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
@ -308,12 +309,12 @@ let make_setter curr_class prop_name prop_type =
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, qt_param, decl_ptr) `ParmVar stmt_info in
let retain_call = Ast_expressions.make_message_expr qt_param retain param_decl stmt_info true in let retain_call = Ast_expressions.make_message_expr qt_param CFrontend_config.retain param_decl stmt_info true in
let release_call = Ast_expressions.make_message_expr qt_param release lhs_exp stmt_info true in let release_call = Ast_expressions.make_message_expr qt_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, qt_param, decl_ptr) `ParmVar stmt_info in
let copy_call = Ast_expressions.make_message_expr qt_param copy param_decl stmt_info true in let copy_call = Ast_expressions.make_message_expr qt_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
@ -349,12 +350,12 @@ let make_getter_setter curr_class decl_info prop_name =
let add_properties_to_table curr_class decl_list = let add_properties_to_table curr_class decl_list =
let add_property_to_table dec = let add_property_to_table dec =
match dec with match dec with
| ObjCPropertyDecl(decl_info, name_info, pdi) -> | Clang_ast_t.ObjCPropertyDecl(decl_info, name_info, pdi) ->
(* Property declaration register the property on the property table to be *) (* Property declaration register the property on the property table to be *)
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, pname) pdi.opdi_qual_type pdi.opdi_property_attributes decl_info; Property.add_property (curr_class, pname) pdi.Clang_ast_t.opdi_qual_type 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
@ -364,7 +365,7 @@ let get_methods curr_class decl_list =
add_properties_to_table curr_class decl_list; add_properties_to_table curr_class decl_list;
let get_method decl list_methods = let get_method decl list_methods =
match decl with match decl with
ObjCMethodDecl(decl_info, name_info, method_decl_info) -> | Clang_ast_t.ObjCMethodDecl (decl_info, name_info, method_decl_info) ->
let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in let is_instance = method_decl_info.Clang_ast_t.omdi_is_instance_method in
let method_kind = Procname.objc_method_kind_of_bool is_instance in let method_kind = Procname.objc_method_kind_of_bool is_instance in
let method_name = name_info.Clang_ast_t.ni_name in let method_name = name_info.Clang_ast_t.ni_name in

Write Preview
Loading…
Cancel
Save