Construct inferconfig patterns in Inferconfig not Config

Reviewed By: jeremydubreil

Differential Revision: D4310695

fbshipit-source-id: 670e516

infer/src/backend/inferconfig.ml

@@ -9,6 +9,8 @@
 
 open! IStd
 
+module CLOpt = CommandLineOption
+module F = Format
 module L = Logging
 
 type path_filter = SourceFile.t -> bool
@@ -93,6 +95,16 @@ module FileContainsStringMatcher = struct
         with Sys_error _ -> false
 end
 
+type method_pattern = {
+  class_name : string;
+  method_name : string option;
+  parameters : (string list) option;
+}
+
+type pattern =
+  | Method_pattern of Config.language * method_pattern
+  | Source_contains of Config.language * string
+
 (* Module to create matcher based on source file names or class names and method names *)
 module FileOrProcMatcher = struct
 
@@ -110,9 +122,9 @@ module FileOrProcMatcher = struct
           (fun map pattern ->
              let previous =
                try
-                 String.Map.find_exn map pattern.Config.class_name
+                 String.Map.find_exn map pattern.class_name
                with Not_found -> [] in
-             String.Map.add ~key:pattern.Config.class_name ~data:(pattern:: previous) map)
+             String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map)
           String.Map.empty
           m_patterns in
       let do_java pname_java =
@@ -122,7 +134,7 @@ module FileOrProcMatcher = struct
           let class_patterns = String.Map.find_exn pattern_map class_name in
           IList.exists
             (fun p ->
-               match p.Config.method_name with
+               match p.method_name with
                | None -> true
                | Some m -> String.equal m method_name)
             class_patterns
@@ -138,8 +150,8 @@ module FileOrProcMatcher = struct
   let create_file_matcher patterns =
     let s_patterns, m_patterns =
       let collect (s_patterns, m_patterns) = function
-        | Config.Source_contains (_, s) -> (s:: s_patterns, m_patterns)
+        | Source_contains (_, s) -> (s:: s_patterns, m_patterns)
-        | Config.Method_pattern (_, mp) -> (s_patterns, mp :: m_patterns) in
+        | Method_pattern (_, mp) -> (s_patterns, mp :: m_patterns) in
       IList.fold_left collect ([], []) patterns in
     let s_matcher =
       let matcher = FileContainsStringMatcher.create_matcher s_patterns in
@@ -163,16 +175,16 @@ module FileOrProcMatcher = struct
         Format.fprintf fmt "[%a]"
           (Pp.semicolon_seq_oneline Pp.text pp_string) l in
       Format.fprintf fmt "%a%a%a"
-        (pp_key_value pp_string) ("class", Some mp.Config.class_name)
+        (pp_key_value pp_string) ("class", Some mp.class_name)
-        (pp_key_value pp_string) ("method", mp.Config.method_name)
+        (pp_key_value pp_string) ("method", mp.method_name)
-        (pp_key_value pp_params) ("parameters", mp.Config.parameters)
+        (pp_key_value pp_params) ("parameters", mp.parameters)
     and pp_source_contains fmt sc =
       Format.fprintf fmt "  pattern: %s\n" sc in
     match pattern with
-    | Config.Method_pattern (language, mp) ->
+    | Method_pattern (language, mp) ->
         Format.fprintf fmt "Method pattern (%s) {\n%a}\n"
           (Config.string_of_language language) pp_method_pattern mp
-    | Config.Source_contains (language, sc) ->
+    | Source_contains (language, sc) ->
         Format.fprintf fmt "Source contains (%s) {\n%a}\n"
           (Config.string_of_language language) pp_source_contains sc
 
@@ -184,19 +196,146 @@ module OverridesMatcher = struct
   let load_matcher patterns =
     fun is_subtype proc_name ->
       let is_matching = function
-        | Config.Method_pattern (language, mp) ->
+        | Method_pattern (language, mp) ->
-            is_subtype mp.Config.class_name
+            is_subtype mp.class_name
-            && (Option.value_map ~f:(match_method language proc_name) ~default:false
+            && (Option.value_map ~f:(match_method language proc_name) ~default:false mp.method_name)
-                  mp.Config.method_name)
         | _ -> failwith "Expecting method pattern" in
       IList.exists is_matching patterns
 
 end
 
