[config] Add RevList for explicit reversed list in Config

Summary:
In `Config`, the lists generated by `mk_string_list`, `mk_path_list`, `mk_rest_actions` are reversed implicitly, which made it hard for developers to use them correctly. What this and the next diff will do is to change the list variables of the `Config` to not-reversed one.

* diff1: First this diff adds `RevList` to distinguish reversed lists explicitly. All usages of the reversed list should be changed to use `RevList`'s lib calls.

* diff2: Then the next diff will change types of `Config` variables to not-reversed, normal list.

Reviewed By: ngorogiannis

Differential Revision: D25562297

fbshipit-source-id: b96622336
master
Sungkeun Cho 4 years ago committed by Facebook GitHub Bot
parent edc8754727
commit 153005c3cb

@ -108,7 +108,7 @@ module Match = struct
let of_fuzzy_qual_names ?prefix fuzzy_qual_names = let of_fuzzy_qual_names ?prefix fuzzy_qual_names =
List.rev_map fuzzy_qual_names ~f:qualifiers_of_fuzzy_qual_name RevList.rev_map fuzzy_qual_names ~f:qualifiers_of_fuzzy_qual_name
|> qualifiers_list_matcher ?prefix |> qualifiers_list_matcher ?prefix

@ -87,7 +87,7 @@ val pp : Format.formatter -> t -> unit
module Match : sig module Match : sig
type quals_matcher type quals_matcher
val of_fuzzy_qual_names : ?prefix:bool -> string list -> quals_matcher val of_fuzzy_qual_names : ?prefix:bool -> string RevList.t -> quals_matcher
val match_qualifiers : quals_matcher -> t -> bool val match_qualifiers : quals_matcher -> t -> bool
end end

