@ -89,215 +89,16 @@ let ivar_name an =
| _ -> " " )
| _ -> " "
let var_name an =
let cxx_ref_captured_in_block an =
let capt_refs = match an with
| CTL . Stmt ( Clang_ast_t . BlockExpr ( _ , _ , _ , decl ) ) ->
Predicates . captured_variables_cxx_ref decl
| CTL . Decl d -> Predicates . captured_variables_cxx_ref d
| CTL . Stmt ( Clang_ast_t . BlockExpr ( _ , _ , _ , d ) ) ->
Predicates . captured_variables_cxx_ref d
| _ -> [] in
let var_desc vars var_named_decl_info =
vars ^ " ' " ^ var_named_decl_info . Clang_ast_t . ni_name ^ " ' " in
IList . fold_left var_desc " " capt_refs
(* ( is_CallExpr /\ not call_function_named ) ||
is_CXXTemporaryObjectExpr | | is_CXXMemberCallExpr
| | is_CXXOperatorCallExpr | | is_ObjCMessageExpr * )
let ctl_makes_an_expensive_call () =
let open CTL in
let white_list_functions = [ " CGPointMake " ] in
Or ( Or ( Or ( Or ( And ( Atomic ( " in_node " , [ " CallExpr " ] ) ,
Not ( Atomic ( " call_function_named " , white_list_functions ) ) ) ,
Atomic ( " in_node " , [ " CXXTemporaryObjectExpr " ] ) ) ,
Atomic ( " in_node " , [ " CXXMemberCallExpr " ] ) ) ,
Atomic ( " in_node " , [ " CXXOperatorCallExpr " ] ) ) ,
Atomic ( " in_node " , [ " ObjCMessageExpr " ] ) )
(*
ET ( [ ObjCMethodDecl ] [ -> Body ] ( EF call_addObserver
Or EF call_addObserverForName )
= >
ET ( [ ObjCImplementationDecl , ObjCProtocolDecl ] [ -> ]
ET ( [ ObjCMethodDecl ] [ -> Body ] EF remove_observer ) Or
EH ( [ ObjCImplementationDecl , ObjCProtocolDecl ] EF remove_observer )
* )
let ctl_ns_notification_warning lctx an =
let open CTL in
let exists_method_calling_addObserver =
EF ( None , ( Atomic ( " call_method " , [ " addObserver:selector:name:object: " ] ) ) ) in
let exists_method_calling_addObserverForName =
EF ( None , ( Atomic ( " call_method " , [ " addObserverForName:object:queue:usingBlock: " ] ) ) ) in
let add_observer = Or ( exists_method_calling_addObserver ,
exists_method_calling_addObserverForName ) in
let eventually_addObserver = ET ( [ " ObjCMethodDecl " ] , Some Body , add_observer ) in
let exists_method_calling_removeObserver =
EF ( None , ( Atomic ( " call_method " , [ " removeObserver: " ] ) ) ) in
let exists_method_calling_removeObserverName =
EF ( None , ( Atomic ( " call_method " , [ " removeObserver:name:object: " ] ) ) ) in
let remove_observer = Or ( exists_method_calling_removeObserver ,
exists_method_calling_removeObserverName ) in
let remove_observer_in_block = ET ( [ " BlockDecl " ] , Some Body , remove_observer ) in
let remove_observer' = Or ( remove_observer , remove_observer_in_block ) in
let remove_observer_in_method = ET ( [ " ObjCMethodDecl " ] , Some Body , remove_observer' ) in
let eventually_removeObserver =
ET ( [ " ObjCImplementationDecl " ; " ObjCProtocolDecl " ] , None ,
Or ( remove_observer_in_method ,
EH ( [ " ObjCImplementationDecl " ; " ObjCProtocolDecl " ] , remove_observer_in_method ) ) ) in
let condition = InNode ( [ " ObjCImplementationDecl " ; " ObjCProtocolDecl " ] ,
Not ( Implies ( eventually_addObserver , eventually_removeObserver ) ) ) in
let issue_desc = {
CIssue . name = " REGISTERED_OBSERVER_BEING_DEALLOCATED " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description =
" Object self is registered in a notification center but not being removed before deallocation " ;
suggestion =
Some " Consider removing the object from the notification center before its deallocation. " ;
loc = location_from_an lctx an ;
} in
condition , Some issue_desc
(* BAD_POINTER_COMPARISON: Fires whenever a NSNumber is dangerously coerced to
a boolean in a comparison * )
let ctl_bad_pointer_comparison_warning lctx an =
let open CTL in
let is_binop = Atomic ( " in_node " , [ " BinaryOperator " ] ) in
let is_binop_eq = Atomic ( " is_binop_with_kind " , [ " EQ " ] ) in
let is_binop_ne = Atomic ( " is_binop_with_kind " , [ " NE " ] ) in
let is_binop_neq = Or ( is_binop_eq , is_binop_ne ) in
let is_unop_lnot = Atomic ( " is_unop_with_kind " , [ " LNot " ] ) in
let is_implicit_cast_expr = Atomic ( " in_node " , [ " ImplicitCastExpr " ] ) in
let is_expr_with_cleanups = Atomic ( " in_node " , [ " ExprWithCleanups " ] ) in
let is_nsnumber = Atomic ( " isa " , [ " NSNumber " ] ) in
(*
NOT is_binop_neq AND
( is_expr_with_cleanups OR is_implicit_cast_expr OR is_binop OR is_unop_lnot )
UNTIL is_nsnumber
* )
let p = Or ( is_expr_with_cleanups , Or ( is_implicit_cast_expr , Or ( is_binop , is_unop_lnot ) ) ) in
let p' = And ( Not is_binop_neq , p ) in
let etx = ETX ( [ " IfStmt " ; " ForStmt " ; " WhileStmt " ; " ConditionalOperator " ] , Some Cond ,
EU ( None , p' , is_nsnumber ) ) in
let condition = InNode ( [ " IfStmt " ; " ForStmt " ; " WhileStmt " ; " ConditionalOperator " ] , etx ) in
let issue_desc =
{ CIssue .
name = " BAD_POINTER_COMPARISON " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description = " Implicitly checking whether NSNumber pointer is nil " ;
suggestion =
Some ( " Did you mean to compare against the unboxed value instead? " ^
" Please either explicitly compare the NSNumber instance to nil, " ^
" or use one of the NSNumber accessors before the comparison. " ) ;
loc = location_from_an lctx an
} in
condition , Some issue_desc
(* name_contains_delegate AND not name_contains_queue AND is_strong_property *)
let ctl_strong_delegate_warning lctx an =
let open CTL in
let name_contains_delegate =
Atomic ( " property_name_contains_word " , [ " delegate " ] ) in
let name_does_not_contains_queue =
Not ( Atomic ( " property_name_contains_word " , [ " queue " ] ) ) in
let is_strong_property =
Atomic ( " is_strong_property " , [] ) in
let condition = InNode ( [ " ObjCPropertyDecl " ] , And ( name_contains_delegate ,
And ( name_does_not_contains_queue ,
is_strong_property ) ) ) in
let issue_desc = {
CIssue . name = " STRONG_DELEGATE_WARNING " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description =
" Property or ivar %decl_name% declared strong " ;
suggestion = Some " In general delegates should be declared weak or assign " ;
loc = location_from_an lctx an
} in
condition , Some issue_desc
(* ( is_ObjC || is_Objc++ ) /\ is_global_var /\ not is_const_var /\
ET ( [ VarDecl ] [ -> InitExpr ] EF ctl_makes_an_expensive_call )
* )
let ctl_global_var_init_with_calls_warning lctx an =
let open CTL in
let ctl_is_global_var =
And ( And ( Atomic ( " is_objc_extension " , [] ) , Atomic ( " is_global_var " , [] ) ) ,
Not ( Atomic ( " is_const_var " , [] ) ) ) in
let ctl_is_initialized_with_expensive_call =
ET ( [ " VarDecl " ] , Some InitExpr , EF ( None , ( ctl_makes_an_expensive_call () ) ) ) in
let condition =
InNode ( [ " VarDecl " ] , And ( ctl_is_global_var , ctl_is_initialized_with_expensive_call ) ) in
let issue_desc = {
CIssue . name = " GLOBAL_VARIABLE_INITIALIZED_WITH_FUNCTION_OR_METHOD_CALL " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description =
" Global variable %decl_name% is initialized using a function or method call " ;
suggestion = Some
" If the function/method call is expensive, it can affect the starting time of the app. " ;
loc = location_from_an lctx an
} in
condition , Some issue_desc
(* is_assign_property AND is_property_pointer_type *)
let ctl_assign_pointer_warning lctx an =
let open CTL in
let condition = InNode ( [ " ObjCPropertyDecl " ] ,
And ( Atomic ( " is_assign_property " , [] ) ,
Atomic ( " is_property_pointer_type " , [] ) ) ) in
let issue_desc =
{ CIssue . name = " ASSIGN_POINTER_WARNING " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description =
" Property `%decl_name%` is a pointer type marked with the `assign` attribute " ;
suggestion = Some " Use a different attribute like `strong` or `weak`. " ;
loc = location_from_an lctx an
} in
condition , Some issue_desc
(*
not context_in_synchronized_block / \ not is_method_property_accessor_of_ivar
/ \ not is_objc_constructor / \ not is_objc_dealloc
* )
let ctl_direct_atomic_property_access_warning lctx an =
let open CTL in
let condition = InNode ( [ " ObjCIvarRefExpr " ] ,
And ( And ( And ( And ( Not ( Atomic ( " context_in_synchronized_block " , [] ) ) ,
Atomic ( " is_ivar_atomic " , [] ) ) ,
Not ( Atomic ( " is_method_property_accessor_of_ivar " , [] ) ) ) ,
Not ( Atomic ( " is_objc_constructor " , [] ) ) ) ,
Not ( Atomic ( " is_objc_dealloc " , [] ) ) ) ) in
let issue_desc = {
CIssue . name = " DIRECT_ATOMIC_PROPERTY_ACCESS " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description = " Direct access to ivar %ivar_name% of an atomic property " ;
suggestion =
Some " Accessing an ivar of an atomic property makes the property nonatomic " ;
loc = location_from_an lctx an
} in
condition , Some issue_desc
let ctl_captured_cxx_ref_in_objc_block_warning lctx an =
(* Fire if the list of captured references is not empty *)
let open CTL in
let condition = InNode ( [ " BlockDecl " ] , Atomic ( " captures_cxx_references " , [] ) ) in
let issue_desc = {
CIssue . name = " CXX_REFERENCE_CAPTURED_IN_OBJC_BLOCK " ;
severity = Exceptions . Kwarning ;
mode = CIssue . On ;
description =
" C++ Reference variable(s) %var_name% captured by Objective-C block " ;
suggestion = Some ( " C++ References are unmanaged and may be invalid " ^
" by the time the block executes. " ) ;
loc = match an with
| Stmt ( Clang_ast_t . BlockExpr ( _ , _ , _ , decl ) ) -> location_from_an lctx ( Decl decl )
| _ -> location_from_an lctx an ;
} in
condition , Some issue_desc
(* * If the declaration has avilability attributes, check that it's compatible with
the iphoneos_target_sdk_version * )
let ctl_unavailable_api_in_supported_ios_sdk_error lctx an =