-let never_return_null_matcher = FileOrProcMatcher.load_matcher Config.patterns_never_returning_null
+let patterns_of_json_with_key (json_key, json) =
-let skip_translation_matcher = FileOrProcMatcher.load_matcher Config.patterns_skip_translation
+  let default_method_pattern = {
-let suppress_warnings_matcher = FileOrProcMatcher.load_matcher Config.patterns_suppress_warnings
+    class_name = "";
-let modeled_expensive_matcher = OverridesMatcher.load_matcher Config.patterns_modeled_expensive
+    method_name = None;
+    parameters = None
+  } in
+
+  let default_source_contains = "" in
+
+  let language_of_string = function
+    | "Java" ->
+        Ok Config.Java
+    | l ->
+        Error ("Inferconfig JSON key " ^ json_key ^ " not supported for language " ^ l) in
+
+  let rec detect_language = function
+    | [] ->
+        Error ("No language found for " ^ json_key ^ " in " ^ Config.inferconfig_file)
+    | ("language", `String s) :: _ ->
+        language_of_string s
+    | _:: tl ->
+        detect_language tl in
+
+  (* 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 assoc =
+    match detect_language assoc with
+    | Ok language ->
+        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
+          | [] ->
+              Error ("Unknown pattern for " ^ json_key ^ " in " ^ Config.inferconfig_file)
+          | (key, _) :: _ when is_method_pattern key ->
+              Ok (Method_pattern (language, default_method_pattern))
+          | (key, _) :: _ when is_source_contains key ->
+              Ok (Source_contains (language, default_source_contains))
+          | _:: tl -> loop tl in
+        loop assoc
+    | Error _ as error ->
+        error in
+
+  (* Translate a JSON entry into a matching pattern *)
+  let create_pattern (assoc : (string * Yojson.Basic.json) list) =
+    let collect_params l =
+      let collect accu = function
+        | `String s -> s:: accu
+        | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in
+      IList.rev (IList.fold_left collect [] l) in
+    let create_method_pattern assoc =
+      let loop mp = function
+        | (key, `String s) when key = "class" ->
+            { mp with class_name = s }
+        | (key, `String s) when key = "method" ->
+            { mp with method_name = Some s }
+        | (key, `List l) when key = "parameters" ->
+            { mp with parameters = Some (collect_params l) }
+        | (key, _) when key = "language" -> mp
+        | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in
+      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
+    | Ok (Method_pattern (language, _)) ->
+        Ok (Method_pattern (language, create_method_pattern assoc))
+    | Ok (Source_contains (language, _)) ->
+        Ok (Source_contains (language, create_string_contains assoc))
+    | Error _ as error ->
+        error in
+
+  let warn_user msg =
+    F.eprintf "WARNING: in file %s: error parsing option %s@\n%s"
+      Config.inferconfig_file json_key msg in
+
+  (* Translate all the JSON entries into matching patterns *)
+  let rec translate accu = function
+    | `Assoc l -> (
+        match create_pattern l with
+        | Ok pattern ->
+            pattern :: accu
+        | Error msg ->
+            warn_user msg;
+            accu)
+    | `List l ->
+        IList.fold_left translate accu l
+    | json ->
+        warn_user (Printf.sprintf "expected list or assoc json type, but got value %s"
+                     (Yojson.Basic.to_string json));
+        accu in
+
+  translate [] json
+
+let modeled_expensive_matcher =
+  OverridesMatcher.load_matcher (patterns_of_json_with_key Config.patterns_modeled_expensive)
+
+let never_return_null_matcher =
+  FileOrProcMatcher.load_matcher (patterns_of_json_with_key Config.patterns_never_returning_null)
+
+let skip_translation_matcher =
+  FileOrProcMatcher.load_matcher (patterns_of_json_with_key Config.patterns_skip_translation)
+
+let suppress_warnings_matcher =
+  let error msg =
+    F.eprintf
+      "There was an issue reading the option %s.@\n\
+       If you did not call %s directly, this is likely a bug in Infer.@\n\
+       %s@."
+      Config.suppress_warnings_annotations_long
+      (Filename.basename Sys.executable_name)
+      msg ;
+    [] in
+  let patterns =
+    match Config.suppress_warnings_out with
+    | Some path -> (
+        match Utils.read_optional_json_file path with
+        | Ok json -> (
+            let json_key = "suppress_warnings" in
+            match Yojson.Basic.Util.member json_key json with
+            | `Null -> []
+            | json -> patterns_of_json_with_key (json_key, json))
+        | Error msg -> error ("Could not read or parse the supplied " ^ path ^ ":\n" ^ msg)
+      )
+    | None when Config.current_exe <> CLOpt.Java -> []
+    | None when Option.is_some Config.generated_classes -> []
+    | None ->
+        error ("The option " ^ Config.suppress_warnings_annotations_long ^ " was not provided") in
+  FileOrProcMatcher.load_matcher patterns
 
 let load_filters analyzer =
   {

infer/src/base/CommandLineOption.ml

@@ -426,6 +426,13 @@ let mk_set_from_json ~default ~default_to_string ~f
     ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
     ~mk_spec:(fun set -> Arg.String set)
 
+let mk_json ?(deprecated=[]) ~long ?short ?exes ?(meta="json") doc =
+  mk ~deprecated ~long ?short ?exes ~meta doc
+    ~default:(`List []) ~default_to_string:Yojson.Basic.to_string
+    ~mk_setter:(fun var json -> var := Yojson.Basic.from_string json)
+    ~decode_json:(fun json -> [dashdash long; Yojson.Basic.to_string json])
+    ~mk_spec:(fun set -> Arg.String set)
+
 (** A ref to a function used during argument parsing to process anonymous arguments. By default,
     anonymous arguments are rejected. *)
 let anon_fun = ref (fun arg -> raise (Arg.Bad ("unexpected anonymous argument: " ^ arg)))

infer/src/base/CommandLineOption.mli

@@ -103,6 +103,8 @@ val mk_symbol_seq : ?default:'a list -> symbols:(string * 'a) list -> 'a list re
 val mk_set_from_json : default:'a -> default_to_string:('a -> string)
   -> f:(Yojson.Basic.json -> 'a) -> 'a ref t
 
+val mk_json : Yojson.Basic.json ref t
+
 (** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse
     order they appeared on the command line. *)
 val mk_anon :

infer/src/base/Config.ml

@@ -52,17 +52,6 @@ let ml_bucket_symbols = [
 type os_type = Unix | Win32 | Cygwin
 
 
-type method_pattern = {
-  class_name : string;
-  method_name : string option;
-  parameters : (string list) option;
-}
-
-type pattern =
-  | Method_pattern of language * method_pattern
-  | Source_contains of language * string
-
-
 (** Constant configuration values *)
 
 (** If true, a precondition with e.g. index 3 in an array does not require the caller to
@@ -288,107 +277,6 @@ let os_type = match Sys.os_type with
   | _ -> Unix
 
 
-(** Inferconfig parsing auxiliary functions *)
-
-let patterns_of_json_with_key json_key json =
-  let default_method_pattern = {
-    class_name = "";
-    method_name = None;
-    parameters = None
-  } in
-
-  let default_source_contains = "" in
-
-  let language_of_string = function
-    | "Java" ->
-        Ok Java
-    | l ->
-        Error ("Inferconfig JSON key " ^ json_key ^ " not supported for language " ^ l) in
-
-  let rec detect_language = function
-    | [] ->
-        Error ("No language found for " ^ json_key ^ " in " ^ inferconfig_file)
-    | ("language", `String s) :: _ ->
-        language_of_string s
-    | _:: tl ->
-        detect_language tl in
-
-  (* 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 assoc =
-    match detect_language assoc with
-    | Ok language ->
-        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
-          | [] ->
-              Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file)
-          | (key, _) :: _ when is_method_pattern key ->
-              Ok (Method_pattern (language, default_method_pattern))
-          | (key, _) :: _ when is_source_contains key ->
-              Ok (Source_contains (language, default_source_contains))
-          | _:: tl -> loop tl in
-        loop assoc
-    | Error _ as error ->
-        error in
-
-  (* Translate a JSON entry into a matching pattern *)
-  let create_pattern (assoc : (string * Yojson.Basic.json) list) =
-    let collect_params l =
-      let collect accu = function
-        | `String s -> s:: accu
-        | _ -> failwith ("Unrecognised parameters in " ^ Yojson.Basic.to_string (`Assoc assoc)) in
-      IList.rev (IList.fold_left collect [] l) in
-    let create_method_pattern assoc =
-      let loop mp = function
-        | (key, `String s) when key = "class" ->
-            { mp with class_name = s }
-        | (key, `String s) when key = "method" ->
-            { mp with method_name = Some s }
-        | (key, `List l) when key = "parameters" ->
-            { mp with parameters = Some (collect_params l) }
-        | (key, _) when key = "language" -> mp
-        | _ -> failwith ("Fails to parse " ^ Yojson.Basic.to_string (`Assoc assoc)) in
-      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
-    | Ok (Method_pattern (language, _)) ->
-        Ok (Method_pattern (language, create_method_pattern assoc))
-    | Ok (Source_contains (language, _)) ->
-        Ok (Source_contains (language, create_string_contains assoc))
-    | Error _ as error ->
-        error in
-
-  let warn_user msg =
-    F.eprintf "WARNING: in file %s: error parsing option %s@\n%s" inferconfig_file json_key msg in
-
-  (* Translate all the JSON entries into matching patterns *)
-  let rec translate accu = function
-    | `Assoc l -> (
-        match create_pattern l with
-        | Ok pattern ->
-            pattern :: accu
-        | Error msg ->
-            warn_user msg;
-            accu)
-    | `List l ->
-        IList.fold_left translate accu l
-    | json ->
-        warn_user (Printf.sprintf "expected list or assoc json type, but got value %s"
-                     (Yojson.Basic.to_string json));
-        accu in
-
-  translate [] json
-
-
-(** Command Line options *)
-
 (** The working directory of the initial invocation of infer, to which paths passed as command line
     options are relative. *)
 let init_work_dir, is_originator =
