Making signature of predicates uniform

Reviewed By: martinoluca

Differential Revision: D4507368

fbshipit-source-id: 4957426
master
Dino Distefano 8 years ago committed by Facebook Github Bot
parent 319e3ed271
commit fb14d31bb7

@ -12,10 +12,10 @@ open! PVariant
let get_source_range an =
match an with
| CTL.Decl decl ->
| Ctl_parser_types.Decl decl ->
let decl_info = Clang_ast_proj.get_decl_tuple decl in
decl_info.Clang_ast_t.di_source_range
| CTL.Stmt stmt ->
| Ctl_parser_types.Stmt stmt ->
let stmt_info, _ = Clang_ast_proj.get_stmt_tuple stmt in
stmt_info.Clang_ast_t.si_source_range
@ -103,7 +103,7 @@ let mutable_local_vars_advice context an =
| _ -> false in
match an with
| CTL.Decl (Clang_ast_t.VarDecl(decl_info, named_decl_info, qual_type, _) as decl)->
| Ctl_parser_types.Decl (Clang_ast_t.VarDecl(decl_info, named_decl_info, qual_type, _) as decl)->
let is_const_ref = match CAst_utils.get_type qual_type.qt_type_ptr with
| Some LValueReferenceType (_, {Clang_ast_t.qt_is_const}) ->
qt_is_const
@ -137,7 +137,7 @@ let component_factory_function_advice context an =
CAst_utils.is_objc_if_descendant decl [CFrontend_config.ckcomponent_cl] in
match an with
| CTL.Decl (Clang_ast_t.FunctionDecl (decl_info, _, (qual_type: Clang_ast_t.qual_type), _)) ->
| Ctl_parser_types.Decl (Clang_ast_t.FunctionDecl (decl_info, _, (qual_type: Clang_ast_t.qual_type), _)) ->
let objc_interface =
CAst_utils.type_ptr_to_objc_interface qual_type.qt_type_ptr in
let condition =
@ -203,7 +203,7 @@ let component_with_unconventional_superclass_advice context an =
CTL.False, None
| _ -> assert false in
match an with
| CTL.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) ->
| Ctl_parser_types.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) ->
let if_decl_opt =
CAst_utils.get_decl_opt_with_decl_ref impl_decl_info.oidi_class_interface in
if Option.is_some if_decl_opt && is_ck_context context an then
@ -253,7 +253,7 @@ let component_with_multiple_factory_methods_advice context an =
}) (IList.drop_first 1 factory_methods)
| _ -> assert false in
match an with
| CTL.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) ->
| Ctl_parser_types.Decl (Clang_ast_t.ObjCImplementationDecl (_, _, _, _, impl_decl_info)) ->
let if_decl_opt =
CAst_utils.get_decl_opt_with_decl_ref impl_decl_info.oidi_class_interface in
(match if_decl_opt with
@ -281,7 +281,7 @@ let rec _component_initializer_with_side_effects_advice
in_ck_class context
&& context.in_objc_static_factory_method
&& (match context.current_objc_impl with
| Some d -> is_in_main_file context.translation_unit_context (CTL.Decl d)
| Some d -> is_in_main_file context.translation_unit_context (Ctl_parser_types.Decl d)
| None -> false) in
if condition then
match call_stmt with
@ -313,7 +313,7 @@ let rec _component_initializer_with_side_effects_advice
let component_initializer_with_side_effects_advice
(context: CLintersContext.context) an =
match an with
| CTL.Stmt (CallExpr (_, called_func_stmt :: _, _)) ->
| Ctl_parser_types.Stmt (CallExpr (_, called_func_stmt :: _, _)) ->
_component_initializer_with_side_effects_advice context called_func_stmt
| _ -> CTL.False, None (* only to be called in CallExpr *)
@ -324,7 +324,7 @@ let component_initializer_with_side_effects_advice
let component_file_line_count_info (context: CLintersContext.context) dec =
let condition = Config.compute_analytics && context.is_ck_translation_unit in
match dec with
| CTL.Decl Clang_ast_t.TranslationUnitDecl _ when condition ->
| Ctl_parser_types.Decl Clang_ast_t.TranslationUnitDecl _ when condition ->
let source_file =
context.translation_unit_context.CFrontend_config.source_file in
let line_count = SourceFile.line_count source_file in
@ -364,11 +364,11 @@ let component_file_cyclomatic_complexity_info (context: CLintersContext.context)
List.mem ~equal:(=) [`LAnd; `LOr] boi.Clang_ast_t.boi_kind
| _ -> false in
let cyclo_loc_opt an = match an with
| CTL.Stmt stmt when (Config.compute_analytics
&& is_cyclo_stmt stmt
&& is_ck_context context an) ->
| Ctl_parser_types.Stmt stmt when (Config.compute_analytics
&& is_cyclo_stmt stmt
&& is_ck_context context an) ->
Some (CFrontend_checkers.location_from_stmt context stmt)
| CTL.Decl (Clang_ast_t.TranslationUnitDecl _ as d)
| Ctl_parser_types.Decl (Clang_ast_t.TranslationUnitDecl _ as d)
when Config.compute_analytics && context.is_ck_translation_unit ->
Some (CFrontend_checkers.location_from_decl context d)
| _ -> None in

@ -17,22 +17,22 @@ open! IStd
val contains_ck_impl : Clang_ast_t.decl list -> bool
val mutable_local_vars_advice :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc option
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc option
val component_factory_function_advice :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc option
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc option
val component_with_unconventional_superclass_advice :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc option
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc option
val component_with_multiple_factory_methods_advice :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc list
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc list
val component_initializer_with_side_effects_advice :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc option
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc option
val component_file_line_count_info :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc list
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc list
val component_file_cyclomatic_complexity_info :
CLintersContext.context -> CTL.ast_node -> CTL.t * CIssue.issue_desc option
CLintersContext.context -> Ctl_parser_types.ast_node -> CTL.t * CIssue.issue_desc option

@ -37,12 +37,12 @@ let location_from_decl lctx dec =
let location_from_an lcxt an =
match an with
| CTL.Stmt st -> location_from_stmt lcxt st
| CTL.Decl d -> location_from_decl lcxt d
| Ctl_parser_types.Stmt st -> location_from_stmt lcxt st
| Ctl_parser_types.Decl d -> location_from_decl lcxt d
let decl_name an =
match an with
| CTL.Decl dec ->
| Ctl_parser_types.Decl dec ->
(match Clang_ast_proj.get_named_decl_tuple dec with
| Some (_, n) -> n.Clang_ast_t.ni_name
| None -> "")
@ -50,14 +50,14 @@ let decl_name an =
let tag_name_of_node an =
match an with
| CTL.Stmt stmt -> Clang_ast_proj.get_stmt_kind_string stmt
| CTL.Decl decl -> Clang_ast_proj.get_decl_kind_string decl
| Ctl_parser_types.Stmt stmt -> Clang_ast_proj.get_stmt_kind_string stmt
| Ctl_parser_types.Decl decl -> Clang_ast_proj.get_decl_kind_string decl
let decl_ref_or_selector_name an =
match CTL.next_state_via_transition an (Some CTL.PointerToDecl) with
| Some (CTL.Decl ObjCMethodDecl _ as decl_an) ->
| Some (Ctl_parser_types.Decl ObjCMethodDecl _ as decl_an) ->
"The selector " ^ (decl_name decl_an)
| Some (CTL.Decl _ as decl_an) ->
| Some (Ctl_parser_types.Decl _ as decl_an) ->
"The reference " ^ (decl_name decl_an)
| _ -> failwith("decl_ref_or_selector_name must be called with a DeclRefExpr \
or an ObjCMessageExpr, but got " ^ (tag_name_of_node an))
@ -68,9 +68,10 @@ let iphoneos_target_sdk_version _ =
| None -> "0"
let available_ios_sdk an =
let open Ctl_parser_types in
match CTL.next_state_via_transition an (Some CTL.PointerToDecl) with
| Some CTL.Decl decl ->
(match CPredicates.get_available_attr_ios_sdk decl with
| Some Decl decl ->
(match CPredicates.get_available_attr_ios_sdk (Decl decl) with
| Some version -> version
| None -> "")
| _ -> failwith("available_ios_sdk must be called with a DeclRefExpr \
@ -79,7 +80,7 @@ let available_ios_sdk an =
let ivar_name an =
let open Clang_ast_t in
match an with
| CTL.Stmt (ObjCIvarRefExpr (_, _, _, rei)) ->
| Ctl_parser_types.Stmt (ObjCIvarRefExpr (_, _, _, rei)) ->
let dr_ref = rei.ovrei_decl_ref in
let ivar_pointer = dr_ref.dr_decl_pointer in
(match CAst_utils.get_decl ivar_pointer with
@ -89,11 +90,13 @@ let ivar_name an =
| _ -> ""
let cxx_ref_captured_in_block an =
let open Ctl_parser_types in
let open Clang_ast_t in
let capt_refs = match an with
| CTL.Decl d -> CPredicates.captured_variables_cxx_ref d
| CTL.Stmt (Clang_ast_t.BlockExpr(_, _, _, d)) ->
CPredicates.captured_variables_cxx_ref d
| Decl _ -> CPredicates.captured_variables_cxx_ref an
| Stmt (BlockExpr(_, _, _, d)) ->
CPredicates.captured_variables_cxx_ref (Decl d)
| _ -> [] in
let var_desc vars var_named_decl_info =
vars ^ "'" ^ var_named_decl_info.Clang_ast_t.ni_name ^ "'" in
vars ^ "'" ^ var_named_decl_info.ni_name ^ "'" in
IList.fold_left var_desc "" capt_refs

@ -16,21 +16,21 @@ val location_from_dinfo :
CLintersContext.context -> Clang_ast_t.decl_info -> Location.t
val location_from_an :
CLintersContext.context -> CTL.ast_node -> Location.t
CLintersContext.context -> Ctl_parser_types.ast_node -> Location.t
val location_from_decl :
CLintersContext.context -> Clang_ast_t.decl -> Location.t
val decl_name : CTL.ast_node -> string
val decl_name : Ctl_parser_types.ast_node -> string
val ivar_name : CTL.ast_node -> string
val ivar_name : Ctl_parser_types.ast_node -> string
val cxx_ref_captured_in_block : CTL.ast_node -> string
val cxx_ref_captured_in_block : Ctl_parser_types.ast_node -> string
val decl_ref_or_selector_name : CTL.ast_node -> string
val decl_ref_or_selector_name : Ctl_parser_types.ast_node -> string
val iphoneos_target_sdk_version : CTL.ast_node -> string
val iphoneos_target_sdk_version : Ctl_parser_types.ast_node -> string
val available_ios_sdk : CTL.ast_node -> string
val available_ios_sdk : Ctl_parser_types.ast_node -> string
val tag_name_of_node : CTL.ast_node -> string
val tag_name_of_node : Ctl_parser_types.ast_node -> string

@ -36,7 +36,7 @@ let parse_ctl_file linters_files =
Logging.out "#### Start Expanding checkers #####\n";
let exp_checkers = CFrontend_errors.expand_checkers parsed_checkers in
Logging.out "#### Checkers Expanded #####\n";
if Config.debug_mode then IList.iter Ctl_parser_types.print_checker exp_checkers;
if Config.debug_mode then IList.iter CTL.print_checker exp_checkers;
CFrontend_errors.make_condition_issue_desc_pair exp_checkers;
| None -> Logging.out "No linters found.\n");
In_channel.close inx) linters_files
@ -84,7 +84,7 @@ let rec do_frontend_checks_stmt (context:CLintersContext.context) stmt =
IList.iter (do_frontend_checks_decl context) [decl]
| _ -> ());
do_frontend_checks_stmt context stmt in
CFrontend_errors.invoke_set_of_checkers_on_node context (CTL.Stmt stmt);
CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Stmt stmt);
match stmt with
| ObjCAtSynchronizedStmt (_, stmt_list) ->
let stmt_context = { context with CLintersContext.in_synchronized_block = true } in
@ -104,7 +104,7 @@ let rec do_frontend_checks_stmt (context:CLintersContext.context) stmt =
and do_frontend_checks_decl (context: CLintersContext.context) decl =
let open Clang_ast_t in
CFrontend_errors.invoke_set_of_checkers_on_node context (CTL.Decl decl);
CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Decl decl);
match decl with
| FunctionDecl(_, _, _, fdi)
| CXXMethodDecl (_, _, _, fdi, _)
@ -166,7 +166,7 @@ let do_frontend_checks trans_unit_ctx ast =
CLocation.should_do_frontend_check trans_unit_ctx decl_info.Clang_ast_t.di_source_range in
let allowed_decls = IList.filter is_decl_allowed decl_list in
(* We analyze the top level and then all the allowed declarations *)
CFrontend_errors.invoke_set_of_checkers_on_node context (CTL.Decl ast);
CFrontend_errors.invoke_set_of_checkers_on_node context (Ctl_parser_types.Decl ast);
IList.iter (do_frontend_checks_decl context) allowed_decls;
if (LintIssues.exists_issues ()) then
store_issues source_file;

