pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Core.Std.String

Browse Source 
Reviewed By: cristianoc

Differential Revision: D4232425

fbshipit-source-id: ee93f52
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent a2930b7007
commit e415b73786
55 changed files with 206 additions and 250 deletions
Show Stats Download Patch File Download Diff File

4
infer/src/IR/AttributesTable.re
Unescape View File

@ -30,7 +30,7 @@ let res_dir_attr_filename defined::defined pname => {
if (len < 2) { if (len < 2) {
Filename.current_dir_name Filename.current_dir_name
} else { } else {
String.sub base (len - 2) 2 String.sub base pos::(len - 2) len::2
} }
}; };
let filename = let filename =
@ -144,7 +144,7 @@ let is_whitelisted_cpp_method method_name =>
IList.for_all IList.for_all
( (
fun whitelisting_class_substring => fun whitelisting_class_substring =>
Utils.string_contains whitelisting_class_substring method_name String.is_substring substring::whitelisting_class_substring method_name
) )
whitelisting_class whitelisting_class
) )

32
infer/src/IR/Ident.re
Unescape View File

@ -138,10 +138,10 @@ let fieldname_to_complete_string fn => Mangled.to_string_full fn.fname;
/** Convert a fieldname to a simplified string with at most one-level path. */ /** Convert a fieldname to a simplified string with at most one-level path. */
let fieldname_to_simplified_string fn => { let fieldname_to_simplified_string fn => {
let s = Mangled.to_string fn.fname; let s = Mangled.to_string fn.fname;
switch (string_split_character s '.') { switch (String.rsplit2 s on::'.') {
| (Some s1, s2) => | Some (s1, s2) =>
switch (string_split_character s1 '.') { switch (String.rsplit2 s1 on::'.') {
| (Some _, s4) => s4 ^ "." ^ s2 | Some (_, s4) => s4 ^ "." ^ s2
| _ => s | _ => s
} }
| _ => s | _ => s
@ -152,8 +152,8 @@ let fieldname_to_simplified_string fn => {
/** Convert a fieldname to a flat string without path. */ /** Convert a fieldname to a flat string without path. */
let fieldname_to_flat_string fn => { let fieldname_to_flat_string fn => {
let s = Mangled.to_string fn.fname; let s = Mangled.to_string fn.fname;
switch (string_split_character s '.') { switch (String.rsplit2 s on::'.') {
| (Some _, s2) => s2 | Some (_, s2) => s2
| _ => s | _ => s
} }
}; };
@ -162,16 +162,16 @@ let fieldname_to_flat_string fn => {
/** Returns the class part of the fieldname */ /** Returns the class part of the fieldname */
let java_fieldname_get_class fn => { let java_fieldname_get_class fn => {
let fn = fieldname_to_string fn; let fn = fieldname_to_string fn;
let ri = String.rindex fn '.'; let ri = String.rindex_exn fn '.';
String.sub fn 0 ri String.slice fn 0 ri
}; };
/** Returns the last component of the fieldname */ /** Returns the last component of the fieldname */
let java_fieldname_get_field fn => { let java_fieldname_get_field fn => {
let fn = fieldname_to_string fn; let fn = fieldname_to_string fn;
let ri = 1 + String.rindex fn '.'; let ri = 1 + String.rindex_exn fn '.';
String.sub fn ri (String.length fn - ri) String.slice fn ri 0
}; };
@ -179,12 +179,12 @@ let java_fieldname_get_field fn => {
let java_fieldname_is_outer_instance fn => { let java_fieldname_is_outer_instance fn => {
let fn = fieldname_to_string fn; let fn = fieldname_to_string fn;
let fn_len = String.length fn; let fn_len = String.length fn;
let this = ".this$"; fn_len != 0 && {
let this_len = String.length this; let this = ".this$";
let zero_to_nine s => s >= "0" && s <= "9"; let last_char = fn.[fn_len - 1];
fn_len > this_len && (last_char >= '0' && last_char <= '9') &&
String.sub fn (fn_len - this_len - 1) this_len == this && String.is_suffix fn suffix::(this ^ String.of_char last_char)
zero_to_nine (String.sub fn (fn_len - 1) 1) }
}; };
let fieldname_offset fn => fn.fpos; let fieldname_offset fn => fn.fpos;

2
infer/src/IR/Io_infer.ml
Unescape View File

@ -190,7 +190,7 @@ struct
(** Print an html link to the given node. *) (** Print an html link to the given node. *)
let pp_node_link path_to_root pname ~description ~preds ~succs ~exn ~isvisited ~isproof fmt id = let pp_node_link path_to_root pname ~description ~preds ~succs ~exn ~isvisited ~isproof fmt id =
let display_name = let display_name =
(if description = "" then "N" else String.sub description 0 1) (if description = "" then "N" else String.sub description ~pos:0 ~len:1)
^ "_" ^ "_"
^ (string_of_int id) in ^ (string_of_int id) in
let node_fname = node_filename pname id in let node_fname = node_filename pname id in

2
infer/src/IR/Localise.ml
Unescape View File

@ -500,7 +500,7 @@ let dereference_string deref_str value_str access_opt loc =
| Some (Returned_from_call _) -> true | Some (Returned_from_call _) -> true
| _ -> false in | _ -> false in
let value_desc = let value_desc =
String.concat "" [ String.concat ~sep:"" [
(match deref_str.value_pre with Some s -> s ^ " " | _ -> ""); (match deref_str.value_pre with Some s -> s ^ " " | _ -> "");
(if is_call_access then "returned by " else ""); (if is_call_access then "returned by " else "");
value_str; value_str;

16
infer/src/IR/Objc_models.ml
Unescape View File

@ -201,8 +201,8 @@ struct
| Core_graphics -> core_graphics_types | Core_graphics -> core_graphics_types
let is_objc_memory_model_controlled o = let is_objc_memory_model_controlled o =
IList.mem Core.Std.String.equal o core_foundation_types || IList.mem String.equal o core_foundation_types ||
IList.mem Core.Std.String.equal o core_graphics_types IList.mem String.equal o core_graphics_types
let rec is_core_lib lib typ = let rec is_core_lib lib typ =
match typ with match typ with
@ -210,7 +210,7 @@ struct
is_core_lib lib styp is_core_lib lib styp
| Typ.Tstruct name -> | Typ.Tstruct name ->
let core_lib_types = core_lib_to_type_list lib in let core_lib_types = core_lib_to_type_list lib in
IList.mem Core.Std.String.equal (Typename.name name) core_lib_types IList.mem String.equal (Typename.name name) core_lib_types
| _ -> false | _ -> false
let is_core_foundation_type typ = let is_core_foundation_type typ =
@ -225,11 +225,11 @@ struct
let is_core_lib_create typ funct = let is_core_lib_create typ funct =
is_core_lib_type typ && is_core_lib_type typ &&
((string_contains create funct) || ((String.is_substring ~substring:create funct) ||
(string_contains copy funct )) (String.is_substring ~substring:copy funct ))
let function_arg_is_cftype typ = let function_arg_is_cftype typ =
(string_contains cf_type typ) (String.is_substring ~substring:cf_type typ)
let is_core_lib_retain typ funct = let is_core_lib_retain typ funct =
function_arg_is_cftype typ && funct = cf_retain function_arg_is_cftype typ && funct = cf_retain
@ -241,12 +241,12 @@ struct
try try
let cg_typ = IList.find let cg_typ = IList.find
(fun lib -> (funct = (lib^upper_release))) core_graphics_types in (fun lib -> (funct = (lib^upper_release))) core_graphics_types in
(string_contains (cg_typ^ref) typ) (String.is_substring ~substring:(cg_typ^ref) typ)
with Not_found -> false with Not_found -> false
(* (*
let function_arg_is_core_pgraphics typ = let function_arg_is_core_pgraphics typ =
let res = (string_contains cf_type typ) in let res = (String.is_substring ~substring:cf_type typ) in
res res
*) *)
end end

25
infer/src/IR/Procname.re
Unescape View File

@ -127,7 +127,11 @@ let java_return_type_to_string j verbosity =>
/** Given a package.class_name string, it looks for the latest dot and split the string /** Given a package.class_name string, it looks for the latest dot and split the string
in two (package, class_name) */ in two (package, class_name) */
let split_classname package_classname => string_split_character package_classname '.'; let split_classname package_classname =>
switch (String.rsplit2 package_classname on::'.') {
| Some (x, y) => (Some x, y)
| None => (None, package_classname)
};
let from_string_c_fun (s: string) => C (s, None); let from_string_c_fun (s: string) => C (s, None);
@ -308,17 +312,17 @@ let java_to_string withclass::withclass=false (j: java) verbosity =>
/** Check if the class name is for an anonymous inner class. */ /** Check if the class name is for an anonymous inner class. */
let is_anonymous_inner_class_name class_name => let is_anonymous_inner_class_name class_name =>
switch (string_split_character class_name '$') { switch (String.rsplit2 class_name on::'$') {
| (Some _, s) => | Some (_, s) =>
let is_int = let is_int =
try { try {
ignore (int_of_string (String.trim s)); ignore (int_of_string (String.strip s));
true true
} { } {
| Failure _ => false | Failure _ => false
}; };
is_int is_int
| (None, _) => false | None => false
}; };
@ -362,8 +366,8 @@ let java_is_anonymous_inner_class_constructor =
let java_is_access_method = let java_is_access_method =
fun fun
| Java js => | Java js =>
switch (string_split_character js.method_name '$') { switch (String.rsplit2 js.method_name on::'$') {
| (Some "access", s) => | Some ("access", s) =>
let is_int = let is_int =
try { try {
ignore (int_of_string s); ignore (int_of_string s);
@ -395,7 +399,8 @@ let java_is_vararg =
} }
| _ => false; | _ => false;
let is_objc_constructor method_name => method_name == "new" || string_is_prefix "init" method_name; let is_objc_constructor method_name =>
method_name == "new" || String.is_prefix prefix::"init" method_name;
let is_objc_kind = let is_objc_kind =
fun fun
@ -449,9 +454,9 @@ let is_infer_undefined pn =>
let get_global_name_of_initializer = let get_global_name_of_initializer =
fun fun
| C (name, _) when string_is_prefix Config.clang_initializer_prefix name => { | C (name, _) when String.is_prefix prefix::Config.clang_initializer_prefix name => {
let prefix_len = String.length Config.clang_initializer_prefix; let prefix_len = String.length Config.clang_initializer_prefix;
Some (String.sub name prefix_len (String.length name - prefix_len)) Some (String.sub name pos::prefix_len len::(String.length name - prefix_len))
} }
| _ => None; | _ => None;

15
infer/src/IR/Pvar.re
Unescape View File

@ -175,10 +175,10 @@ let to_string pv => Mangled.to_string pv.pv_name;
let get_simplified_name pv => { let get_simplified_name pv => {
let s = Mangled.to_string pv.pv_name; let s = Mangled.to_string pv.pv_name;
switch (string_split_character s '.') { switch (String.rsplit2 s on::'.') {
| (Some s1, s2) => | Some (s1, s2) =>
switch (string_split_character s1 '.') { switch (String.rsplit2 s1 on::'.') {
| (Some _, s4) => s4 ^ "." ^ s2 | Some (_, s4) => s4 ^ "." ^ s2
| _ => s | _ => s
} }
| _ => s | _ => s
@ -253,10 +253,11 @@ let tmp_prefix = "0$?%__sil_tmp";
let is_frontend_tmp pvar => { let is_frontend_tmp pvar => {
/* Check whether the program variable is a temporary one generated by sawja */ /* Check whether the program variable is a temporary one generated by sawja */
let is_sawja_tmp name => let is_sawja_tmp name =>
string_is_prefix "$irvar" name || String.is_prefix prefix::"$irvar" name ||
string_is_prefix "$T" name || string_is_prefix "$bc" name || string_is_prefix "CatchVar" name; String.is_prefix prefix::"$T" name ||
String.is_prefix prefix::"$bc" name || String.is_prefix prefix::"CatchVar" name;
/* Check whether the program variable is generated by [mk_tmp] */ /* Check whether the program variable is generated by [mk_tmp] */
let is_sil_tmp name => string_is_prefix tmp_prefix name; let is_sil_tmp name => String.is_prefix prefix::tmp_prefix name;
let name = to_string pvar; let name = to_string pvar;
is_sil_tmp name || ( is_sil_tmp name || (
switch pvar.pv_kind { switch pvar.pv_kind {

2
infer/src/IR/Typ.re
Unescape View File

@ -283,7 +283,7 @@ let rec java_from_string =
| "float" => Tfloat FFloat | "float" => Tfloat FFloat
| "double" => Tfloat FDouble | "double" => Tfloat FDouble
| typ_str when String.contains typ_str '[' => { | typ_str when String.contains typ_str '[' => {
let stripped_typ = String.sub typ_str 0 (String.length typ_str - 2); let stripped_typ = String.sub typ_str pos::0 len::(String.length typ_str - 2);
Tptr (Tarray (java_from_string stripped_typ) None) Pk_pointer Tptr (Tarray (java_from_string stripped_typ) None) Pk_pointer
} }
| typ_str => Tstruct (Typename.Java.from_string typ_str); | typ_str => Tstruct (Typename.Java.from_string typ_str);

6
infer/src/backend/InferPrint.re
Unescape View File

@ -345,7 +345,7 @@ let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc =>
let eq o y => let eq o y =>
switch (o, y) { switch (o, y) {
| (None, _) => false | (None, _) => false
| (Some x, y) => Core.Std.String.equal x y | (Some x, y) => String.equal x y
}; };
IList.mem eq issue_bucket high_buckets IList.mem eq issue_bucket high_buckets
}; };
@ -1152,7 +1152,7 @@ let pp_json_report_by_report_kind formats_by_report_kind fname =>
IList.iter pp_json_issue format_list IList.iter pp_json_issue format_list
}; };
let sorted_report = { let sorted_report = {
let report = Jsonbug_j.report_of_string (String.concat "\n" report_lines); let report = Jsonbug_j.report_of_string (String.concat sep::"\n" report_lines);
IList.sort tests_jsonbug_compare report IList.sort tests_jsonbug_compare report
}; };
let pp_report_by_report_kind (report_kind, format_list) => let pp_report_by_report_kind (report_kind, format_list) =>
@ -1260,7 +1260,7 @@ let module AnalysisResults = {
/** Create an iterator which loads spec files one at a time */ /** Create an iterator which loads spec files one at a time */
let iterator_of_spec_files () => { let iterator_of_spec_files () => {
let sorted_spec_files = IList.sort Core.Std.String.compare (spec_files_from_cmdline ()); let sorted_spec_files = IList.sort String.compare (spec_files_from_cmdline ());
let do_spec f fname => let do_spec f fname =>
switch (Specs.load_summary (DB.filename_from_string fname)) { switch (Specs.load_summary (DB.filename_from_string fname)) {
| None => | None =>

2
infer/src/backend/clusterMakefile.ml
Unescape View File

@ -39,7 +39,7 @@ let cluster_should_be_analyzed cluster =
let pp_prolog fmt clusters = let pp_prolog fmt clusters =
let compilation_dbs_cmd = let compilation_dbs_cmd =
IList.map (F.sprintf "--clang-compilation-db-files %s") !Config.clang_compilation_db_files IList.map (F.sprintf "--clang-compilation-db-files %s") !Config.clang_compilation_db_files
|> String.concat " " in |> String.concat ~sep:" " in
F.fprintf fmt "INFERANALYZE= %s -results_dir '%s' %s \n@." F.fprintf fmt "INFERANALYZE= %s -results_dir '%s' %s \n@."
(Config.bin_dir // (CLOpt.exe_name Analyze)) (Config.bin_dir // (CLOpt.exe_name Analyze))
(Escape.escape_map (Escape.escape_map

2
infer/src/backend/crashcontext.ml
Unescape View File

@ -74,7 +74,7 @@ let collect_all_summaries root_summaries_dir stacktrace_file stacktraces_dir =
(fun summaries path -> (fun summaries path ->
(* check if the file is a JSON file under the crashcontext dir *) (* check if the file is a JSON file under the crashcontext dir *)
if not (Sys.is_directory path) && Filename.check_suffix path "json" && if not (Sys.is_directory path) && Filename.check_suffix path "json" &&
string_is_suffix "crashcontext" (Filename.dirname path) String.is_suffix ~suffix:"crashcontext" (Filename.dirname path)
then path :: summaries then path :: summaries
else summaries) else summaries)
[] []

4
infer/src/backend/errdesc.ml
Unescape View File

@ -21,7 +21,7 @@ let vector_class = ["std"; "vector"]
let is_one_of_classes class_name classes = let is_one_of_classes class_name classes =
IList.exists (fun wrapper_class -> IList.exists (fun wrapper_class ->
IList.for_all (fun wrapper_class_substring -> IList.for_all (fun wrapper_class_substring ->
Utils.string_contains wrapper_class_substring class_name) wrapper_class) String.is_substring ~substring:wrapper_class_substring class_name) wrapper_class)
classes classes
let is_method_of_objc_cpp_class pname classes = let is_method_of_objc_cpp_class pname classes =
@ -38,7 +38,7 @@ let is_special_field class_names field_name_opt field =
let complete_fieldname = Ident.fieldname_to_complete_string field in let complete_fieldname = Ident.fieldname_to_complete_string field in
let field_ok = let field_ok =
match field_name_opt with match field_name_opt with
| Some field_name -> Utils.string_contains field_name complete_fieldname | Some field_name -> String.is_substring ~substring:field_name complete_fieldname
| None -> true in | None -> true in
is_one_of_classes complete_fieldname class_names && field_ok is_one_of_classes complete_fieldname class_names && field_ok

6
infer/src/backend/infer.ml
Unescape View File

@ -88,7 +88,7 @@ let clean_results_dir () =
let rec cleandir dir = let rec cleandir dir =
match Unix.readdir dir with match Unix.readdir dir with
| entry -> | entry ->
if (IList.exists (Core.Std.String.equal entry) dirs) then ( if (IList.exists (String.equal entry) dirs) then (
rmtree (name // entry) rmtree (name // entry)
) else if not (entry = Filename.current_dir_name ) else if not (entry = Filename.current_dir_name
|| entry = Filename.parent_dir_name) then ( || entry = Filename.parent_dir_name) then (
@ -132,7 +132,7 @@ let run_command cmd_list after_wait =
let exit_code = match status with Unix.WEXITED i -> i | _ -> 1 in let exit_code = match status with Unix.WEXITED i -> i | _ -> 1 in
after_wait exit_code ; after_wait exit_code ;
if exit_code <> 0 then ( if exit_code <> 0 then (
L.do_err "Failed to execute: %s@\n" (String.concat " " cmd_list) ; L.do_err "Failed to execute: %s@\n" (String.concat ~sep:" " cmd_list) ;
exit exit_code exit exit_code
) )
@ -306,7 +306,7 @@ let fail_on_issue_epilogue () =
let issues_json = DB.Results_dir.(path_to_filename Abs_root ["report.json"]) in let issues_json = DB.Results_dir.(path_to_filename Abs_root ["report.json"]) in
match read_file (DB.filename_to_string issues_json) with match read_file (DB.filename_to_string issues_json) with
| Some lines -> | Some lines ->
let issues = Jsonbug_j.report_of_string @@ String.concat "" lines in let issues = Jsonbug_j.report_of_string @@ String.concat ~sep:"" lines in
if issues <> [] then exit Config.fail_on_issue_exit_code if issues <> [] then exit Config.fail_on_issue_exit_code
| None -> () | None -> ()

8
infer/src/backend/inferconfig.ml
Unescape View File

@ -79,7 +79,7 @@ module FileContainsStringMatcher = struct
else else
let source_map = ref SourceFile.Map.empty in let source_map = ref SourceFile.Map.empty in
let regexp = let regexp =
Str.regexp (join_strings "\\|" s_patterns) in Str.regexp (String.concat ~sep:"\\|" s_patterns) in
fun source_file -> fun source_file ->
try try
SourceFile.Map.find source_file !source_map SourceFile.Map.find source_file !source_map
@ -124,7 +124,7 @@ module FileOrProcMatcher = struct
(fun p -> (fun p ->
match p.Config.method_name with match p.Config.method_name with
| None -> true | None -> true
| Some m -> Core.Std.String.equal m method_name) | Some m -> String.equal m method_name)
class_patterns class_patterns
with Not_found -> false in with Not_found -> false in
@ -221,7 +221,7 @@ let filters_from_inferconfig inferconfig : filters =
let error_filter = let error_filter =
function error_name -> function error_name ->
let error_str = Localise.to_string error_name in let error_str = Localise.to_string error_name in
not (IList.exists (Core.Std.String.equal error_str) inferconfig.suppress_errors) in not (IList.exists (String.equal error_str) inferconfig.suppress_errors) in
{ {
path_filter = path_filter; path_filter = path_filter;
error_filter = error_filter; error_filter = error_filter;
@ -265,7 +265,7 @@ let test () =
let source_file = SourceFile.from_abs_path path in let source_file = SourceFile.from_abs_path path in
let matching = matching_analyzers source_file in let matching = matching_analyzers source_file in
if matching <> [] then if matching <> [] then
let matching_s = join_strings ", " (IList.map fst matching) in let matching_s = String.concat ~sep:", " (IList.map fst matching) in
L.stderr "%s -> {%s}@." L.stderr "%s -> {%s}@."
(SourceFile.to_rel_path source_file) (SourceFile.to_rel_path source_file)
matching_s) matching_s)

2
infer/src/backend/printer.ml
Unescape View File

@ -34,7 +34,7 @@ struct
let line = let line =
let len = String.length line_raw in let len = String.length line_raw in
if len > 0 && String.get line_raw (len -1) = '\013' then if len > 0 && String.get line_raw (len -1) = '\013' then
String.sub line_raw 0 (len -1) String.sub line_raw ~pos:0 ~len:(len -1)
else line_raw in else line_raw in
lines := line :: !lines lines := line :: !lines
done; done;

27
infer/src/backend/rearrange.ml
Unescape View File

@ -624,15 +624,10 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
lowercase_str = "ui_thread" || lowercase_str = "ui-thread" || lowercase_str = "uithread" in lowercase_str = "ui_thread" || lowercase_str = "ui-thread" || lowercase_str = "uithread" in
is_invalid_exp_str str || is_ui_thread str in is_invalid_exp_str str || is_ui_thread str in
let guarded_by_str_is_this guarded_by_str = let guarded_by_str_is_this guarded_by_str =
string_is_suffix "this" guarded_by_str in String.is_suffix ~suffix:"this" guarded_by_str in
let guarded_by_str_is_class guarded_by_str class_str = let guarded_by_str_is_class guarded_by_str class_str =
let dollar_normalize s = let dollar_normalize s = String.map s ~f:(function '$' -> '.' | c -> c) in
String.map String.is_suffix ~suffix:(dollar_normalize guarded_by_str) (dollar_normalize (class_str ^ ".class")) in
(function
| '$' -> '.'
| c -> c)
s in
string_is_suffix (dollar_normalize guarded_by_str) (dollar_normalize (class_str ^ ".class")) in
let guarded_by_str_is_current_class guarded_by_str = function let guarded_by_str_is_current_class guarded_by_str = function
| Procname.Java java_pname -> | Procname.Java java_pname ->
(* programmers write @GuardedBy("MyClass.class") when the field is guarded by the class *) (* programmers write @GuardedBy("MyClass.class") when the field is guarded by the class *)
@ -642,7 +637,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
let guarded_by_str_is_class_this class_name guarded_by_str = let guarded_by_str_is_class_this class_name guarded_by_str =
let fully_qualified_this = let fully_qualified_this =
Printf.sprintf "%s.this" class_name in Printf.sprintf "%s.this" class_name in
string_is_suffix guarded_by_str fully_qualified_this String.is_suffix ~suffix:guarded_by_str fully_qualified_this
in in
(* return true if [guarded_by_str] is a suffix of "<name_of_super_class>.this" *) (* return true if [guarded_by_str] is a suffix of "<name_of_super_class>.this" *)
@ -719,11 +714,11 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
of the object of type T in the current state." note that this is ambiguous when there are of the object of type T in the current state." note that this is ambiguous when there are
multiple objects of type T, but let's try to respect the intention *) multiple objects of type T, but let's try to respect the intention *)
let match_on_field_type typ flds = let match_on_field_type typ flds =
match string_split_character guarded_by_str0 '.' with match String.rsplit2 guarded_by_str0 ~on:'.' with
| Some class_part, field_part -> | Some (class_part, field_part) ->
let typ_matches_guarded_by _ = function let typ_matches_guarded_by _ = function
| Typ.Tptr (ptr_typ, _) -> | Typ.Tptr (ptr_typ, _) ->
string_is_suffix class_part (Typ.to_string ptr_typ); String.is_suffix ~suffix:class_part (Typ.to_string ptr_typ);
| _ -> | _ ->
false in false in
begin begin
@ -797,8 +792,8 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
let exn = Exceptions.Unsafe_guarded_by_access (err_desc, __POS__) in let exn = Exceptions.Unsafe_guarded_by_access (err_desc, __POS__) in
Reporting.log_error pname exn in Reporting.log_error pname exn in
let rec is_read_write_lock typ = let rec is_read_write_lock typ =
let str_is_read_write_lock str = string_is_suffix "ReadWriteUpdateLock" str || let str_is_read_write_lock str = String.is_suffix ~suffix:"ReadWriteUpdateLock" str ||
string_is_suffix "ReadWriteLock" str in String.is_suffix ~suffix:"ReadWriteLock" str in
match typ with match typ with
| Typ.Tstruct name -> str_is_read_write_lock (Typename.name name) | Typ.Tstruct name -> str_is_read_write_lock (Typename.name name)
| Typ.Tptr (typ, _) -> is_read_write_lock typ | Typ.Tptr (typ, _) -> is_read_write_lock typ
@ -818,8 +813,8 @@ let add_guarded_by_constraints tenv prop lexp pdesc =
| _ -> false) | _ -> false)
(Attribute.get_for_exp tenv prop guarded_by_exp) in (Attribute.get_for_exp tenv prop guarded_by_exp) in
let guardedby_is_self_referential = let guardedby_is_self_referential =
Core.Std.String.equal "itself" (String.lowercase guarded_by_str) || String.equal "itself" (String.lowercase guarded_by_str) ||
string_is_suffix guarded_by_str (Ident.fieldname_to_string accessed_fld) in String.is_suffix ~suffix:guarded_by_str (Ident.fieldname_to_string accessed_fld) in
let proc_has_suppress_guarded_by_annot pdesc = let proc_has_suppress_guarded_by_annot pdesc =
let proc_signature = let proc_signature =
Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in Annotations.get_annotated_signature (Procdesc.get_attributes pdesc) in

44
infer/src/base/CommandLineOption.ml
Unescape View File

@ -49,11 +49,11 @@ let dashdash long =
| _ -> "--" ^ long | _ -> "--" ^ long
let short_meta {short; meta; spec} = let short_meta {short; meta; spec} =
String.concat " " String.concat ~sep:" "
((if short = "" then [] else ["| -" ^ short]) @ ((if short = "" then [] else ["| -" ^ short]) @
(match spec with (match spec with
| Arg.Symbol (symbols, _) -> | Arg.Symbol (symbols, _) ->
["{ " ^ (String.concat " | " symbols) ^ " }" ^ meta] ["{ " ^ (String.concat ~sep:" | " symbols) ^ " }" ^ meta]
| _ -> | _ ->
if meta = "" then [] else ["<" ^ meta ^ ">"])) if meta = "" then [] else ["<" ^ meta ^ ">"]))
@ -85,7 +85,7 @@ let xdesc {long; short; spec; doc} =
action arg action arg
else else
raise (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s" raise (Arg.Bad (F.sprintf "wrong argument '%s'; option '%s' expects one of: %s"
arg (dashdash long) (String.concat " | " symbols))) arg (dashdash long) (String.concat ~sep:" | " symbols)))
) )
| _ -> | _ ->
spec spec
@ -138,7 +138,7 @@ let pad_and_xform doc_width left_width desc =
wrap_line "" doc_width s wrap_line "" doc_width s
else [s] in else [s] in
IList.map wrap_line lines in IList.map wrap_line lines in
let doc = indent_doc (String.concat "\n" (IList.flatten wrapped_lines)) in let doc = indent_doc (String.concat ~sep:"\n" (IList.flatten wrapped_lines)) in
xdesc {desc with doc} xdesc {desc with doc}
let align desc_list = let align desc_list =
@ -257,15 +257,15 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let nolong = let nolong =
let len = String.length long in let len = String.length long in
if len > 3 && String.sub long 0 3 = "no-" then if len > 3 && String.sub long ~pos:0 ~len:3 = "no-" then
String.sub long 3 (len - 3) String.sub long ~pos:3 ~len:(len - 3)
else else
"no-" ^ long "no-" ^ long
and noshort = and noshort =
Option.map (fun short -> Option.map (fun short ->
let len = String.length short in let len = String.length short in
if len > 1 && String.sub short 0 1 = "n" then if len > 1 && String.sub short ~pos:0 ~len:1 = "n" then
String.sub short 1 (len - 1) String.sub short ~pos:1 ~len:(len - 1)
else else
"n" ^ short "n" ^ short
) short ) short
@ -339,7 +339,7 @@ let mk_string_opt ?default ?(f=fun s -> s) ?(deprecated=[]) ~long ?short ?exes ?
let mk_string_list ?(default=[]) ?(f=fun s -> s) let mk_string_list ?(default=[]) ?(f=fun s -> s)
?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?exes ~meta doc
~default_to_string:(String.concat ", ") ~default_to_string:(String.concat ~sep:", ")
~mk_setter:(fun var str -> var := (f str) :: !var) ~mk_setter:(fun var str -> var := (f str) :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long)) ~decode_json:(list_json_decoder (string_json_decoder ~long))
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> Arg.String set)
@ -378,13 +378,13 @@ let mk_path_opt ?default ?(deprecated=[]) ~long ?short ?exes ?(meta="path") =
let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?exes ?(meta="path") = let mk_path_list ?(default=[]) ?(deprecated=[]) ~long ?short ?exes ?(meta="path") =
mk_path_helper mk_path_helper
~setter:(fun var x -> var := x :: !var) ~setter:(fun var x -> var := x :: !var)
~default_to_string:(String.concat ", ") ~default_to_string:(String.concat ~sep:", ")
~default ~deprecated ~long ~short ~exes ~meta ~default ~deprecated ~long ~short ~exes ~meta
let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let strings = IList.map fst symbols in let strings = IList.map fst symbols in
let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
let of_string str = IList.assoc Core.Std.String.equal str symbols in let of_string str = IList.assoc String.equal str symbols in
let to_string sym = IList.assoc ( = ) sym sym_to_str in let to_string sym = IList.assoc ( = ) sym sym_to_str in
mk ~deprecated ~long ?short ~default ?exes ~meta doc mk ~deprecated ~long ?short ~default ?exes ~meta doc
~default_to_string:(fun s -> to_string s) ~default_to_string:(fun s -> to_string s)
@ -394,7 +394,7 @@ let mk_symbol ~default ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") d
let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let strings = IList.map fst symbols in let strings = IList.map fst symbols in
let of_string str = IList.assoc Core.Std.String.equal str symbols in let of_string str = IList.assoc String.equal str symbols in
mk ~deprecated ~long ?short ~default:None ?exes ~meta doc mk ~deprecated ~long ?short ~default:None ?exes ~meta doc
~default_to_string:(fun _ -> "") ~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (of_string str)) ~mk_setter:(fun var str -> var := Some (of_string str))
@ -403,15 +403,15 @@ let mk_symbol_opt ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc = let mk_symbol_seq ?(default=[]) ~symbols ?(deprecated=[]) ~long ?short ?exes ?(meta="") doc =
let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in let sym_to_str = IList.map (fun (x,y) -> (y,x)) symbols in
let of_string str = IList.assoc Core.Std.String.equal str symbols in let of_string str = IList.assoc String.equal str symbols in
let to_string sym = IList.assoc ( = ) sym sym_to_str in let to_string sym = IList.assoc ( = ) sym sym_to_str in
mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc mk ~deprecated ~long ?short ~default ?exes ~meta:(",-separated sequence" ^ meta) doc
~default_to_string:(fun syms -> String.concat " " (IList.map to_string syms)) ~default_to_string:(fun syms -> String.concat ~sep:" " (IList.map to_string syms))
~mk_setter:(fun var str_seq -> ~mk_setter:(fun var str_seq ->
var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq)) var := IList.map of_string (Str.split (Str.regexp_string ",") str_seq))
~decode_json:(fun json -> ~decode_json:(fun json ->
[dashdash long; [dashdash long;
String.concat "," (YBU.convert_each YBU.to_string json)]) String.concat ~sep:"," (YBU.convert_each YBU.to_string json)])
~mk_spec:(fun set -> Arg.String set) ~mk_spec:(fun set -> Arg.String set)
let mk_set_from_json ~default ~default_to_string ~f let mk_set_from_json ~default ~default_to_string ~f
@ -453,8 +453,8 @@ let decode_inferconfig_to_argv current_exe path =
let {decode_json} = let {decode_json} =
IList.find IList.find
(fun {long; short} -> (fun {long; short} ->
Core.Std.String.equal key long String.equal key long
|| (* for deprecated options *) Core.Std.String.equal key short) || (* for deprecated options *) String.equal key short)
desc_list in desc_list in
decode_json json_val @ result decode_json json_val @ result
with with
@ -472,7 +472,7 @@ let decode_inferconfig_to_argv current_exe path =
let env_var_sep = '^' let env_var_sep = '^'
let encode_argv_to_env argv = let encode_argv_to_env argv =
String.concat (String.make 1 env_var_sep) String.concat ~sep:(String.make 1 env_var_sep)
(IList.filter (fun arg -> (IList.filter (fun arg ->
not (String.contains arg env_var_sep) not (String.contains arg env_var_sep)
|| ( || (
@ -541,7 +541,9 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
let norm k = let norm k =
let remove_no s = let remove_no s =
let len = String.length k in let len = String.length k in
if len > 3 && String.sub s 0 3 = "no-" then String.sub s 3 (len - 3) else s in if len > 3 && String.sub s ~pos:0 ~len:3 = "no-"
then String.sub s ~pos:3 ~len:(len - 3)
else s in
let remove_weird_chars = Str.global_replace (Str.regexp "[^a-z0-9-]") "" in let remove_weird_chars = Str.global_replace (Str.regexp "[^a-z0-9-]") "" in
remove_weird_chars @@ String.lowercase @@ remove_no k in remove_weird_chars @@ String.lowercase @@ remove_no k in
let compare_specs {long = x} {long = y} = let compare_specs {long = x} {long = y} =
@ -569,7 +571,7 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
let is_not_dup_with_doc speclist (opt, _, doc) = let is_not_dup_with_doc speclist (opt, _, doc) =
opt = "" || opt = "" ||
IList.for_all (fun (opt', _, doc') -> IList.for_all (fun (opt', _, doc') ->
(doc <> "" && doc' = "") || (not (Core.Std.String.equal opt opt'))) speclist in (doc <> "" && doc' = "") || (not (String.equal opt opt'))) speclist in
let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in let unique_exe_speclist = IList.filter (is_not_dup_with_doc !curr_speclist) exe_speclist in
curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @ curr_speclist := IList.filter (is_not_dup_with_doc unique_exe_speclist) !curr_speclist @
(match header with (match header with
@ -619,7 +621,7 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
(* tests if msg indicates an unknown option, as opposed to a known option with bad argument *) (* tests if msg indicates an unknown option, as opposed to a known option with bad argument *)
let is_unknown msg = let is_unknown msg =
let prefix = exe_name ^ ": unknown option" in let prefix = exe_name ^ ": unknown option" in
prefix = (String.sub msg 0 (String.length prefix)) in prefix = (String.sub msg ~pos:0 ~len:(String.length prefix)) in
let rec parse_loop () = let rec parse_loop () =
try try
Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist !anon_fun Arg.parse_argv_dynamic ~current:arg_being_parsed !args_to_parse curr_speclist !anon_fun

8
infer/src/base/Config.ml
Unescape View File

@ -240,7 +240,7 @@ let real_exe_name =
let current_exe = let current_exe =
if !Sys.interactive then CLOpt.Interactive if !Sys.interactive then CLOpt.Interactive
else try IList.assoc Core.Std.String.equal (Filename.basename real_exe_name) CLOpt.exes else try IList.assoc String.equal (Filename.basename real_exe_name) CLOpt.exes
with Not_found -> CLOpt.Toplevel with Not_found -> CLOpt.Toplevel
let bin_dir = let bin_dir =
@ -319,8 +319,8 @@ let patterns_of_json_with_key json_key json =
let detect_pattern assoc = let detect_pattern assoc =
match detect_language assoc with match detect_language assoc with
| Ok language -> | Ok language ->
let is_method_pattern key = IList.exists (Core.Std.String.equal key) ["class"; "method"] let is_method_pattern key = IList.exists (String.equal key) ["class"; "method"]
and is_source_contains key = IList.exists (Core.Std.String.equal key) ["source_contains"] in and is_source_contains key = IList.exists (String.equal key) ["source_contains"] in
let rec loop = function let rec loop = function
| [] -> | [] ->
Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file) Error ("Unknown pattern for " ^ json_key ^ " in " ^ inferconfig_file)
@ -1611,7 +1611,7 @@ let clang_frontend_do_capture, clang_frontend_do_lint =
let analyzer = match !analyzer with Some a -> a | None -> Infer let analyzer = match !analyzer with Some a -> a | None -> Infer
let clang_frontend_action_string = let clang_frontend_action_string =
String.concat " and " String.concat ~sep:" and "
((if clang_frontend_do_capture then ["translating"] else []) ((if clang_frontend_do_capture then ["translating"] else [])
@ (if clang_frontend_do_lint then ["linting"] else [])) @ (if clang_frontend_do_lint then ["linting"] else []))

2
infer/src/base/Latex.ml
Unescape View File

@ -28,7 +28,7 @@ let convert_string s =
if c == '_' then s' := !s' ^ "\\_" if c == '_' then s' := !s' ^ "\\_"
else s' := !s' ^ Char.escaped (String.get s !cnt); else s' := !s' ^ Char.escaped (String.get s !cnt);
incr cnt in incr cnt in
String.iter f s; String.iter ~f s;
!s' !s'
end end
else s else s

2
infer/src/base/Process.ml
Unescape View File

@ -45,7 +45,7 @@ let create_process_and_wait cmd =
| _ -> 1 in | _ -> 1 in
if exit_code <> 0 then if exit_code <> 0 then
print_error_and_exit ~exit_code:exit_code print_error_and_exit ~exit_code:exit_code
"Failed to execute: %s\n" (String.concat " " (Array.to_list cmd)) "Failed to execute: %s\n" (String.concat ~sep:" " (Array.to_list cmd))
(** Given a process id and a function that describes the command that the process id (** Given a process id and a function that describes the command that the process id
represents, prints a message explaining the command and its status, if in debug or stats mode. represents, prints a message explaining the command and its status, if in debug or stats mode.

17
infer/src/base/SourceFile.ml
Unescape View File

@ -10,7 +10,7 @@
open! Utils open! Utils
let count_newlines (path: string): int = let count_newlines (path: string): int =
let open Core.Std in let open! Core.Std in
let f file = In_channel.fold_lines file ~init:0 ~f:(fun i _ -> i + 1) in let f file = In_channel.fold_lines file ~init:0 ~f:(fun i _ -> i + 1) in
In_channel.with_file path ~f In_channel.with_file path ~f
@ -25,6 +25,7 @@ let equal sf1 sf2 =
module OrderedSourceFile = module OrderedSourceFile =
struct struct
(* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 *)
type _t = t [@@deriving compare] type _t = t [@@deriving compare]
type t = _t [@@deriving compare] type t = _t [@@deriving compare]
end end
@ -35,7 +36,7 @@ module Set = Set.Make(OrderedSourceFile)
let rel_path_from_abs_path root fname = let rel_path_from_abs_path root fname =
let relative_complemented_fname = filename_to_relative root fname in let relative_complemented_fname = filename_to_relative root fname in
if string_is_prefix root fname && if String.is_prefix ~prefix:root fname &&
Filename.is_relative relative_complemented_fname then Filename.is_relative relative_complemented_fname then
Some relative_complemented_fname Some relative_complemented_fname
else None (* The project root is not a prefix of the file name *) else None (* The project root is not a prefix of the file name *)
@ -111,20 +112,20 @@ let is_infer_model source_file = match source_file with
let is_cpp_model file = let is_cpp_model file =
match file with match file with
| RelativeInferModel path -> | RelativeInferModel path ->
string_is_prefix Config.relative_cpp_models_dir path String.is_prefix ~prefix:Config.relative_cpp_models_dir path
| _ -> false | _ -> false
let is_under_project_root = function let is_under_project_root = function
| RelativeProjectRoot _ -> true | RelativeProjectRoot _ -> true
| Absolute _ | RelativeInferModel _ -> false | Absolute _ | RelativeInferModel _ -> false
let exists_cache = Hashtbl.create 256 let exists_cache = String.Table.create ~size:256 ()
let path_exists abs_path = let path_exists abs_path =
try Hashtbl.find exists_cache abs_path try String.Table.find_exn exists_cache abs_path
with Not_found -> with Not_found ->
let result = Sys.file_exists abs_path in let result = Sys.file_exists abs_path in
Hashtbl.add exists_cache abs_path result; String.Table.set exists_cache ~key:abs_path ~data:result;
result result
let of_header header_file = let of_header header_file =
@ -133,7 +134,7 @@ let of_header header_file =
let header_exts = ["h"; "hh"; "hpp"; "hxx"] in let header_exts = ["h"; "hh"; "hpp"; "hxx"] in
let file_no_ext, ext_opt = Core.Std.Filename.split_extension abs_path in let file_no_ext, ext_opt = Core.Std.Filename.split_extension abs_path in
let file_opt = match ext_opt with let file_opt = match ext_opt with
| Some ext when IList.mem Core.Std.String.equal ext header_exts -> ( | Some ext when IList.mem String.equal ext header_exts -> (
let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in
try Some (IList.find path_exists possible_files) try Some (IList.find path_exists possible_files)
with Not_found -> None with Not_found -> None

47
infer/src/base/Utils.ml
Unescape View File

@ -11,6 +11,7 @@
(** General utility functions and definition with global scope *) (** General utility functions and definition with global scope *)
module Int = Core.Std.Int module Int = Core.Std.Int
module String = Core.Std.String
module F = Format module F = Format
@ -45,7 +46,7 @@ let int_of_bool b = if b then 1 else 0
module IntSet = Set.Make(Int) module IntSet = Set.Make(Int)
(** Hash table over strings *) (** Hash table over strings *)
module StringHash = Hashtbl.Make (Core.Std.String) module StringHash = Hashtbl.Make (String)
(** Set of strings *) (** Set of strings *)
module StringSet = Set.Make(String) module StringSet = Set.Make(String)
@ -65,7 +66,7 @@ let string_list_intersection a b =
StringSet.inter (string_set_of_list a) (string_set_of_list b) StringSet.inter (string_set_of_list a) (string_set_of_list b)
module StringPPSet = PrettyPrintable.MakePPSet(struct module StringPPSet = PrettyPrintable.MakePPSet(struct
include Core.Std.String include String
let pp_element fmt s = F.fprintf fmt "%s" s let pp_element fmt s = F.fprintf fmt "%s" s
end) end)
@ -73,7 +74,7 @@ module StringPPSet = PrettyPrintable.MakePPSet(struct
module IntMap = Map.Make (Int) module IntMap = Map.Make (Int)
(** Maps from strings *) (** Maps from strings *)
module StringMap = Map.Make (Core.Std.String) module StringMap = Map.Make (String)
(** {2 Printing} *) (** {2 Printing} *)
@ -225,35 +226,6 @@ let pp_elapsed_time fmt () =
let elapsed = Unix.gettimeofday () -. initial_timeofday in let elapsed = Unix.gettimeofday () -. initial_timeofday in
Format.fprintf fmt "%f" elapsed Format.fprintf fmt "%f" elapsed
(** Check if the lhs is a substring of the rhs. *)
let string_is_prefix s1 s2 =
String.length s1 <= String.length s2 &&
String.sub s2 0 (String.length s1) = s1
(** Check if the lhs is a postfix of the rhs. *)
let string_is_suffix s1 s2 =
let l1 = String.length s1 in
let l2 = String.length s2 in
l1 <= l2 &&
String.sub s2 (l2 - l1) l1 = s1
(** Check if the lhs is contained in the rhs. *)
let string_contains s1 s2 =
let rexp = Str.regexp_string s1 in
try
ignore (Str.search_forward rexp s2 0);
true
with Not_found -> false
(** Split a string across the given character, if given. (e.g. split first.second with '.').*)
let string_split_character s c =
try
let index = String.rindex s c in
let lhs = String.sub s 0 index in
let rhs = String.sub s (index + 1) ((String.length s) - (1 + index)) in
(Some lhs, rhs)
with Not_found -> (None, s)
let string_value_or_empty_string let string_value_or_empty_string
(string_option: string option): string = (string_option: string option): string =
match string_option with match string_option with
@ -429,8 +401,8 @@ let filename_to_absolute fname =
let filename_to_relative root fname = let filename_to_relative root fname =
let string_strict_subtract s1 s2 = let string_strict_subtract s1 s2 =
let n1, n2 = String.length s1, String.length s2 in let n1, n2 = String.length s1, String.length s2 in
if n1 < n2 && String.sub s2 0 n1 = s1 then if n1 < n2 && String.sub s2 ~pos:0 ~len:n1 = s1 then
String.sub s2 (n1 + 1) (n2 - (n1 + 1)) String.sub s2 ~pos:(n1 + 1) ~len:(n2 - (n1 + 1))
else s2 in else s2 in
let norm_root = (* norm_root is root without any trailing / *) let norm_root = (* norm_root is root without any trailing / *)
Filename.dirname root // Filename.basename root in Filename.dirname root // Filename.basename root in
@ -458,11 +430,6 @@ let proc_flags_add proc_flags key value =
let proc_flags_find proc_flags key = let proc_flags_find proc_flags key =
Hashtbl.find proc_flags key Hashtbl.find proc_flags key
let join_strings sep = function
| [] -> ""
| hd:: tl ->
IList.fold_left (fun str p -> str ^ sep ^ p) hd tl
let directory_fold f init path = let directory_fold f init path =
let collect current_dir (accu, dirs) path = let collect current_dir (accu, dirs) path =
@ -524,7 +491,7 @@ let string_append_crc_cutoff ?(cutoff=100) ?(key="") name =
let name_up_to_cutoff = let name_up_to_cutoff =
if String.length name <= cutoff if String.length name <= cutoff
then name then name
else String.sub name 0 cutoff in else String.sub name ~pos:0 ~len:cutoff in
let crc_str = let crc_str =
let name_for_crc = name ^ key in let name_for_crc = name ^ key in
string_crc_hex32 name_for_crc in string_crc_hex32 name_for_crc in

16
infer/src/base/Utils.mli
Unescape View File

@ -11,6 +11,7 @@
(** General utility functions *) (** General utility functions *)
module Int = Core.Std.Int module Int = Core.Std.Int
module String = Core.Std.String
(** {2 Generic Utility Functions} *) (** {2 Generic Utility Functions} *)
@ -156,18 +157,6 @@ val string_crc_hex32 : string -> string
Use an optional key to compute the crc. *) Use an optional key to compute the crc. *)
val string_append_crc_cutoff : ?cutoff:int -> ?key:string -> string -> string val string_append_crc_cutoff : ?cutoff:int -> ?key:string -> string -> string
(** Check if the lhs is a substring of the rhs. *)
val string_is_prefix : string -> string -> bool
(** Check if the lhs is a suffix of the rhs. *)
val string_is_suffix : string -> string -> bool
(** Check if the lhs is contained in the rhs. *)
val string_contains : string -> string -> bool
(** Split a string across the given character, if given. (e.g. split first.second with '.').*)
val string_split_character : string -> char -> string option * string
(** The value of a string option or the empty string.: *) (** The value of a string option or the empty string.: *)
val string_value_or_empty_string : string option -> string val string_value_or_empty_string : string option -> string
@ -219,9 +208,6 @@ val proc_flags_add : proc_flags -> string -> string -> unit
(** find a value for a key in the proc flags *) (** find a value for a key in the proc flags *)
val proc_flags_find : proc_flags -> string -> string val proc_flags_find : proc_flags -> string -> string
(** [join_strings sep parts] contatenates the elements of [parts] using [sep] as separator *)
val join_strings : string -> string list -> string
(** Functional fold function over all the file of a directory *) (** Functional fold function over all the file of a directory *)
val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a val directory_fold : ('a -> string -> 'a) -> 'a -> string -> 'a

4
infer/src/base/Version.ml.in
Unescape View File

@ -16,14 +16,14 @@ let patch = @INFER_PATCH@
let commit = "@INFER_GIT_COMMIT@" let commit = "@INFER_GIT_COMMIT@"
let branch = "@INFER_GIT_BRANCH@" let branch = "@INFER_GIT_BRANCH@"
let is_release = Core.Std.String.equal "@IS_RELEASE_TREE@" "yes" let is_release = String.equal "@IS_RELEASE_TREE@" "yes"
let tag = Printf.sprintf "v%d.%d.%d" major minor patch let tag = Printf.sprintf "v%d.%d.%d" major minor patch
let versionString = let versionString =
if is_release then tag if is_release then tag
else Printf.sprintf "%s-%s" tag commit else Printf.sprintf "%s-%s" tag commit
let versionJson = String.concat "\n" [ let versionJson = String.concat ~sep:"\n" [
"{"; "\"major\": " ^ (string_of_int major) ^ ", "; "{"; "\"major\": " ^ (string_of_int major) ^ ", ";
"\"minor\": " ^ (string_of_int minor) ^ ", "; "\"minor\": " ^ (string_of_int minor) ^ ", ";
"\"patch\": " ^ (string_of_int patch) ^ ", "; "\"patch\": " ^ (string_of_int patch) ^ ", ";

4
infer/src/checkers/BoundedCallTree.ml
Unescape View File

@ -114,11 +114,11 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let matches_proc frame = let matches_proc frame =
let matches_class pname = match pname with let matches_class pname = match pname with
| Procname.Java java_proc -> | Procname.Java java_proc ->
Core.Std.String.equal String.equal
frame.Stacktrace.class_str frame.Stacktrace.class_str
(Procname.java_get_class_name java_proc) (Procname.java_get_class_name java_proc)
| Procname.ObjC_Cpp objc_cpp_prod -> | Procname.ObjC_Cpp objc_cpp_prod ->
Core.Std.String.equal String.equal
frame.Stacktrace.class_str frame.Stacktrace.class_str
(Procname.objc_cpp_get_class_name objc_cpp_prod) (Procname.objc_cpp_get_class_name objc_cpp_prod)
| Procname.C _ -> true (* Needed for test code. *) | Procname.C _ -> true (* Needed for test code. *)

2
infer/src/checkers/Siof.ml
Unescape View File

@ -110,7 +110,7 @@ let is_foreign tu_opt v =
let is_orig_file f = match tu_opt with let is_orig_file f = match tu_opt with
| Some orig_file -> | Some orig_file ->
let orig_path = SourceFile.to_abs_path orig_file in let orig_path = SourceFile.to_abs_path orig_file in
Core.Std.String.equal orig_path (SourceFile.to_abs_path f) String.equal orig_path (SourceFile.to_abs_path f)
| None -> assert false in | None -> assert false in
Option.map_default (fun f -> not (is_orig_file f)) false (Pvar.get_source_file v) Option.map_default (fun f -> not (is_orig_file f)) false (Pvar.get_source_file v)

6
infer/src/checkers/Stacktrace.ml
Unescape View File

@ -44,7 +44,7 @@ let make_frame class_str method_str file_str line_num =
let frame_matches_location frame_obj loc = let frame_matches_location frame_obj loc =
let lfname = SourceFile.to_string loc.Location.file in let lfname = SourceFile.to_string loc.Location.file in
let matches_file = Utils.string_is_suffix frame_obj.file_str lfname in let matches_file = String.is_suffix ~suffix:frame_obj.file_str lfname in
let matches_line = match frame_obj.line_num with let matches_line = match frame_obj.line_num with
| None -> false | None -> false
| Some line -> line = loc.Location.line in | Some line -> line = loc.Location.line in
@ -60,7 +60,7 @@ let parse_stack_frame frame_str =
let class_str = Str.matched_group 1 qualified_procname in let class_str = Str.matched_group 1 qualified_procname in
let method_str = Str.matched_group 2 qualified_procname in let method_str = Str.matched_group 2 qualified_procname in
(* Native methods don't have debugging info *) (* Native methods don't have debugging info *)
if Core.Std.String.equal file_and_line "Native Method" then if String.equal file_and_line "Native Method" then
make_frame class_str method_str "Native Method" None make_frame class_str method_str "Native Method" None
else begin else begin
(* Separate the filename and line number. (* Separate the filename and line number.
@ -100,7 +100,7 @@ let of_json filename json =
let frames = let frames =
Yojson.Basic.Util.to_list (extract_json_member frames_key) Yojson.Basic.Util.to_list (extract_json_member frames_key)
|> IList.map Yojson.Basic.Util.to_string |> IList.map Yojson.Basic.Util.to_string
|> IList.map String.trim |> IList.map String.strip
|> IList.filter (fun s -> s <> "") |> IList.filter (fun s -> s <> "")
|> IList.map parse_stack_frame in |> IList.map parse_stack_frame in
make exception_name frames make exception_name frames

2
infer/src/checkers/ThreadSafety.ml
Unescape View File

@ -28,7 +28,7 @@ module Summary = Summary.Make (struct
is assumed to be thread-safe. in the future, we can ask for builder classes to be annotated with is assumed to be thread-safe. in the future, we can ask for builder classes to be annotated with
@Builder and verify that annotated classes satisfy the expected invariants. *) @Builder and verify that annotated classes satisfy the expected invariants. *)
let is_builder_class class_name = let is_builder_class class_name =
string_is_suffix "Builder" class_name String.is_suffix ~suffix:"Builder" class_name
let is_call_to_builder_class_method = function let is_call_to_builder_class_method = function
| Procname.Java java_pname -> is_builder_class (Procname.java_get_class_name java_pname) | Procname.Java java_pname -> is_builder_class (Procname.java_get_class_name java_pname)

8
infer/src/checkers/annotations.ml
Unescape View File

@ -53,7 +53,7 @@ let annot_ends_with annot ann_name =
let filter s = let filter s =
let sl = String.length s in let sl = String.length s in
let al = String.length ann_name in let al = String.length ann_name in
sl >= al && String.sub s (sl - al) al = ann_name in sl >= al && String.sub s ~pos:(sl - al) ~len:al = ann_name in
filter annot.Annot.class_name filter annot.Annot.class_name
(** Check if there is an annotation in [ia] which ends with the given name *) (** Check if there is an annotation in [ia] which ends with the given name *)
@ -75,7 +75,7 @@ let ia_get ia ann_name =
let ma_contains ma ann_names = let ma_contains ma ann_names =
let found = ref false in let found = ref false in
ma_iter (fun a -> ma_iter (fun a ->
if IList.exists (Core.Std.String.equal a.Annot.class_name) ann_names then found := true if IList.exists (String.equal a.Annot.class_name) ann_names then found := true
) ma; ) ma;
!found !found
@ -254,8 +254,8 @@ let annotated_signature_is_anonymous_inner_class_wrapper ann_sig proc_name =
let name_str = Mangled.to_string name in let name_str = Mangled.to_string name in
let len = String.length name_str in let len = String.length name_str in
len >= 2 && len >= 2 &&
String.sub name_str 0 1 = "x" && String.sub name_str ~pos:0 ~len:1 = "x" &&
let s = String.sub name_str 1 (len - 1) in let s = String.sub name_str ~pos:1 ~len:(len - 1) in
let is_int = let is_int =
try try
ignore (int_of_string s); ignore (int_of_string s);

2
infer/src/checkers/checkTraceCallSequence.ml
Unescape View File

@ -230,7 +230,7 @@ module BooleanVars = struct
let exp_boolean_var exp = match exp with let exp_boolean_var exp = match exp with
| Exp.Lvar pvar when Pvar.is_local pvar -> | Exp.Lvar pvar when Pvar.is_local pvar ->
let name = Mangled.to_string (Pvar.get_name pvar) in let name = Mangled.to_string (Pvar.get_name pvar) in
if IList.mem Core.Std.String.equal name boolean_variables if IList.mem String.equal name boolean_variables
then Some name then Some name
else None else None
| _ -> None | _ -> None

14
infer/src/checkers/checkers.ml
Unescape View File

@ -95,13 +95,13 @@ module ST = struct
let drop_prefix str = let drop_prefix str =
Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in
let normalized_equal s1 s2 = let normalized_equal s1 s2 =
Core.Std.String.equal (normalize s1) (normalize s2) in String.equal (normalize s1) (normalize s2) in
let is_parameter_suppressed = let is_parameter_suppressed =
IList.mem Core.Std.String.equal a.class_name [Annotations.suppressLint] && IList.mem String.equal a.class_name [Annotations.suppressLint] &&
IList.mem normalized_equal kind a.parameters in IList.mem normalized_equal kind a.parameters in
let is_annotation_suppressed = let is_annotation_suppressed =
string_is_suffix (normalize (drop_prefix kind)) (normalize a.class_name) in String.is_suffix ~suffix:(normalize (drop_prefix kind)) (normalize a.class_name) in
is_parameter_suppressed || is_annotation_suppressed in is_parameter_suppressed || is_annotation_suppressed in
@ -235,9 +235,9 @@ let callback_check_write_to_parcel_java
let method_name = Procname.java_get_method pname_java in let method_name = Procname.java_get_method pname_java in
(try (try
class_name = "android.os.Parcel" && class_name = "android.os.Parcel" &&
(String.sub method_name 0 5 = "write" (String.sub method_name ~pos:0 ~len:5 = "write"
|| ||
String.sub method_name 0 4 = "read") String.sub method_name ~pos:0 ~len:4 = "read")
with Invalid_argument _ -> false) with Invalid_argument _ -> false)
| _ -> assert false in | _ -> assert false in
@ -247,8 +247,8 @@ let callback_check_write_to_parcel_java
let wn = Procname.java_get_method wc in let wn = Procname.java_get_method wc in
let postfix_length = String.length wn - 5 in (* covers writeList <-> readArrayList etc. *) let postfix_length = String.length wn - 5 in (* covers writeList <-> readArrayList etc. *)
(try (try
String.sub rn (String.length rn - postfix_length) postfix_length = String.sub rn ~pos:(String.length rn - postfix_length) ~len:postfix_length =
String.sub wn 5 postfix_length String.sub wn ~pos:5 ~len:postfix_length
with Invalid_argument _ -> false) with Invalid_argument _ -> false)
| _ -> | _ ->
false in false in

4
infer/src/checkers/immutableChecker.ml
Unescape View File

@ -25,8 +25,8 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l
] in ] in
let in_casts expected given = let in_casts expected given =
IList.exists (fun (x, y) -> IList.exists (fun (x, y) ->
Core.Std.String.equal (Typename.name expected) x String.equal (Typename.name expected) x
&& Core.Std.String.equal (Typename.name given) y && String.equal (Typename.name given) y
) casts in ) casts in
match PatternMatch.type_get_class_name typ_expected, match PatternMatch.type_get_class_name typ_expected,
PatternMatch.type_get_class_name typ_found with PatternMatch.type_get_class_name typ_found with

4
infer/src/checkers/patternMatch.ml
Unescape View File

@ -107,7 +107,7 @@ let type_has_supertype
has_supertype typ Typ.Set.empty has_supertype typ Typ.Set.empty
let type_is_nested_in_direct_supertype tenv t n = let type_is_nested_in_direct_supertype tenv t n =
let is_nested_in cn1 cn2 = string_is_prefix (Typename.name cn1 ^ "$") (Typename.name cn2) in let is_nested_in cn1 cn2 = String.is_prefix ~prefix:(Typename.name cn1 ^ "$") (Typename.name cn2) in
IList.exists (is_nested_in n) (type_get_direct_supertypes tenv t) IList.exists (is_nested_in n) (type_get_direct_supertypes tenv t)
let rec get_type_name = function let rec get_type_name = function
@ -273,7 +273,7 @@ let method_is_initializer
match proc_attributes.ProcAttributes.proc_name with match proc_attributes.ProcAttributes.proc_name with
| Procname.Java pname_java -> | Procname.Java pname_java ->
let mname = Procname.java_get_method pname_java in let mname = Procname.java_get_method pname_java in
IList.exists (Core.Std.String.equal mname) initializer_methods IList.exists (String.equal mname) initializer_methods
| _ -> | _ ->
false false
else else

12
infer/src/checkers/printfArgs.ml
Unescape View File

@ -49,7 +49,7 @@ let printf_like_function
try try
Some ( Some (
IList.find IList.find
(fun printf -> Core.Std.String.equal printf.unique_id (Procname.to_unique_id proc_name)) (fun printf -> String.equal printf.unique_id (Procname.to_unique_id proc_name))
!printf_like_functions) !printf_like_functions)
with Not_found -> None with Not_found -> None
@ -70,15 +70,15 @@ let format_type_matches_given_type
match format_type with match format_type with
| "d" | "i" | "u" | "x" | "X" | "o" -> | "d" | "i" | "u" | "x" | "X" | "o" ->
IList.mem IList.mem
Core.Std.String.equal String.equal
given_type given_type
["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"] ["java.lang.Integer"; "java.lang.Long"; "java.lang.Short"; "java.lang.Byte"]
| "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" -> | "a" | "A" | "f" | "F" | "g" | "G" | "e" | "E" ->
IList.mem IList.mem
Core.Std.String.equal String.equal
given_type given_type
["java.lang.Double"; "java.lang.Float"] ["java.lang.Double"; "java.lang.Float"]
| "c" -> Core.Std.String.equal given_type "java.lang.Character" | "c" -> String.equal given_type "java.lang.Character"
| "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *) | "b" | "h" | "H" | "s" -> true (* accepts pretty much anything, even null *)
| _ -> false | _ -> false
@ -108,7 +108,7 @@ let rec format_string_type_names
let fmt_re = Str.regexp "%[0-9]*\\.?[0-9]*[A-mo-z]" in (* matches '%2.1d' etc. *) let fmt_re = Str.regexp "%[0-9]*\\.?[0-9]*[A-mo-z]" in (* matches '%2.1d' etc. *)
let _ = Str.search_forward fmt_re fmt_string start in let _ = Str.search_forward fmt_re fmt_string start in
let fmt_match = Str.matched_string fmt_string in let fmt_match = Str.matched_string fmt_string in
let fmt_type = String.sub fmt_match ((String.length fmt_match) - 1) 1 in let fmt_type = String.sub fmt_match ~pos:((String.length fmt_match) - 1) ~len:1 in
fmt_type:: format_string_type_names fmt_string (Str.match_end ()) fmt_type:: format_string_type_names fmt_string (Str.match_end ())
with Not_found -> [] with Not_found -> []
@ -221,6 +221,6 @@ let printf_signature_to_string
"{%s; %d [%s] %s}" "{%s; %d [%s] %s}"
printf.unique_id printf.unique_id
printf.format_pos printf.format_pos
(String.concat "," (IList.map string_of_int printf.fixed_pos)) (String.concat ~sep:"," (IList.map string_of_int printf.fixed_pos))
(match printf.vararg_pos with | Some i -> string_of_int i | _ -> "-") (match printf.vararg_pos with | Some i -> string_of_int i | _ -> "-")
*) *)

2
infer/src/clang/CType.ml
Unescape View File

@ -38,7 +38,7 @@ let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n)
let is_class typ = let is_class typ =
match typ with match typ with
| Typ.Tptr (Tstruct ((TN_csu _) as name), _) -> | Typ.Tptr (Tstruct ((TN_csu _) as name), _) ->
Core.Std.String.equal (Typename.name name) CFrontend_config.objc_class String.equal (Typename.name name) CFrontend_config.objc_class
| _ -> false | _ -> false
let rec return_type_of_function_type_ptr type_ptr = let rec return_type_of_function_type_ptr type_ptr =

2
infer/src/clang/CType_decl.ml
Unescape View File

@ -120,7 +120,7 @@ let get_superclass_list_cpp decl =
let get_translate_as_friend_decl decl_list = let get_translate_as_friend_decl decl_list =
let is_translate_as_friend_name (_, name_info) = let is_translate_as_friend_name (_, name_info) =
let translate_as_str = "infer_traits::TranslateAsType" in let translate_as_str = "infer_traits::TranslateAsType" in
string_contains translate_as_str (Ast_utils.get_qualified_name name_info) in String.is_substring ~substring:translate_as_str (Ast_utils.get_qualified_name name_info) in
let get_friend_decl_opt (decl : Clang_ast_t.decl) = match decl with let get_friend_decl_opt (decl : Clang_ast_t.decl) = match decl with
| FriendDecl (_, `Type type_ptr) -> Ast_utils.get_decl_from_typ_ptr type_ptr | FriendDecl (_, `Type type_ptr) -> Ast_utils.get_decl_from_typ_ptr type_ptr
| _ -> None in | _ -> None in

2
infer/src/clang/Capture.re
Unescape View File

@ -141,7 +141,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" clang_command biniou_fname; Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" clang_command biniou_fname;
let infer_clang_options = let infer_clang_options =
String.concat String.concat
"^" sep::"^"
( (
( (
try [Unix.getenv CLOpt.args_env_var] { try [Unix.getenv CLOpt.args_env_var] {

18
infer/src/clang/ClangCommand.re
Unescape View File

@ -37,7 +37,7 @@ let value_of_argv_option argv opt_name =>
let result' = let result' =
if (Option.is_some result) { if (Option.is_some result) {
result result
} else if (Core.Std.String.equal opt_name prev_arg) { } else if (String.equal opt_name prev_arg) {
Some arg Some arg
} else { } else {
None None
@ -50,7 +50,7 @@ let value_of_argv_option argv opt_name =>
let value_of_option {orig_argv} => value_of_argv_option orig_argv; let value_of_option {orig_argv} => value_of_argv_option orig_argv;
let has_flag {orig_argv} flag => IList.exists (Core.Std.String.equal flag) orig_argv; let has_flag {orig_argv} flag => IList.exists (String.equal flag) orig_argv;
let can_attach_ast_exporter cmd => let can_attach_ast_exporter cmd =>
has_flag cmd "-cc1" && ( has_flag cmd "-cc1" && (
@ -58,7 +58,7 @@ let can_attach_ast_exporter cmd =>
| None => | None =>
Logging.stderr "malformed -cc1 command has no \"-x\" flag!"; Logging.stderr "malformed -cc1 command has no \"-x\" flag!";
false false
| Some lang when string_is_prefix "assembler" lang => false | Some lang when String.is_prefix prefix::"assembler" lang => false
| Some _ => true | Some _ => true
} }
); );
@ -84,14 +84,14 @@ let clang_cc1_cmd_sanitizer cmd => {
/* command line options not supported by the opensource compiler or the plugins */ /* command line options not supported by the opensource compiler or the plugins */
let flags_blacklist = ["-fembed-bitcode-marker", "-fno-canonical-system-headers"]; let flags_blacklist = ["-fembed-bitcode-marker", "-fno-canonical-system-headers"];
let replace_option_arg option arg => let replace_option_arg option arg =>
if (Core.Std.String.equal option "-arch" && Core.Std.String.equal arg "armv7k") { if (String.equal option "-arch" && String.equal arg "armv7k") {
"armv7" "armv7"
/* replace armv7k arch with armv7 */ /* replace armv7k arch with armv7 */
} else if ( } else if (
Core.Std.String.equal option "-isystem" String.equal option "-isystem"
) { ) {
switch Config.clang_include_to_override { switch Config.clang_include_to_override {
| Some to_replace when Core.Std.String.equal arg to_replace => | Some to_replace when String.equal arg to_replace =>
fcp_dir /\/ "clang" /\/ "install" /\/ "lib" /\/ "clang" /\/ "4.0.0" /\/ "include" fcp_dir /\/ "clang" /\/ "install" /\/ "lib" /\/ "clang" /\/ "4.0.0" /\/ "include"
| _ => arg | _ => arg
} }
@ -110,7 +110,7 @@ let clang_cc1_cmd_sanitizer cmd => {
| [] => | [] =>
/* return non-reversed list */ /* return non-reversed list */
IList.rev (post_args_rev @ res_rev) IList.rev (post_args_rev @ res_rev)
| [flag, ...tl] when IList.mem Core.Std.String.equal flag flags_blacklist => | [flag, ...tl] when IList.mem String.equal flag flags_blacklist =>
filter_unsupported_args_and_swap_includes (flag, res_rev) tl filter_unsupported_args_and_swap_includes (flag, res_rev) tl
| [arg, ...tl] => { | [arg, ...tl] => {
let res_rev' = [replace_option_arg prev arg, ...res_rev]; let res_rev' = [replace_option_arg prev arg, ...res_rev];
@ -132,12 +132,12 @@ let command_to_run cmd => {
let mk_cmd normalizer => { let mk_cmd normalizer => {
let {exec, argv, quoting_style} = normalizer cmd; let {exec, argv, quoting_style} = normalizer cmd;
Printf.sprintf Printf.sprintf
"'%s' %s" exec (IList.map (ClangQuotes.quote quoting_style) argv |> String.concat " ") "'%s' %s" exec (IList.map (ClangQuotes.quote quoting_style) argv |> String.concat sep::" ")
}; };
if (can_attach_ast_exporter cmd) { if (can_attach_ast_exporter cmd) {
mk_cmd clang_cc1_cmd_sanitizer mk_cmd clang_cc1_cmd_sanitizer
} else if ( } else if (
string_is_prefix "clang" (Filename.basename cmd.exec) String.is_prefix prefix::"clang" (Filename.basename cmd.exec)
) { ) {
/* `clang` supports argument files and the commands can be longer than the maximum length of the /* `clang` supports argument files and the commands can be longer than the maximum length of the
command line, so put arguments in a file */ command line, so put arguments in a file */

4
infer/src/clang/ClangWrapper.re
Unescape View File

@ -37,7 +37,7 @@ let normalize (args: array string) :list action_item => {
Logging.out "clang -### invocation: %s@\n" clang_hashhashhash; Logging.out "clang -### invocation: %s@\n" clang_hashhashhash;
let normalized_commands = ref []; let normalized_commands = ref [];
let one_line line => let one_line line =>
if (string_is_prefix " \"" line) { if (String.is_prefix prefix::" \"" line) {
let cmd = let cmd =
/* massage line to remove edge-cases for splitting */ /* massage line to remove edge-cases for splitting */
"\"" ^ line ^ " \"" |> "\"" ^ line ^ " \"" |>
@ -112,7 +112,7 @@ let exe args xx_suffix => {
files. */ files. */
Logging.out Logging.out
"WARNING: `clang -### <args>` returned an empty set of commands to run and no error. Will run the original command directly:@\n %s@\n" "WARNING: `clang -### <args>` returned an empty set of commands to run and no error. Will run the original command directly:@\n %s@\n"
(String.concat " " @@ Array.to_list args) (String.concat sep::" " @@ Array.to_list args)
}; };
Process.create_process_and_wait args Process.create_process_and_wait args
} }

6
infer/src/clang/ComponentKit.ml
Unescape View File

@ -97,9 +97,9 @@ let mutable_local_vars_advice context an =
let objc_whitelist = ["NSError"] in let objc_whitelist = ["NSError"] in
match get_referenced_type qual_type with match get_referenced_type qual_type with
| Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) -> | Some CXXRecordDecl (_, ndi, _, _, _, _, _, _) ->
IList.mem Core.Std.String.equal ndi.ni_name cpp_whitelist IList.mem String.equal ndi.ni_name cpp_whitelist
| Some ObjCInterfaceDecl (_, ndi, _, _, _) -> | Some ObjCInterfaceDecl (_, ndi, _, _, _) ->
IList.mem Core.Std.String.equal ndi.ni_name objc_whitelist IList.mem String.equal ndi.ni_name objc_whitelist
| _ -> false in | _ -> false in
match an with match an with
@ -168,7 +168,7 @@ let component_with_unconventional_superclass_advice context an =
let has_conventional_superclass = let has_conventional_superclass =
let open CFrontend_config in let open CFrontend_config in
match superclass_name with match superclass_name with
| Some name when IList.mem Core.Std.String.equal name [ | Some name when IList.mem String.equal name [
ckcomponent_cl; ckcomponent_cl;
ckcomponentcontroller_cl; ckcomponentcontroller_cl;
"CKCompositeComponent"; "CKCompositeComponent";

2
infer/src/clang/InferClang.re
Unescape View File

@ -9,7 +9,7 @@
open! Utils; open! Utils;
let () = { let () = {
let xx_suffix = string_is_suffix "++" Sys.argv.(0) ? "++" : ""; let xx_suffix = String.is_suffix suffix::"++" Sys.argv.(0) ? "++" : "";
let args = Array.copy Sys.argv; let args = Array.copy Sys.argv;
ClangWrapper.exe args xx_suffix ClangWrapper.exe args xx_suffix
}; };

2
infer/src/clang/cFrontend_utils.ml
Unescape View File

@ -419,7 +419,7 @@ struct
match if_decl with match if_decl with
| Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) -> | Some Clang_ast_t.ObjCInterfaceDecl (_, ndi, _, _, _) ->
let in_list some_list = let in_list some_list =
IList.mem Core.Std.String.equal ndi.Clang_ast_t.ni_name some_list in IList.mem String.equal ndi.Clang_ast_t.ni_name some_list in
not (in_list blacklist) not (in_list blacklist)
&& (in_list ancestors && (in_list ancestors
|| is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors) || is_objc_if_descendant ~blacklist:blacklist (get_super_if if_decl) ancestors)

2
infer/src/clang/cLocation.ml
Unescape View File

@ -23,7 +23,7 @@ let source_file_in_project source_file =
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 =
IList.exists IList.exists
(fun path -> string_is_prefix path rel_source_file) (fun path -> String.is_prefix ~prefix:path rel_source_file)
Config.skip_translation_headers in Config.skip_translation_headers in
file_in_project && not (file_should_be_skipped) file_in_project && not (file_should_be_skipped)

4
infer/src/clang/cTL.ml
Unescape View File

@ -288,7 +288,7 @@ let node_to_unique_string_id an =
(* true iff an ast node is a node of type among the list tl *) (* true iff an ast node is a node of type among the list tl *)
let node_has_type tl an = let node_has_type tl an =
let an_str = node_to_string an in let an_str = node_to_string an in
IList.mem Core.Std.String.equal an_str tl IList.mem String.equal an_str tl
(* given a decl returns a stmt such that decl--->stmt via label trs *) (* given a decl returns a stmt such that decl--->stmt via label trs *)
let transition_decl_to_stmt d trs = let transition_decl_to_stmt d trs =
@ -467,7 +467,7 @@ and in_node node_type_list phi an lctx =
let holds_for_one_node n = let holds_for_one_node n =
match lctx.CLintersContext.et_evaluation_node with match lctx.CLintersContext.et_evaluation_node with
| Some id -> | Some id ->
(Core.Std.String.equal id (node_to_unique_string_id an)) && (eval_formula phi an lctx) (String.equal id (node_to_unique_string_id an)) && (eval_formula phi an lctx)
| None -> | None ->
(node_has_type [n] an) && (eval_formula phi an lctx) in (node_has_type [n] an) && (eval_formula phi an lctx) in
IList.exists holds_for_one_node node_type_list IList.exists holds_for_one_node node_type_list

4
infer/src/clang/cTrans_models.ml
Unescape View File

@ -67,7 +67,7 @@ let is_modeled_builtin funct =
funct = CFrontend_config.builtin_memset_chk funct = CFrontend_config.builtin_memset_chk
let is_modeled_attribute attr_name = let is_modeled_attribute attr_name =
IList.mem Core.Std.String.equal attr_name CFrontend_config.modeled_function_attributes IList.mem String.equal attr_name CFrontend_config.modeled_function_attributes
let get_first_param_typedef_string_opt type_ptr = let get_first_param_typedef_string_opt type_ptr =
match Ast_utils.get_desugared_type type_ptr with match Ast_utils.get_desugared_type type_ptr with
@ -93,7 +93,7 @@ let is_assert_log_s funct =
funct = CFrontend_config.assert_rtn || funct = CFrontend_config.assert_rtn ||
funct = CFrontend_config.assert_fail || funct = CFrontend_config.assert_fail ||
funct = CFrontend_config.fbAssertWithSignalAndLogFunctionHelper || funct = CFrontend_config.fbAssertWithSignalAndLogFunctionHelper ||
Utils.string_contains CFrontend_config.google_MakeCheckOpString funct String.is_substring ~substring:CFrontend_config.google_MakeCheckOpString funct
let is_assert_log_method m = let is_assert_log_method m =
m = CFrontend_config.google_LogMessageFatal m = CFrontend_config.google_LogMessageFatal

2
infer/src/eradicate/eradicate.ml
Unescape View File

@ -88,7 +88,7 @@ struct
| Some (typ_found, _, _) -> Some typ_found | Some (typ_found, _, _) -> Some typ_found
| None -> None in | None -> None in
let ret_implicitly_nullable = let ret_implicitly_nullable =
Core.Std.String.equal (PatternMatch.get_type_name ret_type) "java.lang.Void" in String.equal (PatternMatch.get_type_name ret_type) "java.lang.Void" in
State.set_node exit_node; State.set_node exit_node;
if checks.TypeCheck.check_ret_type <> [] then if checks.TypeCheck.check_ret_type <> [] then

10
infer/src/eradicate/eradicateChecks.ml
Unescape View File

@ -50,7 +50,7 @@ let classify_procedure proc_attributes =
if Models.is_modelled_nullable pn then "M" (* modelled *) if Models.is_modelled_nullable pn then "M" (* modelled *)
else if Specs.proc_is_library proc_attributes then "L" (* library *) else if Specs.proc_is_library proc_attributes then "L" (* library *)
else if not proc_attributes.ProcAttributes.is_defined then "S" (* skip *) else if not proc_attributes.ProcAttributes.is_defined then "S" (* skip *)
else if string_is_prefix "com.facebook" unique_id then "F" (* FB *) else if String.is_prefix ~prefix:"com.facebook" unique_id then "F" (* FB *)
else "?" in else "?" in
classification classification
@ -116,7 +116,7 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
let throwable_found = ref false in let throwable_found = ref false in
let typ_is_throwable = function let typ_is_throwable = function
| Typ.Tstruct (TN_csu (Class Java, _) as name) -> | Typ.Tstruct (TN_csu (Class Java, _) as name) ->
Core.Std.String.equal (Typename.name name) "java.lang.Throwable" String.equal (Typename.name name) "java.lang.Throwable"
| _ -> false in | _ -> false in
let do_instr = function let do_instr = function
| Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when | Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when
@ -133,8 +133,8 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
(* heuristic to check if the condition is the translation of try-with-resources *) (* heuristic to check if the condition is the translation of try-with-resources *)
match Printer.LineReader.from_loc linereader loc with match Printer.LineReader.from_loc linereader loc with
| Some line -> | Some line ->
not (string_contains "==" line || string_contains "!=" line) not (String.is_substring ~substring:"==" line || String.is_substring ~substring:"!=" line)
&& (string_contains "}" line) && (String.is_substring ~substring:"}" line)
&& contains_instanceof_throwable curr_pdesc node && contains_instanceof_throwable curr_pdesc node
| None -> false in | None -> false in
@ -273,7 +273,7 @@ let check_constructor_initialization tenv
let should_check_field_initialization = let should_check_field_initialization =
let in_current_class = let in_current_class =
let fld_cname = Ident.java_fieldname_get_class fn in let fld_cname = Ident.java_fieldname_get_class fn in
Core.Std.String.equal (Typename.name name) fld_cname in String.equal (Typename.name name) fld_cname in
not injector_readonly_annotated && not injector_readonly_annotated &&
PatternMatch.type_is_class ft && PatternMatch.type_is_class ft &&
in_current_class && in_current_class &&

2
infer/src/eradicate/typeCheck.ml
Unescape View File

@ -250,7 +250,7 @@ let typecheck_instr
let handle_field_access_via_temporary typestate exp = let handle_field_access_via_temporary typestate exp =
let name_is_temporary name = let name_is_temporary name =
let prefix = "$T" in let prefix = "$T" in
string_is_prefix prefix name in String.is_prefix ~prefix:prefix name in
let pvar_get_origin pvar = let pvar_get_origin pvar =
match TypeState.lookup_pvar pvar typestate with match TypeState.lookup_pvar pvar typestate with
| Some (_, ta, _) -> | Some (_, ta, _) ->

6
infer/src/harness/androidFramework.ml
Unescape View File

@ -22,8 +22,8 @@ let is_destroy_method pname =
match pname with match pname with
| Procname.Java pname_java -> | Procname.Java pname_java ->
let method_name = Procname.java_get_method pname_java in let method_name = Procname.java_get_method pname_java in
Core.Std.String.equal method_name on_destroy String.equal method_name on_destroy
|| Core.Std.String.equal method_name on_destroy_view || String.equal method_name on_destroy_view
| _ -> | _ ->
false false
@ -79,7 +79,7 @@ let is_fragment tenv tname =
(** return true if [class_name] is the name of a class that belong to the Android framework *) (** return true if [class_name] is the name of a class that belong to the Android framework *)
let is_android_lib_class class_name = let is_android_lib_class class_name =
let class_str = Typename.name class_name in let class_str = Typename.name class_name in
string_is_prefix "android" class_str || string_is_prefix "com.android" class_str String.is_prefix ~prefix:"android" class_str || String.is_prefix ~prefix:"com.android" class_str
(** given an Android framework type mangled string [lifecycle_typ] (e.g., android.app.Activity) and (** given an Android framework type mangled string [lifecycle_typ] (e.g., android.app.Activity) and
a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *)

18
infer/src/integration/CaptureCompilationDatabase.ml
Unescape View File

@ -29,8 +29,8 @@ let should_capture_file_from_index () =
(** The buck targets are assumed to start with //, aliases are not supported. *) (** The buck targets are assumed to start with //, aliases are not supported. *)
let check_args_for_targets args = let check_args_for_targets args =
if not (IList.exists (Utils.string_is_prefix "//") args) then if not (IList.exists (String.is_prefix ~prefix:"//") args) then
let args_s = String.concat " " args in let args_s = String.concat ~sep:" " args in
Process.print_error_and_exit Process.print_error_and_exit
"Error reading buck command %s. Please, pass buck targets, aliases are not allowed.\n%!" "Error reading buck command %s. Please, pass buck targets, aliases are not allowed.\n%!"
args_s args_s
@ -43,7 +43,7 @@ let add_flavor_to_targets args =
| _ -> assert false (* cannot happen *) in | _ -> assert false (* cannot happen *) in
let process_arg arg = let process_arg arg =
(* Targets are assumed to start with //, aliases are not allowed *) (* Targets are assumed to start with //, aliases are not allowed *)
if Utils.string_is_prefix "//" arg then arg ^ flavor if String.is_prefix ~prefix:"//" arg then arg ^ flavor
else arg in else arg in
IList.map process_arg args IList.map process_arg args
@ -58,7 +58,7 @@ let swap_command cmd =
let plusplus = "++" in let plusplus = "++" in
let clang = "clang" in let clang = "clang" in
let clangplusplus = "clang++" in let clangplusplus = "clang++" in
if Utils.string_is_suffix plusplus cmd then if String.is_suffix ~suffix:plusplus cmd then
Config.wrappers_dir // clangplusplus Config.wrappers_dir // clangplusplus
else else
Config.wrappers_dir // clang Config.wrappers_dir // clang
@ -75,8 +75,8 @@ let run_compilation_file compilation_database file =
let env0 = Unix.environment () in let env0 = Unix.environment () in
let found = ref false in let found = ref false in
Array.iteri (fun i key_val -> Array.iteri (fun i key_val ->
match string_split_character key_val '=' with match String.rsplit2 key_val ~on:'=' with
| Some var, args when Core.Std.String.equal var CLOpt.args_env_var -> | Some (var, args) when String.equal var CLOpt.args_env_var ->
found := true ; found := true ;
env0.(i) <- env0.(i) <-
F.sprintf "%s=%s%c--fcp-syntax-only" CLOpt.args_env_var args CLOpt.env_var_sep F.sprintf "%s=%s%c--fcp-syntax-only" CLOpt.args_env_var args CLOpt.env_var_sep
@ -113,12 +113,12 @@ let get_compilation_database_files_buck () =
(buck :: build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor) in (buck :: build :: "--config" :: "*//cxx.pch_enabled=false" :: args_with_flavor) in
Process.create_process_and_wait buck_build; Process.create_process_and_wait buck_build;
let buck_targets_list = buck :: "targets" :: "--show-output" :: args_with_flavor in let buck_targets_list = buck :: "targets" :: "--show-output" :: args_with_flavor in
let buck_targets = String.concat " " buck_targets_list in let buck_targets = String.concat ~sep:" " buck_targets_list in
try try
match fst @@ Utils.with_process_in buck_targets Std.input_list with match fst @@ Utils.with_process_in buck_targets Std.input_list with
| [] -> Logging.stdout "There are no files to process, exiting."; exit 0 | [] -> Logging.stdout "There are no files to process, exiting."; exit 0
| lines -> | lines ->
Logging.out "Reading compilation database from:@\n%s@\n" (String.concat "\n" lines); Logging.out "Reading compilation database from:@\n%s@\n" (String.concat ~sep:"\n" lines);
let scan_output compilation_database_files chan = let scan_output compilation_database_files chan =
Scanf.sscanf chan "%s %s" Scanf.sscanf chan "%s %s"
(fun target file -> StringMap.add target file compilation_database_files) in (fun target file -> StringMap.add target file compilation_database_files) in
@ -130,7 +130,7 @@ let get_compilation_database_files_buck () =
"Cannot execute %s\n%!" "Cannot execute %s\n%!"
(buck_targets ^ " " ^ (Unix.error_message err))) (buck_targets ^ " " ^ (Unix.error_message err)))
| _ -> | _ ->
let cmd = String.concat " " cmd in let cmd = String.concat ~sep:" " cmd in
Process.print_error_and_exit "Incorrect buck command: %s. Please use buck build <targets>" cmd Process.print_error_and_exit "Incorrect buck command: %s. Please use buck build <targets>" cmd
(** Compute the compilation database files. *) (** Compute the compilation database files. *)

3
infer/src/integration/ClangQuotes.re
Unescape View File

@ -34,7 +34,8 @@ let mk_arg_file prefix style args => {
let temp_dir = Config.results_dir /\/ "clang"; let temp_dir = Config.results_dir /\/ "clang";
create_dir temp_dir; create_dir temp_dir;
let file = Filename.temp_file temp_dir::temp_dir prefix ".txt"; let file = Filename.temp_file temp_dir::temp_dir prefix ".txt";
let write_args outc => output_string outc (IList.map (quote style) args |> String.concat " "); let write_args outc =>
output_string outc (IList.map (quote style) args |> String.concat sep::" ");
with_file file f::write_args |> ignore; with_file file f::write_args |> ignore;
Logging.out "Clang options stored in file %s@\n" file; Logging.out "Clang options stored in file %s@\n" file;
file file

5
infer/src/java/jClasspath.ml
Unescape View File

@ -189,10 +189,7 @@ let load_from_verbose_output () =
let classname_of_class_filename class_filename = let classname_of_class_filename class_filename =
JBasics.make_cn JBasics.make_cn (String.map ~f:(function '/' -> '.' | c -> c) class_filename)
(String.map
(function | '/' -> '.' | c -> c)
class_filename)
let extract_classnames classnames jar_filename = let extract_classnames classnames jar_filename =

3
infer/src/java/jTrans.ml
Unescape View File

@ -37,7 +37,8 @@ let fix_method_definition_line linereader proc_name loc =
| _ -> assert false in | _ -> assert false in
let method_name = let method_name =
if Procname.is_constructor proc_name then if Procname.is_constructor proc_name then
let inner_class_name cname = snd (string_split_character cname '$') in let inner_class_name cname =
match String.rsplit2 cname ~on:'$' with Some (_, icn) -> icn | None -> cname in
inner_class_name (Procname.java_get_simple_class_name proc_name_java) inner_class_name (Procname.java_get_simple_class_name proc_name_java)
else Procname.java_get_method proc_name_java in else Procname.java_get_method proc_name_java in
let regex = Str.regexp (Str.quote method_name) in let regex = Str.regexp (Str.quote method_name) in

2
infer/src/java/jTransType.ml
Unescape View File

@ -344,7 +344,7 @@ let get_class_type program tenv cn =
(** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *)
let is_autogenerated_assert_field field_name = let is_autogenerated_assert_field field_name =
Core.Std.String.equal (Ident.java_fieldname_get_field field_name) "$assertionsDisabled" String.equal (Ident.java_fieldname_get_field field_name) "$assertionsDisabled"
let is_closeable program tenv typ = let is_closeable program tenv typ =
let closeable_cn = JBasics.make_cn "java.io.Closeable" in let closeable_cn = JBasics.make_cn "java.io.Closeable" in

4
infer/src/unit/TaintTests.ml
Unescape View File

@ -41,7 +41,7 @@ module MockTrace = Trace.Make(struct
include MockTraceElem include MockTraceElem
let get site = let get site =
if string_is_prefix "SOURCE" (Procname.to_string (CallSite.pname site)) if String.is_prefix ~prefix:"SOURCE" (Procname.to_string (CallSite.pname site))
then Some site then Some site
else None else None
@ -54,7 +54,7 @@ module MockTrace = Trace.Make(struct
include MockTraceElem include MockTraceElem
let get site _ = let get site _ =
if string_is_prefix "SINK" (Procname.to_string (CallSite.pname site)) if String.is_prefix ~prefix:"SINK" (Procname.to_string (CallSite.pname site))
then [Sink.make_sink_param site 0 ~report_reachable:false] then [Sink.make_sink_param site 0 ~report_reachable:false]
else [] else []
end end

Write Preview
Loading…
Cancel
Save