@@ -1058,20 +946,26 @@ and out_file =
   CLOpt.mk_path ~deprecated:["out_file"] ~long:"out-file" ~default:""
     ~meta:"file" "Specify the file for the non-error logs of the analyzer"
 
-and (
+and patterns_modeled_expensive =
-  patterns_modeled_expensive,
+  let long = "modeled-expensive" in
-  patterns_never_returning_null,
+  (long,
-  patterns_skip_translation) =
+   CLOpt.mk_json ~deprecated:["modeled_expensive"] ~long
-  let mk_option ~deprecated ~long doc =
-    CLOpt.mk_set_from_json ~deprecated ~long ~default:[] ~default_to_string:(fun _ -> "[]")
      ~exes:CLOpt.[Java]
-      ~f:(patterns_of_json_with_key long) doc in
-  ( mk_option ~deprecated:["modeled_expensive"] ~long:"modeled-expensive"
      "Matcher or list of matchers for methods that should be considered expensive by the \
-       performance critical checker.",
+      performance critical checker.")
-    mk_option ~deprecated:["never_returning_null"] ~long:"never-returning-null"
+
-      "Matcher or list of matchers for functions that never return `null`.",
+and patterns_never_returning_null =
-    mk_option ~deprecated:["skip_translation"] ~long:"skip-translation"
+  let long = "never-returning-null" in
+  (long,
+   CLOpt.mk_json ~deprecated:["never_returning_null"] ~long
+     ~exes:CLOpt.[Java]
+     "Matcher or list of matchers for functions that never return `null`.")
+
+and patterns_skip_translation =
+  let long = "skip-translation" in
+  (long,
+   CLOpt.mk_json ~deprecated:["skip_translation"] ~long
+     ~exes:CLOpt.[Java]
      "Matcher or list of matchers for names of files that should not be analyzed at all.")
 
 and pmd_xml =
@@ -1534,9 +1428,9 @@ and objc_memory_model_on = !objc_memory_model
 and only_footprint = !only_footprint
 and optimistic_cast = !optimistic_cast
 and out_file_cmdline = !out_file
-and patterns_never_returning_null = !patterns_never_returning_null
+and patterns_never_returning_null = match patterns_never_returning_null with (k,r) -> (k,!r)
-and patterns_skip_translation = !patterns_skip_translation
+and patterns_skip_translation = match patterns_skip_translation with (k,r) -> (k,!r)
-and patterns_modeled_expensive = !patterns_modeled_expensive
+and patterns_modeled_expensive = match patterns_modeled_expensive with (k,r) -> (k,!r)
 and pmd_xml = !pmd_xml
 and precondition_stats = !precondition_stats
 and print_builtins = !print_builtins
@@ -1569,6 +1463,7 @@ and stacktrace = !stacktrace
 and stacktraces_dir = !stacktraces_dir
 and stats_mode = !stats
 and subtype_multirange = !subtype_multirange
+and suppress_warnings_out = !suppress_warnings_out
 and svg = !svg
 and symops_per_iteration = !symops_per_iteration
 and test = !test
@@ -1624,28 +1519,6 @@ let clang_frontend_action_string =
 
 let dynamic_dispatch = if analyzer = Tracing then `Lazy else !dynamic_dispatch
 
-let patterns_suppress_warnings =
-  let error msg =
-    F.eprintf "There was an issue reading the option %s.@\n"
-      suppress_warnings_annotations_long ;
-    F.eprintf "If you did not call %s directly, this is likely a bug in Infer.@\n"
-      (Filename.basename Sys.executable_name) ;
-    F.eprintf "%s@." msg ;
-    [] in
-  match !suppress_warnings_out with
-  | Some path -> (
-      match Utils.read_optional_json_file path with
-      | Ok json -> (
-          let json_key = "suppress_warnings" in
-          match Yojson.Basic.Util.member json_key json with
-          | `Null -> []
-          | json -> patterns_of_json_with_key json_key json)
-      | Error msg -> error ("Could not read or parse the supplied " ^ path ^ ":\n" ^ msg))
-  | None when CLOpt.(current_exe <> Java) -> []
-  | None when Option.is_some generated_classes -> []
-  | None ->
-      error ("Error: The option " ^ suppress_warnings_annotations_long ^ " was not provided")
-
 let specs_library =
   match infer_cache with
   | Some cache_dir when use_jar_cache ->

