From 3c6f53c8961531cfab77315c19e9a2a978429a41 Mon Sep 17 00:00:00 2001 From: Dino Distefano Date: Wed, 3 May 2017 13:14:58 -0700 Subject: [PATCH] Adding predicate to get return type of a method and start a new parser for types Reviewed By: dulmarod Differential Revision: D4863095 fbshipit-source-id: c966d1d --- infer/src/clang/cFrontend_checkers_main.ml | 3 +- infer/src/clang/cPredicates.ml | 55 +++++++++++++++++++ infer/src/clang/cPredicates.mli | 2 + infer/src/clang/cTL.ml | 6 +- infer/src/clang/types_lexer.mll | 45 +++++++++++++++ infer/src/clang/types_parser.mly | 49 +++++++++++++++++ .../objc/linters-for-test-only/issues.exp | 4 ++ .../linters-for-test-only/linters_example.al | 19 +++++-- .../objc/linters-for-test-only/subclassing.m | 4 +- 9 files changed, 178 insertions(+), 9 deletions(-) create mode 100644 infer/src/clang/types_lexer.mll create mode 100644 infer/src/clang/types_parser.mly diff --git a/infer/src/clang/cFrontend_checkers_main.ml b/infer/src/clang/cFrontend_checkers_main.ml index 707230795..bcc5b0e87 100644 --- a/infer/src/clang/cFrontend_checkers_main.ml +++ b/infer/src/clang/cFrontend_checkers_main.ml @@ -23,7 +23,8 @@ let parse_al_file fname channel : CTL.al_file option = (s ^ " at " ^ (pos_str lexbuf))) | SyntaxError _ | Ctl_parser.Error -> - raise (Ctl_parser_types.ALParsingException ( "SYNTAX ERROR at " ^ (pos_str lexbuf))) in + raise (Ctl_parser_types.ALParsingException + ("SYNTAX ERROR at " ^ (pos_str lexbuf))) in let lexbuf = Lexing.from_channel channel in lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = fname }; parse_with_error lexbuf diff --git a/infer/src/clang/cPredicates.ml b/infer/src/clang/cPredicates.ml index 465d143c2..7bea6c988 100644 --- a/infer/src/clang/cPredicates.ml +++ b/infer/src/clang/cPredicates.ml @@ -8,6 +8,8 @@ *) open! IStd +open Lexing +open Types_lexer let get_available_attr_ios_sdk an = let open Clang_ast_t in @@ -369,6 +371,59 @@ let decl_unavailable_in_supported_ios_sdk (cxt : CLintersContext.context) an = | _ -> false +(* Temporary, partial equality function. Cover only what's covered + by the types_parser. It needs to be replaced by a real + comparison function for Clang_ast_t.c_type *) +let tmp_c_type_equal t1 t2 = + let open Clang_ast_t in + match t1, t2 with + | BuiltinType(_ , `Char_U), BuiltinType(_ , `Char_U) + | BuiltinType(_, `Char16), BuiltinType(_, `Char16) + | BuiltinType(_, `Char32), BuiltinType(_, `Char32) + | BuiltinType(_, `WChar_U), BuiltinType(_, `WChar_U) + | BuiltinType(_, `Bool), BuiltinType(_, `Bool) + | BuiltinType(_, `Short), BuiltinType(_, `Short) + | BuiltinType(_, `Int), BuiltinType(_, `Int) + | BuiltinType(_, `Long), BuiltinType(_, `Long) + | BuiltinType(_, `Float), BuiltinType(_, `Float) + | BuiltinType(_, `Double), BuiltinType(_, `Double) + | BuiltinType(_, `Void), BuiltinType(_, `Void) -> true + | BuiltinType(_, _), BuiltinType(_, _) -> false + | _, _ -> failwith ("[ERROR]: Cannot compare types. Cannot continue...") + + + +(* Check whether a type_ptr and a string denote the same type *) +let type_ptr_equal_type type_ptr type_str = + let pos_str lexbuf = + let pos = lexbuf.lex_curr_p in + pos.pos_fname ^ ":" ^ (string_of_int pos.pos_lnum) ^ ":" ^ + (string_of_int (pos.pos_cnum - pos.pos_bol + 1)) in + let lexbuf = Lexing.from_string type_str in + let c_type = try + (Types_parser.ctype_specifier token lexbuf) + with + | Ctl_parser_types.ALParsingException s -> + raise (Ctl_parser_types.ALParsingException + ("Syntax Error when defining type" ^ s )) + | SyntaxError _ + | Types_parser.Error -> + raise (Ctl_parser_types.ALParsingException + ("SYNTAX ERROR at " ^ (pos_str lexbuf))) in + match CAst_utils.get_type type_ptr with + | Some c_type' -> tmp_c_type_equal c_type c_type' + | _ -> Logging.out "Couldn't find type....\n"; false + + +let method_return_type an typ = + Logging.out "\n Executing method_return_type..."; + match an with + | Ctl_parser_types.Decl (Clang_ast_t.ObjCMethodDecl (_, _, mdi)) -> + Logging.out "\n with parameter `%s`...." typ; + let qual_type = mdi.Clang_ast_t.omdi_result_type in + type_ptr_equal_type qual_type.Clang_ast_t.qt_type_ptr typ + | _ -> false + let within_responds_to_selector_block (cxt:CLintersContext.context) an = let open Clang_ast_t in match an with diff --git a/infer/src/clang/cPredicates.mli b/infer/src/clang/cPredicates.mli index d53773440..9eaf6fbb6 100644 --- a/infer/src/clang/cPredicates.mli +++ b/infer/src/clang/cPredicates.mli @@ -78,6 +78,8 @@ val pp_predicate : Format.formatter -> t -> unit val decl_unavailable_in_supported_ios_sdk : CLintersContext.context -> Ctl_parser_types.ast_node -> bool +val method_return_type : Ctl_parser_types.ast_node -> string -> bool + val get_available_attr_ios_sdk : Ctl_parser_types.ast_node -> string option val within_responds_to_selector_block : CLintersContext.context -> Ctl_parser_types.ast_node -> bool diff --git a/infer/src/clang/cTL.ml b/infer/src/clang/cTL.ml index 4c2b03c3f..26454faeb 100644 --- a/infer/src/clang/cTL.ml +++ b/infer/src/clang/cTL.ml @@ -645,9 +645,11 @@ let rec eval_Atomic _pred_name _args an lcxt = CPredicates.decl_unavailable_in_supported_ios_sdk lcxt an | "within_responds_to_selector_block", [], an -> CPredicates.within_responds_to_selector_block lcxt an + | "method_return_type", [typ], an -> + CPredicates.method_return_type an typ | _ -> failwith - ("\nERROR: Undefined Predicate or wrong set of arguments: '" - ^ pred_name ^ "'\n") + ("ERROR: Undefined Predicate or wrong set of arguments: '" + ^ pred_name ^ "'") (* an, lcxt |= EF phi <=> an, lcxt |= phi or exists an' in Successors(st): an', lcxt |= EF phi diff --git a/infer/src/clang/types_lexer.mll b/infer/src/clang/types_lexer.mll new file mode 100644 index 000000000..299555f37 --- /dev/null +++ b/infer/src/clang/types_lexer.mll @@ -0,0 +1,45 @@ +(* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +{ + open Lexing + open Types_parser + + exception SyntaxError of string + + let next_line lexbuf = + let pos = lexbuf.lex_curr_p in + lexbuf.lex_curr_p <- + { pos with pos_bol = lexbuf.lex_curr_pos; + pos_lnum = pos.pos_lnum + 1; + pos_cnum = 1; + } +} + +let comment = "//" [^'\n']* +let whitespace = [' ' '\t'] +let id = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_' ':']* +let file_id = ['a'-'z' 'A'-'Z' '_' '~' '/' '.'] ['a'-'z' 'A'-'Z' '0'-'9' '_' ':' '.' '/' '-']* + +rule token = parse + | whitespace+ { token lexbuf } + | whitespace*("\r")?"\n" { next_line lexbuf; token lexbuf } + | comment { token lexbuf } + | "char" { CHAR } + | "char16_t" { CHAR16_T } + | "char32_t" { CHAR32_T } + | "wchar_t" { WCHAR_T } + | "bool" { BOOL } + | "short" { SHORT } + | "int" { INT } + | "long" { LONG } + | "float" { FLOAT } + | "double" { DOUBLE } + | "void" { VOID } + | _ { raise (SyntaxError ("Unexpected char: '" ^ (Lexing.lexeme lexbuf) ^"'")) } diff --git a/infer/src/clang/types_parser.mly b/infer/src/clang/types_parser.mly new file mode 100644 index 000000000..6fe69700f --- /dev/null +++ b/infer/src/clang/types_parser.mly @@ -0,0 +1,49 @@ +/* + * Copyright (c) 2017 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + */ + +%{ + + let dummy_ptr = { Clang_ast_t.ti_pointer = 0; + Clang_ast_t.ti_desugared_type = None } + +%} + +%token CHAR +%token CHAR16_T +%token CHAR32_T +%token WCHAR_T +%token BOOL +%token SHORT +%token INT +%token LONG +%token FLOAT +%token DOUBLE +%token VOID + +%start ctype_specifier +%% + +ctype_specifier: + | simple_type_specifier { $1 } + +simple_type_specifier: + | CHAR { Clang_ast_t.BuiltinType(dummy_ptr, `Char_U) } + | CHAR16_T { Clang_ast_t.BuiltinType(dummy_ptr, `Char16) } + | CHAR32_T { Clang_ast_t.BuiltinType(dummy_ptr, `Char32) } + | WCHAR_T { Clang_ast_t.BuiltinType(dummy_ptr, `WChar_U) } + | BOOL { Clang_ast_t.BuiltinType(dummy_ptr, `Bool) } + | SHORT { Clang_ast_t.BuiltinType(dummy_ptr, `Short) } + | INT { Clang_ast_t.BuiltinType(dummy_ptr, `Int) } + | LONG { Clang_ast_t.BuiltinType(dummy_ptr, `Long) } + | FLOAT { Clang_ast_t.BuiltinType(dummy_ptr, `Float) } + | DOUBLE { Clang_ast_t.BuiltinType(dummy_ptr, `Double) } + | VOID { Clang_ast_t.BuiltinType(dummy_ptr, `Void) } + ; + +%% diff --git a/infer/tests/codetoanalyze/objc/linters-for-test-only/issues.exp b/infer/tests/codetoanalyze/objc/linters-for-test-only/issues.exp index 1c2461d65..178254674 100644 --- a/infer/tests/codetoanalyze/objc/linters-for-test-only/issues.exp +++ b/infer/tests/codetoanalyze/objc/linters-for-test-only/issues.exp @@ -1,3 +1,7 @@ +codetoanalyze/objc/linters-for-test-only/subclassing.m, A_foo:, 13, TEST_RETURN_METHOD, [] +codetoanalyze/objc/linters-for-test-only/subclassing.m, A_foo:, 19, TEST_RETURN_METHOD, [] +codetoanalyze/objc/linters-for-test-only/subclassing.m, B_bar, 28, TEST_RETURN_METHOD, [] +codetoanalyze/objc/linters-for-test-only/subclassing.m, B_bar, 34, TEST_RETURN_METHOD, [] codetoanalyze/objc/linters-for-test-only/subclassing.m, B_bar, 35, TEST_ALL_METHODS, [] codetoanalyze/objc/linters-for-test-only/subclassing.m, B_bar, 36, MACRO_TEST1, [] codetoanalyze/objc/linters-for-test-only/subclassing.m, B_bar, 36, MACRO_TEST2, [] diff --git a/infer/tests/codetoanalyze/objc/linters-for-test-only/linters_example.al b/infer/tests/codetoanalyze/objc/linters-for-test-only/linters_example.al index b307f609c..af85afb62 100644 --- a/infer/tests/codetoanalyze/objc/linters-for-test-only/linters_example.al +++ b/infer/tests/codetoanalyze/objc/linters-for-test-only/linters_example.al @@ -71,13 +71,13 @@ DEFINE-CHECKER GLOBAL_MACRO_SUBCLASS = { }; -DEFINE-CHECKER IMPORTED_MACRO_SUBCLASS = { + DEFINE-CHECKER IMPORTED_MACRO_SUBCLASS = { - SET report_when = imported_is_subclass_of("A"); + SET report_when = imported_is_subclass_of("A"); - SET message = "This is subclassing A. Class A should not be subclassed."; + SET message = "This is subclassing A. Class A should not be subclassed."; -}; + }; DEFINE-CHECKER TEST_ALL_METHODS = { @@ -86,3 +86,14 @@ DEFINE-CHECKER TEST_ALL_METHODS = { SET message = "Method call..."; }; + +DEFINE-CHECKER TEST_RETURN_METHOD = { + + SET report_when = + WHEN + method_return_type("int") + HOLDS-IN-NODE ObjCMethodDecl; + + SET message = "Method return int"; + +}; diff --git a/infer/tests/codetoanalyze/objc/linters-for-test-only/subclassing.m b/infer/tests/codetoanalyze/objc/linters-for-test-only/subclassing.m index d60a6e875..39f0b42c8 100644 --- a/infer/tests/codetoanalyze/objc/linters-for-test-only/subclassing.m +++ b/infer/tests/codetoanalyze/objc/linters-for-test-only/subclassing.m @@ -25,13 +25,13 @@ @interface B : A // Error: A subclass -- (void)bar; +- (int)bar; @end @implementation B -- (void)bar { +- (int)bar { A* a = [[A alloc] init]; [a foo:5]; // Error: report MACRO_TEST1, MACRO_TEST2, MACRO_TEST3 }