@ -7,12 +7,7 @@
* of patent rights can be found in the PATENTS file in the same directory .
* )
(* * Name of the infer configuration file *)
let inferconfig_file = " .inferconfig "
let inferconfig_home = ref None
let suppress_warnings_annotations = ref None
module L = Logging
(* * Look up a key in a json file containing a list of strings *)
let lookup_string_list key json =
@ -60,58 +55,8 @@ let is_matching patterns =
with Not_found -> false )
patterns
module FileContainsStringMatcher = struct
type matcher = DB . source_file -> bool
let default_matcher : matcher = fun _ -> false
let file_contains regexp file_in =
let rec loop () =
try
( Str . search_forward regexp ( input_line file_in ) 0 ) > = 0
with
| Not_found -> loop ()
| End_of_file -> false in
loop ()
let create_matcher s_patterns =
if s_patterns = [] then
default_matcher
else
let source_map = ref DB . SourceFileMap . empty in
let regexp =
Str . regexp ( join_strings " \\ | " s_patterns ) in
fun source_file ->
try
DB . SourceFileMap . find source_file ! source_map
with Not_found ->
try
let file_in = open_in ( DB . source_file_to_string source_file ) in
let pattern_found = file_contains regexp file_in in
close_in file_in ;
source_map := DB . SourceFileMap . add source_file pattern_found ! source_map ;
pattern_found
with Sys_error _ -> false
end
module type MATCHABLE_JSON = sig
val json_key : string
end
module type Matcher = sig
type matcher = DB . source_file -> Procname . t -> bool
val load_matcher : string -> matcher
end
module FileOrProcMatcher = functor ( M : MATCHABLE_JSON ) ->
struct
type matcher = DB . source_file -> Procname . t -> bool
let default_matcher : matcher =
fun _ _ -> false
type method_pattern = {
type method_pattern = {
class_name : string ;
method_name : string option ;
parameters : ( string list ) option
@ -129,27 +74,30 @@ struct
| Method_pattern of Config . language * method_pattern
| Source_contains of Config . language * string
let language_of_string = function
| " Java " -> Config . Java
| l -> failwith ( " Inferconfig JSON key " ^ M . json_key ^ " not supported for language " ^ l )
let detect_language assoc =
let rec loop = function
| [] ->
failwith
( " No language found for " ^ M . json_key ^ " in " ^ inferconfig_file )
| ( key , ` String s ) :: _ when key = " language " ->
language_of_string s
let language_of_string json_key = function
| " Java " -> Config . Java
| l -> failwith ( " Inferconfig JSON key " ^ json_key ^ " not supported for language " ^ l )
let detect_language json_key assoc =
let rec loop = function
| [] ->
failwith
( " No language found for " ^ json_key ^ " in " ^ Config . inferconfig_file )
| ( key , ` String s ) :: _ when key = " language " ->
language_of_string json_key s
| _ :: tl -> loop tl in
loop assoc
let detect_pattern assoc =
let language = detect_language assoc in
let is_method_pattern key = IList . exists ( string_equal key ) [ " class " ; " method " ]
and is_source_contains key = IList . exists ( string_equal key ) [ " source_contains " ] in
let rec loop = function
| [] ->
failwith ( " Unknown pattern for " ^ M . json_key ^ " in " ^ inferconfig_file )
(* Detect the kind of pattern, method pattern or pattern based on the content of the source file.
Detecting the kind of patterns in a first step makes it easier to parse the parts of the
pattern in a second step * )
let detect_pattern json_key assoc =
let language = detect_language json_key assoc in
let is_method_pattern key = IList . exists ( string_equal key ) [ " class " ; " method " ]
and is_source_contains key = IList . exists ( string_equal key ) [ " source_contains " ] in
let rec loop = function
| [] ->
failwith ( " Unknown pattern for " ^ json_key ^ " in " ^ Config . inferconfig_file )
| ( key , _ ) :: _ when is_method_pattern key ->
Method_pattern ( language , default_method_pattern )
| ( key , _ ) :: _ when is_source_contains key ->
@ -157,7 +105,8 @@ struct
| _ :: tl -> loop tl in
loop assoc
let create_pattern ( assoc : ( string * Yojson . Basic . json ) list ) =
(* Translate a JSON entry into a matching pattern *)
let create_pattern json_key ( assoc : ( string * Yojson . Basic . json ) list ) =
let collect_params l =
let collect accu = function
| ` String s -> s :: accu
@ -176,22 +125,96 @@ struct
IList . fold_left loop default_method_pattern assoc
and create_string_contains assoc =
let loop sc = function
| ( key , ` String pattern ) when key = " source_contains " -> pattern
| ( key , _ ) when key = " language " -> sc
| _ -> failwith ( " Fails to parse " ^ Yojson . Basic . to_string ( ` Assoc assoc ) ) in
IList . fold_left loop default_source_contains assoc in
match detect_pattern assoc with
| ( key , ` String pattern ) when key = " source_contains " -> pattern
| ( key , _ ) when key = " language " -> sc
| _ -> failwith ( " Fails to parse " ^ Yojson . Basic . to_string ( ` Assoc assoc ) ) in
IList . fold_left loop default_source_contains assoc in
match detect_pattern json_key assoc with
| Method_pattern ( language , _ ) ->
Method_pattern ( language , create_method_pattern assoc )
| Source_contains ( language , _ ) ->
Source_contains ( language , create_string_contains assoc )
let rec translate accu ( json : Yojson . Basic . json ) : pattern list =
match json with
| ` Assoc l -> ( create_pattern l ) :: accu
| ` List l -> IList . fold_left translate accu l
(* Translate all the JSON entries into matching patterns *)
let rec translate json_key accu ( json : Yojson . Basic . json ) : pattern list =
match json with
| ` Assoc l -> ( create_pattern json_key l ) :: accu
| ` List l -> IList . fold_left ( translate json_key ) accu l
| _ -> assert false
(* Creates a list of matching patterns for the given inferconfig file *)
let load_patterns json_key inferconfig =
let found =
Yojson . Basic . Util . filter_member
json_key
[ Yojson . Basic . from_file inferconfig ] in
IList . fold_left ( translate json_key ) [] found
(* Check if a proc name is matching the name given as string *)
let match_method language proc_name method_name =
not ( SymExec . function_is_builtin proc_name ) &&
match language with
| Config . Java ->
Procname . java_get_method proc_name = method_name
| Config . C_CPP ->
Procname . c_get_method proc_name = method_name
(* Module to create matcher based on strings present in the source file *)
module FileContainsStringMatcher = struct
type matcher = DB . source_file -> bool
let default_matcher : matcher = fun _ -> false
let file_contains regexp file_in =
let rec loop () =
try
( Str . search_forward regexp ( input_line file_in ) 0 ) > = 0
with
| Not_found -> loop ()
| End_of_file -> false in
loop ()
let create_matcher s_patterns =
if s_patterns = [] then
default_matcher
else
let source_map = ref DB . SourceFileMap . empty in
let regexp =
Str . regexp ( join_strings " \\ | " s_patterns ) in
fun source_file ->
try
DB . SourceFileMap . find source_file ! source_map
with Not_found ->
try
let file_in = open_in ( DB . source_file_to_string source_file ) in
let pattern_found = file_contains regexp file_in in
close_in file_in ;
source_map := DB . SourceFileMap . add source_file pattern_found ! source_map ;
pattern_found
with Sys_error _ -> false
end
module type MATCHABLE_JSON = sig
val json_key : string
end
module type Matcher = sig
type matcher = DB . source_file -> Procname . t -> bool
val load_matcher : string -> matcher
end
(* Module to create matcher based on source file names or class names and method names *)
module FileOrProcMatcher = functor ( M : MATCHABLE_JSON ) ->
struct
type matcher = DB . source_file -> Procname . t -> bool
let default_matcher : matcher =
fun _ _ -> false
let create_method_matcher m_patterns =
if m_patterns = [] then
default_matcher
@ -234,20 +257,12 @@ struct
let load_matcher inferconfig =
if Sys . file_exists inferconfig then
try
let patterns =
let found =
Yojson . Basic . Util . filter_member
M . json_key
[ Yojson . Basic . from_file inferconfig ] in
IList . fold_left translate [] found in
create_file_matcher patterns
with Sys_error _ ->
default_matcher
else default_matcher
create_file_matcher ( load_patterns M . json_key inferconfig )
else
default_matcher
(*
let pp_pattern fmt pattern =
let _ pp_pattern fmt pattern =
let pp_string fmt s =
Format . fprintf fmt " %s " s in
let pp_option pp_value fmt = function
@ -272,9 +287,30 @@ struct
| Source_contains ( language , sc ) ->
Format . fprintf fmt " Source contains (%s) { \n %a} \n "
( Config . string_of_language language ) pp_source_contains sc
* )
end (* of module FileOrProcMatcher *)
(* Module to create patterns that will match all overriding methods in the pattern *)
module OverridesMatcher = functor ( M : MATCHABLE_JSON ) ->
struct
type matcher = ( string -> bool ) -> Procname . t -> bool
let default_matcher _ _ = false
let load_matcher inferconfig =
if Sys . file_exists inferconfig then
fun is_subtype proc_name ->
let is_matching = function
| Method_pattern ( language , mp ) ->
is_subtype mp . class_name
&& Option . map_default ( match_method language proc_name ) false mp . method_name
| _ -> failwith " Expecting method pattern " in
IList . exists is_matching ( load_patterns M . json_key inferconfig )
else
default_matcher
end
module NeverReturnNull = FileOrProcMatcher ( struct
let json_key = " never_returning_null "
@ -288,10 +324,15 @@ module SkipTranslationMatcher = FileOrProcMatcher(struct
let json_key = " skip_translation "
end )
module ModeledExpensiveMatcher = OverridesMatcher ( struct
let json_key = " modeled_expensive "
end )
let inferconfig () = match ! inferconfig_home with
| Some dir -> Filename . concat dir inferconfig_file
| None -> inferconfig_file
let inferconfig () =
match ! Config . inferconfig_home with
| Some dir -> Filename . concat dir Config . inferconfig_file
| None -> Config . inferconfig_file
let load_filters analyzer =
let inferconfig_file = inferconfig () in
@ -364,7 +405,7 @@ let test () =
let matching_s =
join_strings " , "
( IList . map string_of_analyzer matching ) in
L ogging . stderr " %s -> {%s}@. "
L . stderr " %s -> {%s}@. "
( DB . source_file_to_rel_path source_file )
matching_s )
( Sys . getcwd () )