infer/src/base/Config.mli

@@ -35,17 +35,6 @@ val ml_bucket_symbols :
 type os_type = Unix | Win32 | Cygwin
 
 
-type method_pattern = {
-  class_name : string;
-  method_name : string option;
-  parameters : (string list) option;
-}
-
-type pattern =
-  | Method_pattern of language * method_pattern
-  | Source_contains of language * string
-
-
 (** Constant configuration values *)
 
 val allow_missing_index_in_proc_call : bool
@@ -77,6 +66,7 @@ val global_tenv_filename : string
 val idempotent_getters : bool
 val incremental_procs : bool
 val infer_py_argparse_error_exit_code : int
+val inferconfig_file : string
 val initial_analysis_time : float
 val ivar_attributes : string
 val lib_dir : string
@@ -99,10 +89,9 @@ val multicore_dir_name : string
 val ncpu : int
 val nsnotification_center_checker_backend : bool
 val os_type : os_type
-val patterns_modeled_expensive : pattern list
+val patterns_modeled_expensive : string * Yojson.Basic.json
-val patterns_never_returning_null : pattern list
+val patterns_never_returning_null : string * Yojson.Basic.json
-val patterns_skip_translation : pattern list
+val patterns_skip_translation : string * Yojson.Basic.json
-val patterns_suppress_warnings : pattern list
 val perf_stats_prefix : string
 val proc_stats_filename : string
 val property_attributes : string
@@ -118,6 +107,7 @@ val sources : string list
 val sourcepath : string option
 val specs_dir_name : string
 val specs_files_suffix : string
+val suppress_warnings_annotations_long : string
 val start_filename : string
 val taint_analysis : bool
 val trace_absarray : bool
@@ -260,6 +250,7 @@ val stacktrace : string option
 val stacktraces_dir : string option
 val stats_mode : bool
 val subtype_multirange : bool
+val suppress_warnings_out : string option
 val svg : bool
 val symops_per_iteration : int
 val test : bool