@ -30,14 +30,14 @@ let do_not_filter : filters =
type filter_config = type filter_config =
{ whitelist: string list { whitelist: string RevList.t
; blacklist: string list ; blacklist: string RevList.t
; blacklist_files_containing: string list ; blacklist_files_containing: string RevList.t
; suppress_errors: string list } ; suppress_errors: string RevList.t }
let is_matching patterns source_file = let is_matching patterns source_file =
let path = SourceFile.to_rel_path source_file in let path = SourceFile.to_rel_path source_file in
List.exists RevList.exists
~f:(fun pattern -> ~f:(fun pattern ->
try Int.equal (Str.search_forward pattern path 0) 0 with Caml.Not_found -> false ) try Int.equal (Str.search_forward pattern path 0) 0 with Caml.Not_found -> false )
patterns patterns
@ -77,19 +77,20 @@ module FileContainsStringMatcher = struct
Utils.with_file_in path ~f:(fun file_in -> not (loop regexp_not file_in)) ) Utils.with_file_in path ~f:(fun file_in -> not (loop regexp_not file_in)) )
let create_matcher (s_patterns : contains_pattern list) = let create_matcher (s_patterns : contains_pattern RevList.t) =
if List.is_empty s_patterns then default_matcher if RevList.is_empty s_patterns then default_matcher
else else
let source_map = ref SourceFile.Map.empty in let source_map = ref SourceFile.Map.empty in
let not_contains_patterns = let not_contains_patterns =
List.exists ~f:(fun {not_contains} -> Option.is_some not_contains) s_patterns RevList.exists ~f:(fun {not_contains} -> Option.is_some not_contains) s_patterns
in in
let disjunctive_regexp = let disjunctive_regexp =
Str.regexp (String.concat ~sep:"\\|" (List.map ~f:(fun {contains} -> contains) s_patterns)) Str.regexp
(String.concat ~sep:"\\|" (RevList.rev_map ~f:(fun {contains} -> contains) s_patterns))
in in
let cond check_regexp = let cond check_regexp =
if not_contains_patterns then if not_contains_patterns then
List.exists RevList.exists
~f:(fun {contains; not_contains} -> ~f:(fun {contains; not_contains} ->
check_regexp (Str.regexp contains) (Option.map not_contains ~f:Str.regexp) ) check_regexp (Str.regexp contains) (Option.map not_contains ~f:Str.regexp) )
s_patterns s_patterns
@ -124,10 +125,10 @@ module FileOrProcMatcher = struct
let default_matcher : matcher = fun _ _ -> false let default_matcher : matcher = fun _ _ -> false
let create_method_matcher m_patterns = let create_method_matcher m_patterns =
if List.is_empty m_patterns then default_matcher if RevList.is_empty m_patterns then default_matcher
else else
let pattern_map = let pattern_map =
List.fold RevList.fold
~f:(fun map pattern -> ~f:(fun map pattern ->
let previous = let previous =
try String.Map.find_exn map pattern.class_name try String.Map.find_exn map pattern.class_name
@ -155,11 +156,11 @@ module FileOrProcMatcher = struct
let s_patterns, m_patterns = let s_patterns, m_patterns =
let collect (s_patterns, m_patterns) = function let collect (s_patterns, m_patterns) = function
| Source_pattern (_, s) -> | Source_pattern (_, s) ->
(s :: s_patterns, m_patterns) (RevList.cons s s_patterns, m_patterns)
| Method_pattern (_, mp) -> | Method_pattern (_, mp) ->
(s_patterns, mp :: m_patterns) (s_patterns, RevList.cons mp m_patterns)
in in
List.fold ~f:collect ~init:([], []) patterns List.fold ~f:collect ~init:(RevList.empty, RevList.empty) patterns
in in
let s_matcher = let s_matcher =
let matcher = FileContainsStringMatcher.create_matcher s_patterns in let matcher = FileContainsStringMatcher.create_matcher s_patterns in
@ -330,15 +331,15 @@ let load_filters () =
let filters_from_inferconfig inferconfig : filters = let filters_from_inferconfig inferconfig : filters =
let path_filter = let path_filter =
let whitelist_filter : path_filter = let whitelist_filter : path_filter =
if List.is_empty inferconfig.whitelist then default_path_filter if RevList.is_empty inferconfig.whitelist then default_path_filter
else is_matching (List.map ~f:Str.regexp inferconfig.whitelist) else is_matching (RevList.map ~f:Str.regexp inferconfig.whitelist)
in in
let blacklist_filter : path_filter = let blacklist_filter : path_filter =
is_matching (List.map ~f:Str.regexp inferconfig.blacklist) is_matching (RevList.map ~f:Str.regexp inferconfig.blacklist)
in in
let blacklist_files_containing_filter : path_filter = let blacklist_files_containing_filter : path_filter =
FileContainsStringMatcher.create_matcher FileContainsStringMatcher.create_matcher
(List.map (RevList.map
~f:(fun s -> {contains= s; not_contains= None}) ~f:(fun s -> {contains= s; not_contains= None})
inferconfig.blacklist_files_containing) inferconfig.blacklist_files_containing)
in in
@ -351,7 +352,7 @@ let filters_from_inferconfig inferconfig : filters =
let error_filter = function let error_filter = function
| error_name -> | error_name ->
let error_str = error_name.IssueType.unique_id in let error_str = error_name.IssueType.unique_id in
not (List.exists ~f:(String.equal error_str) inferconfig.suppress_errors) not (RevList.exists ~f:(String.equal error_str) inferconfig.suppress_errors)
in in
{path_filter; error_filter; proc_filter= default_proc_filter} {path_filter; error_filter; proc_filter= default_proc_filter}

@ -123,12 +123,12 @@ end = struct
List.concat_map lock_models ~f:(fun mdl -> List.concat_map lock_models ~f:(fun mdl ->
List.map (f mdl) ~f:(fun mtd -> mdl.classname ^ "::" ^ mtd) ) List.map (f mdl) ~f:(fun mtd -> mdl.classname ^ "::" ^ mtd) )
in in
mk_matcher lock_methods mk_matcher (RevList.of_list lock_methods)
in in
( mk_model_matcher ~f:(fun mdl -> mdl.lock) ( mk_model_matcher ~f:(fun mdl -> mdl.lock)
, mk_model_matcher ~f:(fun mdl -> mdl.unlock) , mk_model_matcher ~f:(fun mdl -> mdl.unlock)
, mk_model_matcher ~f:(fun mdl -> mdl.trylock) , mk_model_matcher ~f:(fun mdl -> mdl.trylock)
, mk_matcher ["std::lock"] ) , mk_matcher (RevList.of_list ["std::lock"]) )
(** C++ guard classes used for scope-based lock management. NB we pretend all classes below (** C++ guard classes used for scope-based lock management. NB we pretend all classes below
@ -192,11 +192,11 @@ end = struct
let is_guard_constructor, is_guard_destructor, is_guard_unlock, is_guard_lock, is_guard_trylock = let is_guard_constructor, is_guard_destructor, is_guard_unlock, is_guard_lock, is_guard_trylock =
let make ~f = let make ~f =
let constructors = List.map guards ~f in let constructors = List.map guards ~f in
mk_matcher constructors mk_matcher (RevList.of_list constructors)
in in
let make_trylock ~f = let make_trylock ~f =
let methods = List.concat_map guards ~f in let methods = List.concat_map guards ~f in
mk_matcher methods mk_matcher (RevList.of_list methods)
in in
( make ~f:get_guard_constructor ( make ~f:get_guard_constructor
, make ~f:get_guard_destructor , make ~f:get_guard_destructor

@ -331,13 +331,14 @@ let context_with_ck_set context decl_list =
let find_linters_files () = let find_linters_files () =
List.concat_map RevList.rev_concat_map
~f:(fun folder -> Utils.find_files ~path:folder ~extension:".al") ~f:(fun folder -> Utils.find_files ~path:folder ~extension:".al")
Config.linters_def_folder Config.linters_def_folder
let linters_files = let linters_files =
List.dedup_and_sort ~compare:String.compare (find_linters_files () @ Config.linters_def_file) RevList.dedup_and_sort ~compare:String.compare
(RevList.rev_append (find_linters_files ()) Config.linters_def_file)
let is_decl_allowed lcxt decl = let is_decl_allowed lcxt decl =

@ -29,7 +29,7 @@ let validate_al_files () =
None None
with CTLExceptions.ALFileException exc_info -> Some (CTLExceptions.json_of_exc_info exc_info) with CTLExceptions.ALFileException exc_info -> Some (CTLExceptions.json_of_exc_info exc_info)
in in
match List.filter_map ~f:validate_al_file Config.linters_def_file with match RevList.rev_filter_map ~f:validate_al_file Config.linters_def_file with
| [] -> | [] ->
Ok () Ok ()
| _ as errors -> | _ as errors ->

@ -231,10 +231,9 @@ end = struct
let is_whitelisted = let is_whitelisted =
match Config.write_html_whitelist_regex with if RevList.is_empty Config.write_html_whitelist_regex then fun _ -> true
| [] -> else
fun _ -> true let reg_list = RevList.to_list Config.write_html_whitelist_regex in
| _ as reg_list ->
let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in let regex = Str.regexp (String.concat ~sep:"\\|" reg_list) in
fun file -> fun file ->
let fname = SourceFile.to_rel_path file in let fname = SourceFile.to_rel_path file in

@ -321,7 +321,7 @@ let subcommands = ref []
let subcommand_actions = ref [] let subcommand_actions = ref []
let rev_anon_args = ref [] let rev_anon_args = ref RevList.empty
(* keep track of the current active command to drive the remainder of the program *) (* keep track of the current active command to drive the remainder of the program *)
let curr_command = ref None let curr_command = ref None
@ -539,14 +539,15 @@ let mk_string_list ?(default = []) ?(default_to_string = String.concat ~sep:",")
?(deprecated = []) ~long ?short ?parse_mode ?in_help ?(meta = "string") doc = ?(deprecated = []) ~long ?short ?parse_mode ?in_help ?(meta = "string") doc =
let flag = mk_flag ~deprecated ?short ~long in let flag = mk_flag ~deprecated ?short ~long in
let mk () = let mk () =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta:("+" ^ meta) doc mk ~deprecated ~long ?short ~default:(RevList.of_list default) ?parse_mode ?in_help
~default_to_string ~meta:("+" ^ meta) doc
~mk_setter:(fun var str -> var := f str :: !var) ~default_to_string:(fun rev -> RevList.to_list rev |> default_to_string)
~mk_setter:(fun var str -> var := RevList.cons (f str) !var)
~decode_json:(list_json_decoder (string_json_decoder ~flag)) ~decode_json:(list_json_decoder (string_json_decoder ~flag))
~mk_spec:(fun set -> String set) ~mk_spec:(fun set -> String set)
in in
let reset_doc = reset_doc_list ~long in let reset_doc = reset_doc_list ~long in
mk_with_reset [] ~reset_doc ~long ?parse_mode mk mk_with_reset RevList.empty ~reset_doc ~long ?parse_mode mk
let map_to_str map = let map_to_str map =
@ -634,13 +635,14 @@ let mk_path_list ?(default = []) ?(default_to_string = String.concat ~sep:", ")
let flag = mk_flag ~deprecated ?short ~long in let flag = mk_flag ~deprecated ?short ~long in
let mk () = let mk () =
mk_path_helper mk_path_helper
~setter:(fun var x -> var := x :: !var) ~setter:(fun var x -> var := RevList.cons x !var)
~decode_json:(list_json_decoder (path_json_decoder ~flag)) ~decode_json:(list_json_decoder (path_json_decoder ~flag))
~default_to_string ~default ~deprecated ~long ~short ~parse_mode ~in_help ~meta:("+" ^ meta) ~default_to_string:(fun rev -> RevList.to_list rev |> default_to_string)
doc ~default:(RevList.of_list default) ~deprecated ~long ~short ~parse_mode ~in_help
~meta:("+" ^ meta) doc
in in
let reset_doc = reset_doc_list ~long in let reset_doc = reset_doc_list ~long in
mk_with_reset [] ~reset_doc ~long ?parse_mode mk mk_with_reset RevList.empty ~reset_doc ~long ?parse_mode mk
let mk_symbols_meta symbols = let mk_symbols_meta symbols =
@ -807,11 +809,12 @@ let string_of_command command =
let mk_rest_actions ?(parse_mode = InferCommand) ?(in_help = []) doc ~usage decode_action = let mk_rest_actions ?(parse_mode = InferCommand) ?(in_help = []) doc ~usage decode_action =
let rest = ref [] in let rest = ref RevList.empty in
let spec = let spec =
String String
(fun arg -> (fun arg ->
rest := List.rev (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ; rest :=
RevList.of_list (Array.to_list (Array.slice !args_to_parse (!arg_being_parsed + 1) 0)) ;
select_parse_mode ~usage (decode_action arg) |> ignore ) select_parse_mode ~usage (decode_action arg) |> ignore )
in in
add parse_mode in_help add parse_mode in_help
@ -882,7 +885,7 @@ let anon_fun arg =
else else
match !anon_arg_action.on_unknown with match !anon_arg_action.on_unknown with
| `Add -> | `Add ->
rev_anon_args := arg :: !rev_anon_args rev_anon_args := RevList.cons arg !rev_anon_args
| `Skip -> | `Skip ->
() ()
| `Reject -> | `Reject ->

@ -93,7 +93,7 @@ val mk_string_list :
?default:string list ?default:string list
-> ?default_to_string:(string list -> string) -> ?default_to_string:(string list -> string)
-> ?f:(string -> string) -> ?f:(string -> string)
-> string list ref t -> string RevList.t ref t
(** [mk_string_list] defines a [string list ref], initialized to [\[\]] unless overridden by (** [mk_string_list] defines a [string list ref], initialized to [\[\]] unless overridden by
[~default]. Each argument of an occurrence of the option will be prepended to the list, so the [~default]. Each argument of an occurrence of the option will be prepended to the list, so the
final value will be in the reverse order they appeared on the command line. final value will be in the reverse order they appeared on the command line.
@ -116,7 +116,7 @@ val mk_path_opt :
(** analogous of [mk_string_opt] with the extra feature of [mk_path] *) (** analogous of [mk_string_opt] with the extra feature of [mk_path] *)
val mk_path_list : val mk_path_list :
?default:string list -> ?default_to_string:(string list -> string) -> string list ref t ?default:string list -> ?default_to_string:(string list -> string) -> string RevList.t ref t
(** analogous of [mk_string_list] with the extra feature of [mk_path] *) (** analogous of [mk_string_list] with the extra feature of [mk_path] *)
val mk_symbol : val mk_symbol :
@ -136,7 +136,7 @@ val mk_symbol_seq :
val mk_json : Yojson.Basic.t ref t val mk_json : Yojson.Basic.t ref t
val mk_anon : unit -> string list ref val mk_anon : unit -> string RevList.t ref
[@@warning "-32"] [@@warning "-32"]
(** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse (** [mk_anon ()] defines a [string list ref] of the anonymous command line arguments, in the reverse
order they appeared on the command line. *) order they appeared on the command line. *)
@ -147,7 +147,7 @@ val mk_rest_actions :
-> string -> string
-> usage:string -> usage:string
-> (string -> parse_mode) -> (string -> parse_mode)
-> string list ref -> string RevList.t ref
(** [mk_rest_actions doc ~usage command_to_parse_mode] defines a [string list ref] of the command (** [mk_rest_actions doc ~usage command_to_parse_mode] defines a [string list ref] of the command
line arguments following ["--"], in the reverse order they appeared on the command line. [usage] line arguments following ["--"], in the reverse order they appeared on the command line. [usage]
is the usage message in case of parse errors or if --help is passed. For example, calling is the usage message in case of parse errors or if --help is passed. For example, calling

@ -1200,7 +1200,7 @@ and differential_filter_set =
and () = and () =
let mk b ?deprecated ~long ?default doc = let mk b ?deprecated ~long ?default doc =
let (_ : string list ref) = let (_ : string RevList.t ref) =
CLOpt.mk_string_list ?deprecated ~long CLOpt.mk_string_list ?deprecated ~long
~f:(fun issue_id -> ~f:(fun issue_id ->
let issue = let issue =
@ -1534,7 +1534,7 @@ and linters_def_folder =
~meta:"dir" "Specify the folder containing linters files with extension .al" ~meta:"dir" "Specify the folder containing linters files with extension .al"
in in
let () = let () =
CLOpt.mk_set linters_def_folder [] ~long:"reset-linters-def-folder" CLOpt.mk_set linters_def_folder RevList.empty ~long:"reset-linters-def-folder"
"Reset the list of folders containing linters definitions to be empty (see \ "Reset the list of folders containing linters definitions to be empty (see \
$(b,linters-def-folder))." $(b,linters-def-folder))."
in in
@ -2677,11 +2677,12 @@ let post_parsing_initialization command_opt =
if is_none !symops_per_iteration then symops_per_iteration := symops_timeout ; if is_none !symops_per_iteration then symops_per_iteration := symops_timeout ;
if is_none !seconds_per_iteration then seconds_per_iteration := seconds_timeout ; if is_none !seconds_per_iteration then seconds_per_iteration := seconds_timeout ;
clang_compilation_dbs := clang_compilation_dbs :=
List.rev_map ~f:(fun x -> `Raw x) !compilation_database RevList.rev_map ~f:(fun x -> `Raw x) !compilation_database
|> List.rev_map_append ~f:(fun x -> `Escaped x) !compilation_database_escaped ; |> RevList.rev_map_append ~f:(fun x -> `Escaped x) !compilation_database_escaped ;
(* set analyzer mode to linters in linters developer mode *) (* set analyzer mode to linters in linters developer mode *)
if !linters_developer_mode then enable_checker Linters ; if !linters_developer_mode then enable_checker Linters ;
if !default_linters then linters_def_file := linters_def_default_file :: !linters_def_file ; if !default_linters then
linters_def_file := RevList.cons linters_def_default_file !linters_def_file ;
( match !analyzer with ( match !analyzer with
| Linters -> | Linters ->
disable_all_checkers () ; disable_all_checkers () ;
@ -2710,7 +2711,7 @@ let process_linters_doc_url args =
but got %s" but got %s"
arg arg
in in
let linter_doc_url_assocs = List.rev_map ~f:linters_doc_url args in let linter_doc_url_assocs = RevList.rev_map ~f:linters_doc_url args in
fun ~linter_id -> List.Assoc.find ~equal:String.equal linter_doc_url_assocs linter_id fun ~linter_id -> List.Assoc.find ~equal:String.equal linter_doc_url_assocs linter_id
@ -2785,7 +2786,7 @@ and capture = !capture
and capture_blacklist = !capture_blacklist and capture_blacklist = !capture_blacklist
and censor_report = and censor_report =
List.map !censor_report ~f:(fun str -> RevList.map !censor_report ~f:(fun str ->
match String.split str ~on:':' with match String.split str ~on:':' with
| [issue_type_re; filename_re; reason_str] | [issue_type_re; filename_re; reason_str]
when not String.(is_empty issue_type_re || is_empty filename_re || is_empty reason_str) -> when not String.(is_empty issue_type_re || is_empty filename_re || is_empty reason_str) ->
@ -2934,7 +2935,7 @@ and genrule_mode = !genrule_mode
and get_linter_doc_url = process_linters_doc_url !linters_doc_url and get_linter_doc_url = process_linters_doc_url !linters_doc_url
and help_checker = and help_checker =
List.map !help_checker ~f:(fun checker_string -> RevList.map !help_checker ~f:(fun checker_string ->
match Checker.from_id checker_string with match Checker.from_id checker_string with
| Some checker -> | Some checker ->
checker checker
@ -2946,7 +2947,7 @@ and help_checker =
and help_issue_type = and help_issue_type =
List.map !help_issue_type ~f:(fun id -> RevList.map !help_issue_type ~f:(fun id ->
match IssueType.find_from_string ~id with match IssueType.find_from_string ~id with
| Some issue_type -> | Some issue_type ->
issue_type issue_type
@ -3139,7 +3140,7 @@ and pulse_model_skip_pattern = Option.map ~f:Str.regexp !pulse_model_skip_patter
and pulse_model_transfer_ownership_namespace, pulse_model_transfer_ownership = and pulse_model_transfer_ownership_namespace, pulse_model_transfer_ownership =
let models = let models =
let re = Str.regexp "::" in let re = Str.regexp "::" in
List.map ~f:(fun model -> (model, Str.split re model)) !pulse_model_transfer_ownership RevList.map ~f:(fun model -> (model, Str.split re model)) !pulse_model_transfer_ownership
in in
let aux el = let aux el =
match el with match el with
@ -3154,7 +3155,7 @@ and pulse_model_transfer_ownership_namespace, pulse_model_transfer_ownership =
option option
(List.length splits - 1) (List.length splits - 1)
in in
List.partition_map ~f:aux models RevList.rev_partition_map ~f:aux models
and pulse_recency_limit = !pulse_recency_limit and pulse_recency_limit = !pulse_recency_limit
@ -3431,11 +3432,7 @@ let dynamic_dispatch = is_checker_enabled Biabduction
(** Check if a Java package is external to the repository *) (** Check if a Java package is external to the repository *)
let java_package_is_external package = let java_package_is_external package =
match external_java_packages with RevList.exists external_java_packages ~f:(fun (prefix : string) ->
| [] ->
false
| _ ->
List.exists external_java_packages ~f:(fun (prefix : string) ->
String.is_prefix package ~prefix ) String.is_prefix package ~prefix )

@ -39,7 +39,7 @@ val anonymous_block_num_sep : string
val anonymous_block_prefix : string val anonymous_block_prefix : string
val append_buck_flavors : string list val append_buck_flavors : string RevList.t
val assign : string val assign : string
@ -132,7 +132,7 @@ val kotlin_source_extension : string
val sourcepath : string option val sourcepath : string option
val sources : string list val sources : string RevList.t
val trace_absarray : bool val trace_absarray : bool
@ -174,11 +174,11 @@ val bootclasspath : string option
val buck : bool val buck : bool
val buck_blacklist : string list val buck_blacklist : string RevList.t
val buck_build_args : string list val buck_build_args : string RevList.t
val buck_build_args_no_inline_rev : string list val buck_build_args_no_inline_rev : string RevList.t
val buck_cache_mode : bool val buck_cache_mode : bool
@ -188,7 +188,7 @@ val buck_mode : BuckMode.t option
val buck_out_gen : string val buck_out_gen : string
val buck_targets_blacklist : string list val buck_targets_blacklist : string RevList.t
val call_graph_schedule : bool val call_graph_schedule : bool
@ -196,7 +196,7 @@ val capture : bool
val capture_blacklist : string option val capture_blacklist : string option
val censor_report : ((bool * Str.regexp) * (bool * Str.regexp) * string) list val censor_report : ((bool * Str.regexp) * (bool * Str.regexp) * string) RevList.t
val changed_files_index : string option val changed_files_index : string option
@ -206,11 +206,11 @@ val clang_ast_file : [`Biniou of string | `Yojson of string] option
val clang_compound_literal_init_limit : int val clang_compound_literal_init_limit : int
val clang_extra_flags : string list val clang_extra_flags : string RevList.t
val clang_blacklisted_flags : string list val clang_blacklisted_flags : string RevList.t
val clang_blacklisted_flags_with_arg : string list val clang_blacklisted_flags_with_arg : string RevList.t
val clang_ignore_regex : string option val clang_ignore_regex : string option
@ -310,9 +310,9 @@ val genrule_mode : bool
val get_linter_doc_url : linter_id:string -> string option val get_linter_doc_url : linter_id:string -> string option
val help_checker : Checker.t list val help_checker : Checker.t RevList.t
val help_issue_type : IssueType.t list val help_issue_type : IssueType.t RevList.t
val hoisting_report_only_expensive : bool val hoisting_report_only_expensive : bool
@ -362,9 +362,9 @@ val keep_going : bool
val linter : string option val linter : string option
val linters_def_file : string list val linters_def_file : string RevList.t
val linters_def_folder : string list val linters_def_folder : string RevList.t
val linters_developer_mode : bool val linters_developer_mode : bool
@ -378,7 +378,7 @@ val list_issue_types : bool
val liveness_dangerous_classes : Yojson.Basic.t val liveness_dangerous_classes : Yojson.Basic.t
val liveness_ignored_constant : string list val liveness_ignored_constant : string RevList.t
val max_nesting : int option val max_nesting : int option
@ -471,13 +471,13 @@ val pulse_isl : bool [@@warning "-32"]
val pulse_max_disjuncts : int val pulse_max_disjuncts : int
val pulse_model_abort : string list val pulse_model_abort : string RevList.t
val pulse_model_alloc_pattern : Str.regexp option val pulse_model_alloc_pattern : Str.regexp option
val pulse_model_release_pattern : Str.regexp option val pulse_model_release_pattern : Str.regexp option
val pulse_model_return_nonnull : string list val pulse_model_return_nonnull : string RevList.t
val pulse_model_skip_pattern : Str.regexp option val pulse_model_skip_pattern : Str.regexp option
@ -509,7 +509,7 @@ val reactive_mode : bool
val reanalyze : bool val reanalyze : bool
val report_blacklist_files_containing : string list val report_blacklist_files_containing : string RevList.t
val report_console_limit : int option val report_console_limit : int option
@ -517,17 +517,17 @@ val report_current : string option
val report_formatter : [`No_formatter | `Phabricator_formatter] val report_formatter : [`No_formatter | `Phabricator_formatter]
val report_path_regex_blacklist : string list val report_path_regex_blacklist : string RevList.t
val report_path_regex_whitelist : string list val report_path_regex_whitelist : string RevList.t
val report_previous : string option val report_previous : string option
val report_suppress_errors : string list val report_suppress_errors : string RevList.t
val reports_include_ml_loc : bool val reports_include_ml_loc : bool
val rest : string list val rest : string RevList.t
val results_dir : string val results_dir : string
@ -547,15 +547,15 @@ val show_buckets : bool
val siof_check_iostreams : bool val siof_check_iostreams : bool
val siof_safe_methods : string list val siof_safe_methods : string RevList.t
val skip_analysis_in_path : string list val skip_analysis_in_path : string RevList.t
val skip_analysis_in_path_skips_compilation : bool val skip_analysis_in_path_skips_compilation : bool
val skip_duplicated_types : bool val skip_duplicated_types : bool
val skip_translation_headers : string list val skip_translation_headers : string RevList.t
val source_files : bool val source_files : bool
@ -607,7 +607,7 @@ val topl_max_conjuncts : int
val topl_max_disjuncts : int val topl_max_disjuncts : int
val topl_properties : string list val topl_properties : string RevList.t
val trace_error : bool val trace_error : bool
@ -641,7 +641,7 @@ val write_dotty : bool
val write_html : bool val write_html : bool
val write_html_whitelist_regex : string list val write_html_whitelist_regex : string RevList.t
val write_website : string option val write_website : string option

@ -14,7 +14,7 @@ module L = Logging
module F = Format module F = Format
module DExp = DecompiledExp module DExp = DecompiledExp
let vector_matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["std::vector"] let vector_matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::vector"])
let is_one_of_classes = QualifiedCppName.Match.match_qualifiers let is_one_of_classes = QualifiedCppName.Match.match_qualifiers

@ -50,7 +50,8 @@ let models = List.map ~f:parse_siof_model [("std::ios_base::Init::Init", standar
let is_modelled = let is_modelled =
let models_matcher = let models_matcher =
List.map models ~f:(fun {qual_name} -> qual_name) |> QualifiedCppName.Match.of_fuzzy_qual_names List.map models ~f:(fun {qual_name} -> qual_name)
|> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names
in in
fun pname -> fun pname ->
Procname.get_qualifiers pname |> QualifiedCppName.Match.match_qualifiers models_matcher Procname.get_qualifiers pname |> QualifiedCppName.Match.match_qualifiers models_matcher
@ -75,7 +76,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let filter_global_accesses initialized = let filter_global_accesses initialized =
let initialized_matcher = let initialized_matcher =
Domain.VarNames.elements initialized |> QualifiedCppName.Match.of_fuzzy_qual_names Domain.VarNames.elements initialized
|> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names
in in
Staged.stage (fun (* gvar \notin initialized, up to some fuzzing *) Staged.stage (fun (* gvar \notin initialized, up to some fuzzing *)
gvar -> gvar ->
@ -153,7 +155,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let init = let init =
List.find_map_exn models ~f:(fun {qual_name; initialized_globals} -> List.find_map_exn models ~f:(fun {qual_name; initialized_globals} ->
if if
QualifiedCppName.Match.of_fuzzy_qual_names [qual_name] QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [qual_name])
|> Fn.flip QualifiedCppName.Match.match_qualifiers |> Fn.flip QualifiedCppName.Match.match_qualifiers
(Procname.get_qualifiers callee_pname) (Procname.get_qualifiers callee_pname)
then Some initialized_globals then Some initialized_globals

@ -54,13 +54,15 @@ end
module CheckerMode : LivenessConfig = struct module CheckerMode : LivenessConfig = struct
let blacklisted_destructor_matcher = let blacklisted_destructor_matcher =
QualifiedCppName.Match.of_fuzzy_qual_names QualifiedCppName.Match.of_fuzzy_qual_names
(RevList.of_list
(string_list_of_json ~option_name:"liveness-dangerous-classes" ~init:[] (string_list_of_json ~option_name:"liveness-dangerous-classes" ~init:[]
Config.liveness_dangerous_classes) Config.liveness_dangerous_classes))
(** hardcoded list of wrappers, mostly because they are impossible to specify as config options *) (** hardcoded list of wrappers, mostly because they are impossible to specify as config options *)
let standard_wrappers_matcher = let standard_wrappers_matcher =
QualifiedCppName.Match.of_fuzzy_qual_names ["std::unique_ptr"; "std::shared_ptr"] QualifiedCppName.Match.of_fuzzy_qual_names
(RevList.of_list ["std::unique_ptr"; "std::shared_ptr"])
let is_blacklisted_class_name class_name = let is_blacklisted_class_name class_name =
@ -176,7 +178,7 @@ let matcher_scope_guard =
let default_scope_guards = ["CKComponentKey"; "CKComponentScope"] in let default_scope_guards = ["CKComponentKey"; "CKComponentScope"] in
string_list_of_json ~option_name:"cxx-scope_guards" ~init:default_scope_guards string_list_of_json ~option_name:"cxx-scope_guards" ~init:default_scope_guards
Config.cxx_scope_guards Config.cxx_scope_guards
|> QualifiedCppName.Match.of_fuzzy_qual_names |> RevList.of_list |> QualifiedCppName.Match.of_fuzzy_qual_names
module CapturedByRefTransferFunctions (CFG : ProcCfg.S) = struct module CapturedByRefTransferFunctions (CFG : ProcCfg.S) = struct
@ -216,7 +218,7 @@ module IntLitSet = Caml.Set.Make (IntLit)
let ignored_constants = let ignored_constants =
let int_lit_constants = let int_lit_constants =
List.map RevList.map
~f:(fun el -> ~f:(fun el ->
try IntLit.of_string el try IntLit.of_string el
with Invalid_argument _ -> with Invalid_argument _ ->
@ -224,7 +226,7 @@ let ignored_constants =
"Ill-formed option '%s' for --liveness-ignored-constant: an integer was expected" el ) "Ill-formed option '%s' for --liveness-ignored-constant: an integer was expected" el )
Config.liveness_ignored_constant Config.liveness_ignored_constant
in in
IntLitSet.of_list int_lit_constants IntLitSet.of_seq (RevList.to_rev_seq int_lit_constants)
let checker {IntraproceduralAnalysis.proc_desc; err_log} = let checker {IntraproceduralAnalysis.proc_desc; err_log} =

@ -331,7 +331,7 @@ let get_superclass_decls decl =
let translate_as_type_ptr_matcher = let translate_as_type_ptr_matcher =
QualifiedCppName.Match.of_fuzzy_qual_names ["infer_traits::TranslateAsType"] QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["infer_traits::TranslateAsType"])
let get_translate_as_friend_decl decl_list = let get_translate_as_friend_decl decl_list =

@ -114,15 +114,16 @@ let filter_and_replace_unsupported_args ?(replace_options_arg = fun _ s -> s) ?(
(Exn.to_string e) ; (Exn.to_string e) ;
aux in_argfiles' (false, at_argfile :: res_rev, changed) tl ) aux in_argfiles' (false, at_argfile :: res_rev, changed) tl )
| flag :: tl | flag :: tl
when List.mem ~equal:String.equal Config.clang_blacklisted_flags flag when RevList.mem ~equal:String.equal Config.clang_blacklisted_flags flag
|| String.lsplit2 ~on:'=' flag || String.lsplit2 ~on:'=' flag
|> function |> function
| Some (flag, _arg) -> | Some (flag, _arg) ->
List.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag RevList.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag
| None -> | None ->
false -> false ->
aux in_argfiles (false, res_rev, true) tl aux in_argfiles (false, res_rev, true) tl
| flag :: tl when List.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag -> | flag :: tl when RevList.mem ~equal:String.equal Config.clang_blacklisted_flags_with_arg flag
->
(* remove the flag and its arg separately in case we are at the end of an argfile *) (* remove the flag and its arg separately in case we are at the end of an argfile *)
aux in_argfiles (true, res_rev, true) tl aux in_argfiles (true, res_rev, true) tl
| arg :: tl -> | arg :: tl ->
@ -204,7 +205,7 @@ let mk ~is_driver quoting_style ~prog ~args =
(* Some arguments break the compiler so they need to be removed even before the normalization step *) (* Some arguments break the compiler so they need to be removed even before the normalization step *)
let sanitized_args = filter_and_replace_unsupported_args args in let sanitized_args = filter_and_replace_unsupported_args args in
let sanitized_args = let sanitized_args =
if is_driver then sanitized_args @ List.rev Config.clang_extra_flags else sanitized_args if is_driver then sanitized_args @ RevList.to_list Config.clang_extra_flags else sanitized_args
in in
{exec= prog; orig_argv= sanitized_args; argv= sanitized_args; quoting_style; is_driver} {exec= prog; orig_argv= sanitized_args; argv= sanitized_args; quoting_style; is_driver}

@ -106,7 +106,7 @@ let return_param = "__return_param"
let self = "self" let self = "self"
let std_addressof = QualifiedCppName.Match.of_fuzzy_qual_names ["std::addressof"] let std_addressof = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::addressof"])
let string_with_utf8_m = "stringWithUTF8String:" let string_with_utf8_m = "stringWithUTF8String:"

@ -300,9 +300,11 @@ module CFrontend_decl_funct (T : CModule_type.CTranslation) : CModule_type.CFron
method should be translated based on method and class whitelists *) method should be translated based on method and class whitelists *)
let is_whitelisted_cpp_method = let is_whitelisted_cpp_method =
let method_matcher = let method_matcher =
QualifiedCppName.Match.of_fuzzy_qual_names Config.whitelisted_cpp_methods QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list Config.whitelisted_cpp_methods)
in
let class_matcher =
QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list Config.whitelisted_cpp_classes)
in in
let class_matcher = QualifiedCppName.Match.of_fuzzy_qual_names Config.whitelisted_cpp_classes in
fun qual_name -> fun qual_name ->
(* either the method is explictely whitelisted, or the whole class is whitelisted *) (* either the method is explictely whitelisted, or the whole class is whitelisted *)
QualifiedCppName.Match.match_qualifiers method_matcher qual_name QualifiedCppName.Match.match_qualifiers method_matcher qual_name

@ -24,7 +24,7 @@ let source_file_in_project source_file =
let file_in_project = SourceFile.is_under_project_root source_file in let file_in_project = SourceFile.is_under_project_root source_file in
let rel_source_file = SourceFile.to_string source_file in let rel_source_file = SourceFile.to_string source_file in
let file_should_be_skipped = let file_should_be_skipped =
List.exists RevList.exists
~f:(fun path -> String.is_prefix ~prefix:path rel_source_file) ~f:(fun path -> String.is_prefix ~prefix:path rel_source_file)
Config.skip_translation_headers Config.skip_translation_headers
in in
@ -83,7 +83,7 @@ let should_translate_lib translation_unit source_range decl_trans_context ~trans
let is_file_blacklisted file = let is_file_blacklisted file =
let paths = Config.skip_analysis_in_path in let paths = Config.skip_analysis_in_path in
let is_file_blacklisted = let is_file_blacklisted =
List.exists ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) paths RevList.exists ~f:(fun path -> Str.string_match (Str.regexp ("^.*/" ^ path)) file 0) paths
in in
is_file_blacklisted is_file_blacklisted

@ -45,7 +45,7 @@ let test_fuzzy_match =
; ("test_std_fuzzy_no_match1", ["std::foo"], ["std"; "__1"; "__2"; "foo"], false) ; ("test_std_fuzzy_no_match1", ["std::foo"], ["std"; "__1"; "__2"; "foo"], false)
; ("test_std_fuzzy_no_match2", ["std::foo"], ["std"; "__1"; "foo"; "bad"], false) ] ; ("test_std_fuzzy_no_match2", ["std::foo"], ["std"; "__1"; "foo"; "bad"], false) ]
|> List.map ~f:(fun (name, fuzzy_qual_names, qualifiers, expected_output) -> |> List.map ~f:(fun (name, fuzzy_qual_names, qualifiers, expected_output) ->
name >:: create_test fuzzy_qual_names qualifiers expected_output ) name >:: create_test (RevList.of_list fuzzy_qual_names) qualifiers expected_output )
let tests = "qualified_cpp_name_fuzzy_match" >::: test_fuzzy_match let tests = "qualified_cpp_name_fuzzy_match" >::: test_fuzzy_match

@ -119,7 +119,7 @@ let is_cpp_container_read =
QualifiedCppName.extract_last pname_qualifiers QualifiedCppName.extract_last pname_qualifiers
|> Option.exists ~f:(fun (last, _) -> String.equal last "operator[]") |> Option.exists ~f:(fun (last, _) -> String.equal last "operator[]")
in in
let matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["std::map::find"] in let matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["std::map::find"]) in
fun pname -> fun pname ->
let pname_qualifiers = Procname.get_qualifiers pname in let pname_qualifiers = Procname.get_qualifiers pname in
QualifiedCppName.Match.match_qualifiers matcher pname_qualifiers QualifiedCppName.Match.match_qualifiers matcher pname_qualifiers
@ -128,7 +128,8 @@ let is_cpp_container_read =
let is_cpp_container_write = let is_cpp_container_write =
let matcher = let matcher =
QualifiedCppName.Match.of_fuzzy_qual_names ["std::map::operator[]"; "std::map::erase"] QualifiedCppName.Match.of_fuzzy_qual_names
(RevList.of_list ["std::map::operator[]"; "std::map::erase"])
in in
fun pname -> QualifiedCppName.Match.match_qualifiers matcher (Procname.get_qualifiers pname) fun pname -> QualifiedCppName.Match.match_qualifiers matcher (Procname.get_qualifiers pname)
@ -162,6 +163,7 @@ let should_skip =
let matcher = let matcher =
lazy lazy
(QualifiedCppName.Match.of_fuzzy_qual_names ~prefix:true (QualifiedCppName.Match.of_fuzzy_qual_names ~prefix:true
(RevList.of_list
[ "folly::AtomicStruct" [ "folly::AtomicStruct"
; "folly::fbstring_core" ; "folly::fbstring_core"
; "folly::Future" ; "folly::Future"
@ -172,7 +174,7 @@ let should_skip =
; "folly::ThreadLocal" ; "folly::ThreadLocal"
; "folly::detail::SingletonHolder" ; "folly::detail::SingletonHolder"
; "std::atomic" ; "std::atomic"
; "std::vector" ]) ; "std::vector" ]))
in in
function function
| Procname.ObjC_Cpp cpp_pname as pname -> | Procname.ObjC_Cpp cpp_pname as pname ->

@ -168,14 +168,15 @@ let () =
if if
Config.( Config.(
list_checkers || list_issue_types || Option.is_some write_website list_checkers || list_issue_types || Option.is_some write_website
|| (not (List.is_empty help_checker)) || (not (RevList.is_empty help_checker))
|| not (List.is_empty help_issue_type)) || not (RevList.is_empty help_issue_type))
then ( then (
if Config.list_checkers then Help.list_checkers () ; if Config.list_checkers then Help.list_checkers () ;
if Config.list_issue_types then Help.list_issue_types () ; if Config.list_issue_types then Help.list_issue_types () ;
if not (List.is_empty Config.help_checker) then Help.show_checkers Config.help_checker ; if not (RevList.is_empty Config.help_checker) then
if not (List.is_empty Config.help_issue_type) then Help.show_checkers (RevList.to_list Config.help_checker) ;
Help.show_issue_types Config.help_issue_type ; if not (RevList.is_empty Config.help_issue_type) then
Help.show_issue_types (RevList.to_list Config.help_issue_type) ;
Option.iter Config.write_website ~f:(fun website_root -> Help.write_website ~website_root) ; Option.iter Config.write_website ~f:(fun website_root -> Help.write_website ~website_root) ;
() ) () )
else else

@ -97,7 +97,7 @@ module Target = struct
let add_flavor (mode : BuckMode.t) (command : InferCommand.t) ~extra_flavors target = let add_flavor (mode : BuckMode.t) (command : InferCommand.t) ~extra_flavors target =
let target = List.fold_left ~f:add_flavor_internal ~init:target extra_flavors in let target = RevList.fold ~f:add_flavor_internal ~init:target extra_flavors in
match (mode, command) with match (mode, command) with
| ClangCompilationDB _, _ -> | ClangCompilationDB _, _ ->
add_flavor_internal target "compilation-database" add_flavor_internal target "compilation-database"
@ -137,10 +137,10 @@ let config =
| None -> | None ->
[] ) [] )
@ @
if List.is_empty Config.buck_blacklist then [] if RevList.is_empty Config.buck_blacklist then []
else else
[ Printf.sprintf "*//infer.blacklist_regex=(%s)" [ Printf.sprintf "*//infer.blacklist_regex=(%s)"
(String.concat ~sep:")|(" Config.buck_blacklist) ] (String.concat ~sep:")|(" (RevList.to_list Config.buck_blacklist)) ]
in in
fun buck_mode -> fun buck_mode ->
let args = let args =
@ -296,7 +296,7 @@ module Query = struct
store_args_in_file ~identifier:"buck_query_args" (buck_config @ buck_output_options @ [query]) store_args_in_file ~identifier:"buck_query_args" (buck_config @ buck_output_options @ [query])
in in
let cmd = let cmd =
"buck" :: "query" :: List.rev_append Config.buck_build_args_no_inline_rev bounded_args "buck" :: "query" :: RevList.rev_append2 Config.buck_build_args_no_inline_rev bounded_args
in in
wrap_buck_call ~label:"query" cmd |> parse_query_output ?buck_mode wrap_buck_call ~label:"query" cmd |> parse_query_output ?buck_mode
end end
@ -368,10 +368,10 @@ let config =
| None -> | None ->
[] ) [] )
@ @
if List.is_empty Config.buck_blacklist then [] if RevList.is_empty Config.buck_blacklist then []
else else
[ Printf.sprintf "*//infer.blacklist_regex=(%s)" [ Printf.sprintf "*//infer.blacklist_regex=(%s)"
(String.concat ~sep:")|(" Config.buck_blacklist) ] (String.concat ~sep:")|(" (RevList.to_list Config.buck_blacklist)) ]
in in
fun buck_mode -> fun buck_mode ->
let args = let args =
@ -455,10 +455,13 @@ let parse_command_and_targets (buck_mode : BuckMode.t) original_buck_args =
let expanded_buck_args = inline_argument_files original_buck_args in let expanded_buck_args = inline_argument_files original_buck_args in
let command, args = split_buck_command expanded_buck_args in let command, args = split_buck_command expanded_buck_args in
let buck_targets_blacklist_regexp = let buck_targets_blacklist_regexp =
if List.is_empty Config.buck_targets_blacklist then None if RevList.is_empty Config.buck_targets_blacklist then None
else else
Some Some
(Str.regexp ("\\(" ^ String.concat ~sep:"\\)\\|\\(" Config.buck_targets_blacklist ^ "\\)")) (Str.regexp
( "\\("
^ String.concat ~sep:"\\)\\|\\(" (RevList.to_list Config.buck_targets_blacklist)
^ "\\)" ))
in in
let rec parse_cmd_args parsed_args = function let rec parse_cmd_args parsed_args = function
| [] -> | [] ->

@ -14,7 +14,7 @@ module Target : sig
val to_string : t -> string val to_string : t -> string
val add_flavor : BuckMode.t -> InferCommand.t -> extra_flavors:string list -> t -> t val add_flavor : BuckMode.t -> InferCommand.t -> extra_flavors:string RevList.t -> t -> t
end end
val wrap_buck_call : val wrap_buck_call :

@ -26,7 +26,8 @@ let add_flavors_to_buck_arguments buck_mode ~extra_flavors original_buck_args =
let capture_buck_args () = let capture_buck_args () =
("--show-output" :: (if Config.keep_going then ["--keep-going"] else [])) ("--show-output" :: (if Config.keep_going then ["--keep-going"] else []))
@ (match Config.load_average with Some l -> ["-L"; Float.to_string l] | None -> []) @ (match Config.load_average with Some l -> ["-L"; Float.to_string l] | None -> [])
@ Buck.config ClangFlavors @ List.rev Config.buck_build_args @ Buck.config ClangFlavors
@ RevList.to_list Config.buck_build_args
let run_buck_build prog buck_build_args = let run_buck_build prog buck_build_args =
@ -108,14 +109,14 @@ let capture build_cmd =
in in
Unix.putenv ~key:CLOpt.args_env_var ~data:infer_args_with_buck ; Unix.putenv ~key:CLOpt.args_env_var ~data:infer_args_with_buck ;
let {command; rev_not_targets; targets} = let {command; rev_not_targets; targets} =
add_flavors_to_buck_arguments ClangFlavors ~extra_flavors:[] buck_args add_flavors_to_buck_arguments ClangFlavors ~extra_flavors:RevList.empty buck_args
in in
if List.is_empty targets then () if List.is_empty targets then ()
else else
let all_args = List.rev_append rev_not_targets targets in let all_args = List.rev_append rev_not_targets targets in
let updated_buck_cmd = let updated_buck_cmd =
command command
:: List.rev_append Config.buck_build_args_no_inline_rev :: RevList.rev_append2 Config.buck_build_args_no_inline_rev
(Buck.store_args_in_file ~identifier:"clang_flavor_build" all_args) (Buck.store_args_in_file ~identifier:"clang_flavor_build" all_args)
in in
L.debug Capture Quiet "Processed buck command '%a'@\n" (Pp.seq F.pp_print_string) L.debug Capture Quiet "Processed buck command '%a'@\n" (Pp.seq F.pp_print_string)

@ -10,7 +10,7 @@ open! IStd
type flavored_arguments = {command: string; rev_not_targets: string list; targets: string list} type flavored_arguments = {command: string; rev_not_targets: string list; targets: string list}
val add_flavors_to_buck_arguments : val add_flavors_to_buck_arguments :
BuckMode.t -> extra_flavors:string list -> string list -> flavored_arguments BuckMode.t -> extra_flavors:string RevList.t -> string list -> flavored_arguments
(** Add infer flavors to the targets in the given buck arguments, depending on the infer analyzer. (** Add infer flavors to the targets in the given buck arguments, depending on the infer analyzer.
For instance, in clang capture mode, the buck command: build //foo/bar:baz#some,flavor becomes: For instance, in clang capture mode, the buck command: build //foo/bar:baz#some,flavor becomes:
build //foo/bar:baz#infer-capture-all,some,flavor *) build //foo/bar:baz#infer-capture-all,some,flavor *)

@ -170,7 +170,7 @@ let capture buck_mode build_cmd =
let updated_buck_cmd = let updated_buck_cmd =
(* make buck tell us where in buck-out are the capture directories for merging *) (* make buck tell us where in buck-out are the capture directories for merging *)
(prog :: command :: "--build-report" :: build_report_file :: Buck.config buck_mode) (prog :: command :: "--build-report" :: build_report_file :: Buck.config buck_mode)
@ List.rev_append Config.buck_build_args_no_inline_rev @ RevList.rev_append2 Config.buck_build_args_no_inline_rev
(Buck.store_args_in_file ~identifier:"genrule_build" all_args) (Buck.store_args_in_file ~identifier:"genrule_build" all_args)
in in
L.(debug Capture Quiet) L.(debug Capture Quiet)

@ -14,7 +14,7 @@ let capture build_cmd =
L.progress "Querying buck for java flavor capture targets...@." ; L.progress "Querying buck for java flavor capture targets...@." ;
let time0 = Mtime_clock.counter () in let time0 = Mtime_clock.counter () in
let BuckFlavors.{command; rev_not_targets; targets} = let BuckFlavors.{command; rev_not_targets; targets} =
BuckFlavors.add_flavors_to_buck_arguments JavaFlavor ~extra_flavors:[] buck_cmd BuckFlavors.add_flavors_to_buck_arguments JavaFlavor ~extra_flavors:RevList.empty buck_cmd
in in
L.progress "Found %d java flavor capture targets in %a.@." (List.length targets) Mtime.Span.pp L.progress "Found %d java flavor capture targets in %a.@." (List.length targets) Mtime.Span.pp
(Mtime_clock.count time0) ; (Mtime_clock.count time0) ;
@ -25,7 +25,7 @@ let capture build_cmd =
let updated_buck_cmd = let updated_buck_cmd =
(* make buck tell us where in buck-out are the capture directories for merging *) (* make buck tell us where in buck-out are the capture directories for merging *)
(prog :: command :: "--build-report" :: build_report_file :: Buck.config JavaFlavor) (prog :: command :: "--build-report" :: build_report_file :: Buck.config JavaFlavor)
@ List.rev_append Config.buck_build_args_no_inline_rev @ RevList.rev_append2 Config.buck_build_args_no_inline_rev
(Buck.store_args_in_file ~identifier:"java_flavor_build" all_args) (Buck.store_args_in_file ~identifier:"java_flavor_build" all_args)
in in
L.(debug Capture Quiet) L.(debug Capture Quiet)

@ -21,7 +21,8 @@ let create_cmd (source_file, (compilation_data : CompilationDatabase.compilation
( source_file ( source_file
, { CompilationDatabase.directory= compilation_data.directory , { CompilationDatabase.directory= compilation_data.directory
; executable= swap_executable compilation_data.executable ; executable= swap_executable compilation_data.executable
; escaped_arguments= ["@" ^ arg_file; "-fsyntax-only"] @ List.rev Config.clang_extra_flags } ) ; escaped_arguments=
["@" ^ arg_file; "-fsyntax-only"] @ RevList.to_list Config.clang_extra_flags } )
let invoke_cmd (source_file, (cmd : CompilationDatabase.compilation_data)) = let invoke_cmd (source_file, (cmd : CompilationDatabase.compilation_data)) =
@ -83,7 +84,8 @@ let get_compilation_database_files_buck db_deps ~prog ~args =
| {command= "build" as command; rev_not_targets; targets} -> | {command= "build" as command; rev_not_targets; targets} ->
let targets_args = Buck.store_args_in_file ~identifier:"compdb_build_args" targets in let targets_args = Buck.store_args_in_file ~identifier:"compdb_build_args" targets in
let build_args = let build_args =
(command :: List.rev_append rev_not_targets (List.rev Config.buck_build_args_no_inline_rev)) command
:: List.rev_append rev_not_targets (RevList.to_list Config.buck_build_args_no_inline_rev)
@ (* Infer doesn't support C++ modules nor precompiled headers yet (T35656509) *) @ (* Infer doesn't support C++ modules nor precompiled headers yet (T35656509) *)
"--config" :: "*//cxx.pch_enabled=false" :: "--config" :: "*//cxx.modules_default=false" "--config" :: "*//cxx.pch_enabled=false" :: "--config" :: "*//cxx.modules_default=false"
:: "--config" :: "*//cxx.modules=False" :: targets_args :: "--config" :: "*//cxx.modules=False" :: targets_args
@ -95,7 +97,7 @@ let get_compilation_database_files_buck db_deps ~prog ~args =
prog :: "targets" prog :: "targets"
:: List.rev_append :: List.rev_append
(Buck.filter_compatible `Targets rev_not_targets) (Buck.filter_compatible `Targets rev_not_targets)
(List.rev Config.buck_build_args_no_inline_rev) (RevList.to_list Config.buck_build_args_no_inline_rev)
@ ("--show-output" :: targets_args) @ ("--show-output" :: targets_args)
in in
let on_target_lines = function let on_target_lines = function

@ -372,7 +372,8 @@ let mode_of_build_command build_cmd (buck_mode : BuckMode.t option) =
| BBuck, Some CombinedGenrule -> | BBuck, Some CombinedGenrule ->
BuckCombinedGenrule {build_cmd} BuckCombinedGenrule {build_cmd}
| BBuck, Some (ClangCompilationDB deps) -> | BBuck, Some (ClangCompilationDB deps) ->
BuckCompilationDB {deps; prog; args= List.append args (List.rev Config.buck_build_args)} BuckCompilationDB
{deps; prog; args= List.append args (RevList.to_list Config.buck_build_args)}
| BBuck, Some ClangFlavors when Config.is_checker_enabled Linters -> | BBuck, Some ClangFlavors when Config.is_checker_enabled Linters ->
L.user_warning L.user_warning
"WARNING: the linters require --buck-compilation-database to be set.@ Alternatively, \ "WARNING: the linters require --buck-compilation-database to be set.@ Alternatively, \
@ -426,7 +427,7 @@ let mode_from_command_line =
assert_supported_mode `Java "Buck genrule" ; assert_supported_mode `Java "Buck genrule" ;
BuckGenrule {prog= path} BuckGenrule {prog= path}
| None -> | None ->
mode_of_build_command (List.rev Config.rest) Config.buck_mode ) mode_of_build_command (RevList.to_list Config.rest) Config.buck_mode )
let run_prologue mode = let run_prologue mode =

@ -100,7 +100,7 @@ let censored_reason (issue_type : IssueType.t) source_file =
in in
Option.some_if (not accepted) reason Option.some_if (not accepted) reason
in in
List.find_map Config.censor_report ~f:rejected_by RevList.find_map Config.censor_report ~f:rejected_by
let potential_exception_message = "potential exception at line" let potential_exception_message = "potential exception at line"

@ -0,0 +1,40 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
include List
let empty = []
let to_list = rev
let of_list = rev
let rev_partition_map t ~f =
let rec loop t fst snd =
match t with
| [] ->
(fst, snd)
| x :: t -> (
match (f x : _ Either.t) with
| First y ->
loop t (y :: fst) snd
| Second y ->
loop t fst (y :: snd) )
in
loop t [] []
let rev_concat_map rev ~f =
let rec aux acc = function [] -> acc | hd :: tl -> aux (rev_append (f hd) acc) tl in
aux [] rev
let rev_append2 = rev_append
let rec to_rev_seq rev =
match rev with [] -> fun () -> Seq.Nil | hd :: tl -> fun () -> Seq.Cons (hd, to_rev_seq tl)

@ -0,0 +1,48 @@
(*
* Copyright (c) Facebook, Inc. and its affiliates.
*
* This source code is licensed under the MIT license found in the
* LICENSE file in the root directory of this source tree.
*)
open! IStd
type 'a t
val empty : 'a t
val is_empty : 'a t -> bool
val cons : 'a -> 'a t -> 'a t
val to_list : 'a t -> 'a list
val of_list : 'a list -> 'a t
val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
val mem : 'a t -> 'a -> equal:('a -> 'a -> bool) -> bool
val exists : 'a t -> f:('a -> bool) -> bool
val map : 'a t -> f:('a -> 'b) -> 'b t
val rev_map : 'a t -> f:('a -> 'b) -> 'b list
val rev_map_append : 'a t -> 'b list -> f:('a -> 'b) -> 'b list
val rev_partition_map : 'a t -> f:('a -> ('b, 'c) Either.t) -> 'b list * 'c list
val find_map : 'a t -> f:('a -> 'b option) -> 'b option
val rev_filter_map : 'a t -> f:('a -> 'b option) -> 'b list
val rev_concat_map : 'a t -> f:('a -> 'b list) -> 'b list
val rev_append : 'a list -> 'a t -> 'a t
val rev_append2 : 'a t -> 'a list -> 'a list
val dedup_and_sort : compare:('a -> 'a -> int) -> 'a t -> 'a list
val to_rev_seq : 'a t -> 'a Seq.t

@ -173,7 +173,7 @@ let search_classes path =
let search_sources () = let search_sources () =
let initial_map = let initial_map =
List.fold ~f:(fun map path -> add_source_file path map) ~init:String.Map.empty Config.sources RevList.fold ~f:(fun map path -> add_source_file path map) ~init:String.Map.empty Config.sources
in in
match Config.sourcepath with match Config.sourcepath with
| None -> | None ->

@ -82,7 +82,7 @@ let do_all_files sources program =
let tenv = load_tenv () in let tenv = load_tenv () in
let skip source_file = let skip source_file =
let is_path_matching path = let is_path_matching path =
List.exists RevList.exists
~f:(fun pattern -> Str.string_match (Str.regexp pattern) path 0) ~f:(fun pattern -> Str.string_match (Str.regexp pattern) path 0)
Config.skip_analysis_in_path Config.skip_analysis_in_path
in in

@ -982,7 +982,7 @@ module ProcNameDispatcher = struct
in in
let get_cpp_matchers config ~model = let get_cpp_matchers config ~model =
let cpp_separator_regex = Str.regexp_string "::" in let cpp_separator_regex = Str.regexp_string "::" in
List.filter_map RevList.rev_filter_map
~f:(fun m -> ~f:(fun m ->
match Str.split cpp_separator_regex m with match Str.split cpp_separator_regex m with
| [] -> | [] ->

@ -77,7 +77,7 @@ include TaintAnalysis.Make (struct
when folly::Subprocess calls exec), in addition some folly functions are heavily optimized in when folly::Subprocess calls exec), in addition some folly functions are heavily optimized in
a way that obscures what they're actually doing (e.g., they use assembly code). it's better a way that obscures what they're actually doing (e.g., they use assembly code). it's better
to write models for these functions or treat them as unknown *) to write models for these functions or treat them as unknown *)
let models_matcher = QualifiedCppName.Match.of_fuzzy_qual_names ["folly"] let models_matcher = QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list ["folly"])
let get_model pname ret_typ actuals tenv summary = let get_model pname ret_typ actuals tenv summary =
(* hack for default C++ constructors, which get translated as an empty body (and will thus (* hack for default C++ constructors, which get translated as an empty body (and will thus

@ -10,7 +10,7 @@ module F = Format
module L = Logging module L = Logging
let parse_clang_procedure procedure kinds index = let parse_clang_procedure procedure kinds index =
try Some (QualifiedCppName.Match.of_fuzzy_qual_names [procedure], kinds, index) try Some (QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [procedure]), kinds, index)
with QualifiedCppName.ParseError _ -> with QualifiedCppName.ParseError _ ->
(* Java and Clang sources/sinks live in the same inferconfig entry. If we try to parse a Java (* Java and Clang sources/sinks live in the same inferconfig entry. If we try to parse a Java
procedure that happens to be an invalid Clang qualified name (e.g., MyClass.<init>), procedure that happens to be an invalid Clang qualified name (e.g., MyClass.<init>),
@ -423,7 +423,8 @@ module CppSanitizer = struct
let external_sanitizers = let external_sanitizers =
List.map List.map
~f:(fun {QuandaryConfig.Sanitizer.procedure; kind} -> ~f:(fun {QuandaryConfig.Sanitizer.procedure; kind} ->
(QualifiedCppName.Match.of_fuzzy_qual_names [procedure], of_string kind) ) (QualifiedCppName.Match.of_fuzzy_qual_names (RevList.of_list [procedure]), of_string kind)
)
(QuandaryConfig.Sanitizer.of_json Config.quandary_sanitizers) (QuandaryConfig.Sanitizer.of_json Config.quandary_sanitizers)

@ -23,7 +23,7 @@ let parse topl_file =
with Sys_error msg -> L.die UserError "@[topl:%s: %s@]@\n@?" topl_file msg with Sys_error msg -> L.die UserError "@[topl:%s: %s@]@\n@?" topl_file msg
let properties = lazy (List.concat_map ~f:parse Config.topl_properties) let properties = lazy (RevList.rev_concat_map ~f:parse Config.topl_properties)
let automaton = lazy (ToplAutomaton.make (Lazy.force properties)) let automaton = lazy (ToplAutomaton.make (Lazy.force properties))

Loading…
Cancel
Save