@ -91,11 +91,12 @@ let string_to_issue_mode m =
(** Convert a parsed checker in a pair (condition, issue_desc) *)
let make_condition_issue_desc_pair checkers =
let open CIssue in
let open CTL in
let open Ctl_parser_types in
Logging.out "\n Converting checkers in (condition, issue) pairs\n";
let do_one_checker c =
let dummy_issue = {
name = c.Ctl_parser_types.name;
name = c.name;
description = "";
suggestion = None;
loc = Location.dummy;
@ -114,10 +115,10 @@ let make_condition_issue_desc_pair checkers =
{issue' with severity = string_to_err_kind sev}, cond'
| CDesc (s, m) when String.equal s mode_const ->
{issue' with mode = string_to_issue_mode m }, cond'
| _ -> issue', cond') (dummy_issue, CTL.False) c.Ctl_parser_types.definitions in
| _ -> issue', cond') (dummy_issue, CTL.False) c.definitions in
if Config.debug_mode then (
Logging.out "\nMaking condition and issue desc for checker '%s'\n"
c.Ctl_parser_types.name;
c.name;
Logging.out "\nCondition =\n %a\n" CTL.Debug.pp_formula condition;
Logging.out "\nIssue_desc = %a\n" CIssue.pp_issue issue);
condition, issue in
@ -160,7 +161,7 @@ let expand_checkers checkers =
let map : CTL.t Core.Std.String.Map.t = Core.Std.String.Map.empty in
let map = IList.fold_left (fun map' d -> match d with
| CLet (k,formula) -> Core.Std.Map.add map' ~key:k ~data:formula
| _ -> map') map c.Ctl_parser_types.definitions in
| _ -> map') map c.definitions in
let exp_defs = IList.fold_left (fun defs clause ->
match clause with
| CSet (report_when_const, phi) ->
@ -192,15 +193,15 @@ let log_frontend_issue translation_unit_context method_decl_opt key issue_desc =
Reporting.log_issue_from_errlog err_kind errlog exn ~loc ~ltr:trace
~node_id:(0, key)
let get_current_method context an =
let get_current_method context (an : Ctl_parser_types.ast_node) =
match an with
| CTL.Decl (FunctionDecl _ as d)
| CTL.Decl (CXXMethodDecl _ as d)
| CTL.Decl (CXXConstructorDecl _ as d)
| CTL.Decl (CXXConversionDecl _ as d)
| CTL.Decl (CXXDestructorDecl _ as d)
| CTL.Decl (ObjCMethodDecl _ as d)
| CTL.Decl (BlockDecl _ as d) -> Some d
| Decl (FunctionDecl _ as d)
| Decl (CXXMethodDecl _ as d)
| Decl (CXXConstructorDecl _ as d)
| Decl (CXXConversionDecl _ as d)
| Decl (CXXDestructorDecl _ as d)
| Decl (ObjCMethodDecl _ as d)
| Decl (BlockDecl _ as d) -> Some d
| _ -> context.CLintersContext.current_method
let fill_issue_desc_info_and_log context an key issue_desc loc =
@ -211,10 +212,10 @@ let fill_issue_desc_info_and_log context an key issue_desc loc =
(get_current_method context an) key issue_desc'
(* Calls the set of hard coded checkers (if any) *)
let invoke_set_of_hard_coded_checkers_an context an =
let invoke_set_of_hard_coded_checkers_an context (an : Ctl_parser_types.ast_node) =
let checkers, key = match an with
| CTL.Decl dec -> decl_checkers_list, CAst_utils.generate_key_decl dec
| CTL.Stmt st -> stmt_checkers_list, CAst_utils.generate_key_stmt st in
| Decl dec -> decl_checkers_list, CAst_utils.generate_key_decl dec
| Stmt st -> stmt_checkers_list, CAst_utils.generate_key_stmt st in
IList.iter (fun checker ->
let condition, issue_desc_list = checker context an in
if CTL.eval_formula condition an context then
@ -226,10 +227,10 @@ let invoke_set_of_hard_coded_checkers_an context an =
) checkers
(* Calls the set of checkers parsed from files (if any) *)
let invoke_set_of_parsed_checkers_an context an =
let invoke_set_of_parsed_checkers_an context (an : Ctl_parser_types.ast_node) =
let key = match an with
| CTL.Decl dec -> CAst_utils.generate_key_decl dec
| CTL.Stmt st -> CAst_utils.generate_key_stmt st in
| Decl dec -> CAst_utils.generate_key_decl dec
| Stmt st -> CAst_utils.generate_key_stmt st in
IList.iter (fun (condition, issue_desc) ->
if CIssue.should_run_check issue_desc.CIssue.mode &&
CTL.eval_formula condition an context then

@ -13,9 +13,9 @@ open! IStd
(* Module for warnings detected at translation time by the frontend *)
(* Run frontend checkers on an AST node *)
val invoke_set_of_checkers_on_node : CLintersContext.context -> CTL.ast_node -> unit
val invoke_set_of_checkers_on_node : CLintersContext.context -> Ctl_parser_types.ast_node -> unit
val expand_checkers : Ctl_parser_types.ctl_checker list -> Ctl_parser_types.ctl_checker list
val expand_checkers : CTL.ctl_checker list -> CTL.ctl_checker list
val make_condition_issue_desc_pair :
Ctl_parser_types.ctl_checker list -> unit
CTL.ctl_checker list -> unit

@ -9,20 +9,23 @@
open! IStd
let get_available_attr_ios_sdk decl =
let get_available_attr_ios_sdk an =
let open Clang_ast_t in
let decl_info = Clang_ast_proj.get_decl_tuple decl in
let rec get_available_attr attrs =
match attrs with
| [] -> None
| AvailabilityAttr attr_info :: _ ->
(match attr_info.Clang_ast_t.ai_parameters with
(match attr_info.ai_parameters with
| "ios" :: version :: _ ->
Some (String.Search_pattern.replace_all
(String.Search_pattern.create "_") ~in_:version ~with_:".")
| _ -> None)
| _ :: rest -> get_available_attr rest in
get_available_attr decl_info.Clang_ast_t.di_attributes
match an with
| Ctl_parser_types.Decl decl ->
let decl_info = Clang_ast_proj.get_decl_tuple decl in
get_available_attr decl_info.di_attributes
| _ -> None
let get_ivar_attributes ivar_decl =
let open Clang_ast_t in
@ -35,7 +38,8 @@ let get_ivar_attributes ivar_decl =
| _ -> []
(* list of cxx references captured by decl *)
let captured_variables_cxx_ref dec =
let captured_variables_cxx_ref an =
let open Clang_ast_t in
let capture_var_is_cxx_ref reference_captured_vars captured_var =
let decl_ref_opt = captured_var.Clang_ast_t.bcv_variable in
match CAst_utils.get_decl_opt_with_decl_ref decl_ref_opt with
@ -47,11 +51,11 @@ let captured_variables_cxx_ref dec =
named_decl_info::reference_captured_vars
| _ -> reference_captured_vars)
| _ -> reference_captured_vars in
let captured_vars = match dec with
| Clang_ast_t.BlockDecl (_, bdi) ->
bdi.Clang_ast_t.bdi_captured_variables
| _ -> [] in
IList.fold_left capture_var_is_cxx_ref [] captured_vars
match an with
| Ctl_parser_types.Decl (BlockDecl (_, bdi)) ->
IList.fold_left capture_var_is_cxx_ref [] bdi.bdi_captured_variables
| _ -> []
@ -64,28 +68,36 @@ let is_declaration_kind decl s =
String.equal (Clang_ast_proj.get_decl_kind_string decl) s
(* st |= call_method(m) *)
let call_method m st =
match st with
| Clang_ast_t.ObjCMessageExpr (_, _, _, omei) -> String.equal omei.omei_selector m
let call_method m an =
match an with
| Ctl_parser_types.Stmt (Clang_ast_t.ObjCMessageExpr (_, _, _, omei)) ->
String.equal omei.omei_selector m
| _ -> false
let property_name_contains_word word decl =
match Clang_ast_proj.get_named_decl_tuple decl with
| Some (_, n) -> let pname = n.Clang_ast_t.ni_name in
let rexp = Str.regexp_string_case_fold word in
(try
Str.search_forward rexp pname 0 >= 0
with Not_found -> false)
let property_name_contains_word word an =
match an with
| Ctl_parser_types.Decl decl ->
(match Clang_ast_proj.get_named_decl_tuple decl with
| Some (_, n) -> let pname = n.Clang_ast_t.ni_name in
let rexp = Str.regexp_string_case_fold word in
(try
Str.search_forward rexp pname 0 >= 0
with Not_found -> false)
| _ -> false)
| _ -> false
let is_objc_extension lcxt =
CGeneral_utils.is_objc_extension lcxt.CLintersContext.translation_unit_context
let is_syntactically_global_var decl =
CAst_utils.is_syntactically_global_var decl
let is_syntactically_global_var an =
match an with
| Ctl_parser_types.Decl d -> CAst_utils.is_syntactically_global_var d
| _ -> false
let is_const_expr_var decl =
CAst_utils.is_const_expr_var decl
let is_const_expr_var an =
match an with
| Ctl_parser_types.Decl d -> CAst_utils.is_const_expr_var d
| _ -> false
let decl_ref_is_in names st =
match st with
@ -96,25 +108,28 @@ let decl_ref_is_in names st =
| _ -> false)
| _ -> false
let call_function_named names st =
CAst_utils.exists_eventually_st decl_ref_is_in names st
let call_function_named names an =
match an with
| Ctl_parser_types.Stmt st ->
CAst_utils.exists_eventually_st decl_ref_is_in names st
| _ -> false
let is_strong_property decl =
match decl with
| Clang_ast_t.ObjCPropertyDecl (_, _, pdi) ->
let is_strong_property an =
match an with
| Ctl_parser_types.Decl (Clang_ast_t.ObjCPropertyDecl (_, _, pdi)) ->
ObjcProperty_decl.is_strong_property pdi
| _ -> false
let is_assign_property decl =
match decl with
| Clang_ast_t.ObjCPropertyDecl (_, _, pdi) ->
let is_assign_property an =
match an with
| Ctl_parser_types.Decl (Clang_ast_t.ObjCPropertyDecl (_, _, pdi)) ->
ObjcProperty_decl.is_assign_property pdi
| _ -> false
let is_property_pointer_type decl =
let is_property_pointer_type an =
let open Clang_ast_t in
match decl with
| ObjCPropertyDecl (_, _, pdi) ->
match an with
| Ctl_parser_types.Decl (ObjCPropertyDecl (_, _, pdi)) ->
(match CAst_utils.get_desugared_type pdi.opdi_type_ptr with
| Some MemberPointerType _
| Some ObjCObjectPointerType _
@ -129,9 +144,9 @@ let context_in_synchronized_block context =
context.CLintersContext.in_synchronized_block
(* checks if ivar is defined among a set of fields and if it is atomic *)
let is_ivar_atomic stmt =
match stmt with
| Clang_ast_t.ObjCIvarRefExpr (_, _, _, irei) ->
let is_ivar_atomic an =
match an with
| Ctl_parser_types.Stmt (Clang_ast_t.ObjCIvarRefExpr (_, _, _, irei)) ->
let dr_ref = irei.Clang_ast_t.ovrei_decl_ref in
let ivar_pointer = dr_ref.Clang_ast_t.dr_decl_pointer in
(match CAst_utils.get_decl ivar_pointer with
@ -141,10 +156,10 @@ let is_ivar_atomic stmt =
| _ -> false)
| _ -> false
let is_method_property_accessor_of_ivar stmt context =
let is_method_property_accessor_of_ivar an context =
let open Clang_ast_t in
match stmt with
| ObjCIvarRefExpr (_, _, _, irei) ->
match an with
| Ctl_parser_types.Stmt (ObjCIvarRefExpr (_, _, _, irei)) ->
let dr_ref = irei.Clang_ast_t.ovrei_decl_ref in
let ivar_pointer = dr_ref.Clang_ast_t.dr_decl_pointer in
(match context.CLintersContext.current_method with
@ -180,56 +195,58 @@ let is_objc_dealloc context =
Procname.is_objc_dealloc method_name
| _ -> false
let captures_cxx_references decl =
IList.length (captured_variables_cxx_ref decl) > 0
let captures_cxx_references an =
IList.length (captured_variables_cxx_ref an) > 0
let is_binop_with_kind str_kind stmt =
let is_binop_with_kind str_kind an =
if not (Clang_ast_proj.is_valid_binop_kind_name str_kind) then
failwith ("Binary operator kind " ^ str_kind ^ " is not valid");
match stmt with
| Clang_ast_t.BinaryOperator (_, _, _, boi) ->
match an with
| Ctl_parser_types.Stmt (Clang_ast_t.BinaryOperator (_, _, _, boi)) ->
String.equal (Clang_ast_proj.string_of_binop_kind boi.boi_kind) str_kind
| _ -> false
let is_unop_with_kind str_kind stmt =
let is_unop_with_kind str_kind an =
if not (Clang_ast_proj.is_valid_unop_kind_name str_kind) then
failwith ("Unary operator kind " ^ str_kind ^ " is not valid");
match stmt with
| Clang_ast_t.UnaryOperator (_, _, _, uoi) ->
match an with
| Ctl_parser_types.Stmt (Clang_ast_t.UnaryOperator (_, _, _, uoi)) ->
String.equal (Clang_ast_proj.string_of_unop_kind uoi.uoi_kind) str_kind
| _ -> false
let is_stmt nodename stmt =
if not (Clang_ast_proj.is_valid_astnode_kind nodename) then
failwith ("Statement " ^ nodename ^ " is not a valid statement");
String.equal nodename (Clang_ast_proj.get_stmt_kind_string stmt)
let is_decl nodename decl =
let is_node nodename an =
if not (Clang_ast_proj.is_valid_astnode_kind nodename) then
failwith ("Declaration " ^ nodename ^ " is not a valid declaration");
String.equal nodename (Clang_ast_proj.get_decl_kind_string decl)
let isa classname stmt =
match Clang_ast_proj.get_expr_tuple stmt with
| Some (_, _, expr_info) ->
let typ = CAst_utils.get_desugared_type expr_info.ei_type_ptr in
CAst_utils.is_ptr_to_objc_class typ classname
failwith ("Node " ^ nodename ^ " is not a valid AST node");
let an_str = match an with
| Ctl_parser_types.Stmt s -> Clang_ast_proj.get_stmt_kind_string s
| Ctl_parser_types.Decl d -> Clang_ast_proj.get_decl_kind_string d in
String.equal nodename an_str
let isa classname an =
match an with
| Ctl_parser_types.Stmt stmt ->
(match Clang_ast_proj.get_expr_tuple stmt with
| Some (_, _, expr_info) ->
let typ = CAst_utils.get_desugared_type expr_info.ei_type_ptr in
CAst_utils.is_ptr_to_objc_class typ classname
| _ -> false)
| _ -> false
let decl_unavailable_in_supported_ios_sdk decl =
let available_attr_ios_sdk = get_available_attr_ios_sdk decl in
let decl_unavailable_in_supported_ios_sdk an =
let available_attr_ios_sdk = get_available_attr_ios_sdk an in
match available_attr_ios_sdk, Config.iphoneos_target_sdk_version with
| Some available_attr_ios_sdk, Some iphoneos_target_sdk_version ->
Int.equal (Utils.compare_versions available_attr_ios_sdk iphoneos_target_sdk_version) 1
| _ -> false
let within_responds_to_selector_block (cxt:CLintersContext.context) decl =
let within_responds_to_selector_block (cxt:CLintersContext.context) an =
let open Clang_ast_t in
match decl with
| ObjCMethodDecl (_, named_decl_info, _) ->
match an with
| Ctl_parser_types.Decl (ObjCMethodDecl (_, named_decl_info, _)) ->
(match cxt.if_context with
| Some if_context ->
let in_selector_block = if_context.within_responds_to_selector_block in
List.mem ~equal:String.equal in_selector_block named_decl_info.Clang_ast_t.ni_name
List.mem ~equal:String.equal in_selector_block named_decl_info.ni_name
| None -> false)
| _ -> false

@ -11,52 +11,50 @@ open! IStd
type t = string * string list (* (name, [param1,...,paramK]) *)
val captured_variables_cxx_ref : Clang_ast_t.decl -> Clang_ast_t.named_decl_info list
val captured_variables_cxx_ref : Ctl_parser_types.ast_node -> Clang_ast_t.named_decl_info list
val call_method : string -> Clang_ast_t.stmt -> bool
val call_method : string -> Ctl_parser_types.ast_node -> bool
val property_name_contains_word : string -> Clang_ast_t.decl -> bool
val property_name_contains_word : string -> Ctl_parser_types.ast_node -> bool
val is_objc_extension : CLintersContext.context -> bool
val is_syntactically_global_var : Clang_ast_t.decl -> bool
val is_syntactically_global_var : Ctl_parser_types.ast_node -> bool
val is_const_expr_var : Clang_ast_t.decl -> bool
val is_const_expr_var : Ctl_parser_types.ast_node -> bool
val call_function_named : string list -> Clang_ast_t.stmt -> bool
val call_function_named : string list -> Ctl_parser_types.ast_node -> bool
val is_strong_property : Clang_ast_t.decl -> bool
val is_strong_property : Ctl_parser_types.ast_node -> bool
val is_assign_property : Clang_ast_t.decl -> bool
val is_assign_property : Ctl_parser_types.ast_node -> bool
val is_property_pointer_type : Clang_ast_t.decl -> bool
val is_property_pointer_type : Ctl_parser_types.ast_node -> bool
val context_in_synchronized_block : CLintersContext.context -> bool
val is_ivar_atomic : Clang_ast_t.stmt -> bool
val is_ivar_atomic : Ctl_parser_types.ast_node -> bool
val is_method_property_accessor_of_ivar : Clang_ast_t.stmt -> CLintersContext.context -> bool
val is_method_property_accessor_of_ivar : Ctl_parser_types.ast_node -> CLintersContext.context -> bool
val is_objc_constructor : CLintersContext.context -> bool
val is_objc_dealloc : CLintersContext.context -> bool
val captures_cxx_references : Clang_ast_t.decl -> bool
val captures_cxx_references : Ctl_parser_types.ast_node -> bool
val is_binop_with_kind : string -> Clang_ast_t.stmt -> bool
val is_binop_with_kind : string -> Ctl_parser_types.ast_node -> bool
val is_unop_with_kind : string -> Clang_ast_t.stmt -> bool
val is_unop_with_kind : string -> Ctl_parser_types.ast_node -> bool
val isa : string -> Clang_ast_t.stmt -> bool
val isa : string -> Ctl_parser_types.ast_node -> bool
val is_stmt : string -> Clang_ast_t.stmt -> bool
val is_decl : string -> Clang_ast_t.decl -> bool
val is_node : string -> Ctl_parser_types.ast_node -> bool
val pp_predicate : Format.formatter -> t -> unit
val decl_unavailable_in_supported_ios_sdk : Clang_ast_t.decl -> bool
val decl_unavailable_in_supported_ios_sdk : Ctl_parser_types.ast_node -> bool
val get_available_attr_ios_sdk : Clang_ast_t.decl -> string option
val get_available_attr_ios_sdk : Ctl_parser_types.ast_node -> string option
val within_responds_to_selector_block : CLintersContext.context -> Clang_ast_t.decl -> bool
val within_responds_to_selector_block : CLintersContext.context -> Ctl_parser_types.ast_node -> bool

@ -8,13 +8,13 @@
*)
open! IStd
open Ctl_parser_types
(* This module defines a language to define checkers. These checkers
are intepreted over the AST of the program. A checker is defined by a
CTL formula which express a condition saying when the checker should
report a problem *)
(* Transition labels used for example to switch from decl to stmt *)
type transitions =
| Body (** decl to stmt *)
@ -48,10 +48,31 @@ type t = (* A ctl formula *)
| ET of string list * transitions option * t
| ETX of string list * transitions option * t
(* the kind of AST nodes where formulas are evaluated *)
type ast_node =
| Stmt of Clang_ast_t.stmt
| Decl of Clang_ast_t.decl
(* "set" clauses are used for defining mandatory variables that will be used
by when reporting issues: eg for defining the condition.
"desc" clauses are used for defining the error message,
the suggestion, the severity.
"let" clauses are used to define temporary formulas which are then
used to abbreviate the another formula. For example
let f = a And B
set formula = f OR f
set message = "bla"
*)
type clause =
| CLet of string * t (* Let clause: let id = definifion; *)
| CSet of string * t (* Set clause: set id = definition *)
| CDesc of string * string (* Description clause eg: set message = "..." *)
type ctl_checker = {
name : string; (* Checker's name *)
definitions : clause list (* A list of let/set definitions *)
}
let equal_ast_node = Poly.(=)
@ -231,6 +252,20 @@ module Debug = struct
end
end
let print_checker c =
Logging.out "\n-------------------- \n";
Logging.out "\nChecker name: %s\n" c.name;
IList.iter (fun d -> (match d with
| CSet (clause_name, phi)
| CLet (clause_name, phi) ->
Logging.out " %s= \n %a\n\n"
clause_name Debug.pp_formula phi
| CDesc (clause_name, s) ->
Logging.out " %s= \n %s\n\n" clause_name s)
) c.definitions;
Logging.out "\n-------------------- \n"
let ctl_evaluation_tracker = match Config.debug_mode with
| true -> Some (ref (Debug.EvaluationTracker.create ()))
| false -> None
@ -377,49 +412,30 @@ let next_state_via_transition an trans =
linter context lcxt. That is: an, lcxt |= pred_name(params) *)
let rec eval_Atomic pred_name args an lcxt =
match pred_name, args, an with
| "call_method", [m], Stmt st -> CPredicates.call_method m st
(* Note: I think it should be better to change all predicated to be
evaluated in a node an. The predicate itself should decide if it's a
stmt or decl predicate and return false for an unappropriate node *)
| "call_method", _, Decl _ -> false
| "property_name_contains_word", [word], Decl d -> CPredicates.property_name_contains_word word d
| "property_name_contains_word", _, Stmt _ -> false
| "call_method", [m], an -> CPredicates.call_method m an
| "property_name_contains_word", [word], an -> CPredicates.property_name_contains_word word an
| "is_objc_extension", [], _ -> CPredicates.is_objc_extension lcxt
| "is_global_var", [], Decl d -> CPredicates.is_syntactically_global_var d
| "is_global_var", _, Stmt _ -> false
| "is_const_var", [], Decl d -> CPredicates.is_const_expr_var d
| "is_const_var", _, Stmt _ -> false
| "call_function_named", args, Stmt st -> CPredicates.call_function_named args st
| "call_function_named", _, Decl _ -> false
| "is_strong_property", [], Decl d -> CPredicates.is_strong_property d
| "is_strong_property", _, Stmt _ -> false
| "is_assign_property", [], Decl d -> CPredicates.is_assign_property d
| "is_assign_property", _, Stmt _ -> false
| "is_property_pointer_type", [], Decl d -> CPredicates.is_property_pointer_type d
| "is_property_pointer_type", _, Stmt _ -> false
| "is_global_var", [], an -> CPredicates.is_syntactically_global_var an
| "is_const_var", [], an -> CPredicates.is_const_expr_var an
| "call_function_named", args, an -> CPredicates.call_function_named args an
| "is_strong_property", [], an -> CPredicates.is_strong_property an
| "is_assign_property", [], an -> CPredicates.is_assign_property an
| "is_property_pointer_type", [], an -> CPredicates.is_property_pointer_type an
| "context_in_synchronized_block", [], _ -> CPredicates.context_in_synchronized_block lcxt
| "is_ivar_atomic", [], Stmt st -> CPredicates.is_ivar_atomic st
| "is_ivar_atomic", _, Decl _ -> false
| "is_method_property_accessor_of_ivar", [], Stmt st ->
CPredicates.is_method_property_accessor_of_ivar st lcxt
| "is_method_property_accessor_of_ivar", _, Decl _ -> false
| "is_ivar_atomic", [], an -> CPredicates.is_ivar_atomic an
| "is_method_property_accessor_of_ivar", [], an ->
CPredicates.is_method_property_accessor_of_ivar an lcxt
| "is_objc_constructor", [], _ -> CPredicates.is_objc_constructor lcxt
| "is_objc_dealloc", [], _ -> CPredicates.is_objc_dealloc lcxt
| "captures_cxx_references", [], Decl d -> CPredicates.captures_cxx_references d
| "captures_cxx_references", _, Stmt _ -> false
| "is_binop_with_kind", [str_kind], Stmt st -> CPredicates.is_binop_with_kind str_kind st
| "is_binop_with_kind", _, Decl _ -> false
| "is_unop_with_kind", [str_kind], Stmt st -> CPredicates.is_unop_with_kind str_kind st
| "is_unop_with_kind", _, Decl _ -> false
| "in_node", [nodename], Stmt st -> CPredicates.is_stmt nodename st
| "in_node", [nodename], Decl d -> CPredicates.is_decl nodename d
| "isa", [classname], Stmt st -> CPredicates.isa classname st
| "isa", _, Decl _ -> false
| "decl_unavailable_in_supported_ios_sdk", [], Decl decl ->
CPredicates.decl_unavailable_in_supported_ios_sdk decl
| "within_responds_to_selector_block", [], Decl decl ->
CPredicates.within_responds_to_selector_block lcxt decl
| "decl_unavailable_in_supported_ios_sdk", _, Stmt _ -> false
| "captures_cxx_references", [], _ -> CPredicates.captures_cxx_references an
| "is_binop_with_kind", [str_kind], an -> CPredicates.is_binop_with_kind str_kind an
| "is_unop_with_kind", [str_kind], an -> CPredicates.is_unop_with_kind str_kind an
| "in_node", [nodename], an -> CPredicates.is_node nodename an
| "isa", [classname], an -> CPredicates.isa classname an
| "decl_unavailable_in_supported_ios_sdk", [], an ->
CPredicates.decl_unavailable_in_supported_ios_sdk an
| "within_responds_to_selector_block", [], an ->
CPredicates.within_responds_to_selector_block lcxt an
| _ -> failwith ("ERROR: Undefined Predicate or wrong set of arguments: " ^ pred_name)
(* an, lcxt |= EF phi <=>

@ -8,6 +8,7 @@
*)
open! IStd
open Ctl_parser_types
(* This module defines a language to define checkers. These checkers
are intepreted over the AST of the program. A checker is defined by a
@ -57,10 +58,34 @@ type t =
there exists a descentant an of the current node such that an is of type in set T
making a transition to a node an' via label l, such that in an phi holds. *)
(** the kind of AST nodes where formulas are evaluated *)
type ast_node =
| Stmt of Clang_ast_t.stmt
| Decl of Clang_ast_t.decl
(* "set" clauses are used for defining mandatory variables that will be used
by when reporting issues: eg for defining the condition.
"desc" clauses are used for defining the error message,
the suggestion, the severity.
"let" clauses are used to define temporary formulas which are then
used to abbreviate the another formula. For example
let f = a And B
set formula = f OR f
set message = "bla"
*)
type clause =
| CLet of string * t (* Let clause: let id = definifion; *)
| CSet of string * t (* Set clause: set id = definition *)
| CDesc of string * string (* Description clause eg: set message = "..." *)
type ctl_checker = {
name : string; (* Checker's name *)
definitions : clause list (* A list of let/set definitions *)
}
val print_checker : ctl_checker -> unit
val eval_formula : t -> ast_node -> CLintersContext.context -> bool

@ -53,7 +53,7 @@
%left AU, EU
%right NOT, AX, EX, AF, EF, EG, AG, EH
%start <Ctl_parser_types.ctl_checker list> checkers_list
%start <CTL.ctl_checker list> checkers_list
%%
checkers_list:
@ -65,8 +65,8 @@ checker:
DEFINE_CHECKER identifier ASSIGNMENT LEFT_BRACE clause_list RIGHT_BRACE
{
Logging.out "\nParsed checker definition";
let c = { name = $2; definitions = $5 } in
print_checker c;
let c = { CTL.name = $2; CTL.definitions = $5 } in
CTL.print_checker c;
c
}
;
@ -78,11 +78,11 @@ clause_list:
clause:
| SET identifier ASSIGNMENT formula
{ Logging.out "\tParsed set clause\n"; CSet ($2, $4) }
{ Logging.out "\tParsed set clause\n"; CTL.CSet ($2, $4) }
| SET identifier ASSIGNMENT STRING
{ Logging.out "\tParsed desc clause\n"; CDesc ($2, $4) }
{ Logging.out "\tParsed desc clause\n"; CTL.CDesc ($2, $4) }
| LET identifier ASSIGNMENT formula
{ Logging.out "\tParsed let clause\n"; CLet ($2, $4) }
{ Logging.out "\tParsed let clause\n"; CTL.CLet ($2, $4) }
;
atomic_formula:

@ -12,31 +12,11 @@ open! IStd
(* Types used by the ctl parser *)
(* "set" clauses are used for defining mandatory variables that will be used
by when reporting issues: eg for defining the condition.
(** the kind of AST nodes where formulas are evaluated *)
type ast_node =
| Stmt of Clang_ast_t.stmt
| Decl of Clang_ast_t.decl
"desc" clauses are used for defining the error message,
the suggestion, the severity.
"let" clauses are used to define temporary formulas which are then
used to abbreviate the another formula. For example
let f = a And B
set formula = f OR f
set message = "bla"
*)
type clause =
| CLet of string * CTL.t (* Let clause: let id = definifion; *)
| CSet of string * CTL.t (* Set clause: set id = definition *)
| CDesc of string * string (* Description clause eg: set message = "..." *)
type ctl_checker = {
name : string; (* Checker's name *)
definitions : clause list (* A list of let/set definitions *)
}
let infer_prefix = "__infer_ctl_"
let formula_id_const = infer_prefix ^ "formula_id__"
@ -45,16 +25,3 @@ let message_const = "message"
let suggestion_const = "suggestion"
let severity_const = "severity"
let mode_const = "mode"
let print_checker c =
Logging.out "\n-------------------- \n";
Logging.out "\nChecker name: %s\n" c.name;
IList.iter (fun d -> (match d with
| CSet (clause_name, phi)
| CLet (clause_name, phi) ->
Logging.out " %s= \n %a\n\n"
clause_name CTL.Debug.pp_formula phi
| CDesc (clause_name, s) ->
Logging.out " %s= \n %s\n\n" clause_name s)
) c.definitions;
Logging.out "\n-------------------- \n"

Loading…
Cancel
Save