Core.Std.Option

Reviewed By: cristianoc

Differential Revision: D4232435

fbshipit-source-id: a47355e
master
Josh Berdine 8 years ago committed by Facebook Github Bot
parent 4ea3410b47
commit de2e6c9d88

@ -390,7 +390,7 @@ let specialize_types_proc callee_pdesc resolved_pdesc substitutions => {
loc loc
call_flags call_flags
when call_flags.CallFlags.cf_virtual && redirected_class_name id != None => { when call_flags.CallFlags.cf_virtual && redirected_class_name id != None => {
let redirected_typ = Option.get (redirected_class_name id); let redirected_typ = Option.value_exn (redirected_class_name id);
let redirected_pname = let redirected_pname =
Procname.replace_class Procname.replace_class
(Procname.Java callee_pname_java) (extract_class_name redirected_typ) (Procname.Java callee_pname_java) (extract_class_name redirected_typ)

@ -235,7 +235,7 @@ let rec pp_ pe pp_t f e => {
| Lfield e fld _ => F.fprintf f "%a.%a" pp_exp e Ident.pp_fieldname fld | Lfield e fld _ => F.fprintf f "%a.%a" pp_exp e Ident.pp_fieldname fld
| Lindex e1 e2 => F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2 | Lindex e1 e2 => F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2
| Sizeof t l s => | Sizeof t l s =>
let pp_len f l => Option.map_default (F.fprintf f "[%a]" pp_exp) () l; let pp_len f l => Option.iter f::(F.fprintf f "[%a]" pp_exp) l;
F.fprintf f "sizeof(%a%a%a)" pp_t t pp_len l Subtype.pp s F.fprintf f "sizeof(%a%a%a)" pp_t t pp_len l Subtype.pp s
} }
}; };

@ -276,7 +276,7 @@ let zero_value_of_numerical_type_option typ =>
/** Returns the zero value of a type, for int, float and ptr types, fail otherwise */ /** Returns the zero value of a type, for int, float and ptr types, fail otherwise */
let zero_value_of_numerical_type typ => Option.get (zero_value_of_numerical_type_option typ); let zero_value_of_numerical_type typ => Option.value_exn (zero_value_of_numerical_type_option typ);
/** Make a static local name in objc */ /** Make a static local name in objc */
@ -402,7 +402,7 @@ let d_exp_list (el: list Exp.t) => L.add_print_action (L.PTexp_list, Obj.repr el
let pp_texp pe f => let pp_texp pe f =>
fun fun
| Exp.Sizeof t l s => { | Exp.Sizeof t l s => {
let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp_printenv pe)) () l; let pp_len f l => Option.iter f::(F.fprintf f "[%a]" (pp_exp_printenv pe)) l;
F.fprintf f "%a%a%a" (Typ.pp pe) t pp_len l Subtype.pp s F.fprintf f "%a%a%a" (Typ.pp pe) t pp_len l Subtype.pp s
} }
| e => (pp_exp_printenv pe) f e; | e => (pp_exp_printenv pe) f e;
@ -412,7 +412,7 @@ let pp_texp pe f =>
let pp_texp_full pe f => let pp_texp_full pe f =>
fun fun
| Exp.Sizeof t l s => { | Exp.Sizeof t l s => {
let pp_len f l => Option.map_default (F.fprintf f "[%a]" (pp_exp_printenv pe)) () l; let pp_len f l => Option.iter f::(F.fprintf f "[%a]" (pp_exp_printenv pe)) l;
F.fprintf f "%a%a%a" (Typ.pp_full pe) t pp_len l Subtype.pp s F.fprintf f "%a%a%a" (Typ.pp_full pe) t pp_len l Subtype.pp s
} }
| e => Exp.pp_printenv pe Typ.pp_full f e; | e => Exp.pp_printenv pe Typ.pp_full f e;
@ -470,7 +470,10 @@ let instr_get_exps =
| Load id e _ _ => [Exp.Var id, e] | Load id e _ _ => [Exp.Var id, e]
| Store e1 _ e2 _ => [e1, e2] | Store e1 _ e2 _ => [e1, e2]
| Prune cond _ _ _ => [cond] | Prune cond _ _ _ => [cond]
| Call ret_id e _ _ _ => [e, ...Option.map_default (fun (id, _) => [Exp.Var id]) [] ret_id] | Call ret_id e _ _ _ => [
e,
...Option.value_map f::(fun (id, _) => [Exp.Var id]) default::[] ret_id
]
| Nullify pvar _ => [Exp.Lvar pvar] | Nullify pvar _ => [Exp.Lvar pvar]
| Abstract _ => [] | Abstract _ => []
| Remove_temps temps _ => IList.map (fun id => Exp.Var id) temps | Remove_temps temps _ => IList.map (fun id => Exp.Var id) temps

@ -34,7 +34,7 @@ let print_prolog () =>
let () = { let () = {
Logging.set_log_file_identifier Logging.set_log_file_identifier
CommandLineOption.Analyze (Option.map Filename.basename Config.cluster_cmdline); CommandLineOption.Analyze (Option.map f::Filename.basename Config.cluster_cmdline);
if Config.print_builtins { if Config.print_builtins {
Builtin.print_and_exit () Builtin.print_and_exit ()
}; };

@ -188,7 +188,7 @@ let summary_values top_proc_set summary => {
vname_id: Procname.to_filename proc_name, vname_id: Procname.to_filename proc_name,
vspecs: IList.length specs, vspecs: IList.length specs,
vtime: Printf.sprintf "%.0f" stats.Specs.stats_time, vtime: Printf.sprintf "%.0f" stats.Specs.stats_time,
vto: Option.map_default pp_failure "NONE" stats.Specs.stats_failure, vto: Option.value_map f::pp_failure default::"NONE" stats.Specs.stats_failure,
vsymop: stats.Specs.symops, vsymop: stats.Specs.symops,
verr: verr:
Errlog.size (fun ekind in_footprint => ekind == Exceptions.Kerror && in_footprint) err_log, Errlog.size (fun ekind in_footprint => ekind == Exceptions.Kerror && in_footprint) err_log,
@ -1318,35 +1318,36 @@ let register_perf_stats_report () => {
}; };
let mk_format format_kind fname => let mk_format format_kind fname =>
Option.map_default (fun out_file => [(format_kind, out_file)]) [] (create_outfile fname); Option.value_map
f::(fun out_file => [(format_kind, out_file)]) default::[] (create_outfile fname);
let init_issues_format_list report_csv report_json => { let init_issues_format_list report_csv report_json => {
let csv_format = Option.map_default (mk_format Csv) [] report_csv; let csv_format = Option.value_map f::(mk_format Csv) default::[] report_csv;
let json_format = Option.map_default (mk_format Json) [] report_json; let json_format = Option.value_map f::(mk_format Json) default::[] report_json;
let tests_format = Option.map_default (mk_format Tests) [] Config.bugs_tests; let tests_format = Option.value_map f::(mk_format Tests) default::[] Config.bugs_tests;
let txt_format = Option.map_default (mk_format Text) [] Config.bugs_txt; let txt_format = Option.value_map f::(mk_format Text) default::[] Config.bugs_txt;
let xml_format = Option.map_default (mk_format Xml) [] Config.bugs_xml; let xml_format = Option.value_map f::(mk_format Xml) default::[] Config.bugs_xml;
csv_format @ json_format @ tests_format @ txt_format @ xml_format csv_format @ json_format @ tests_format @ txt_format @ xml_format
}; };
let init_procs_format_list () => { let init_procs_format_list () => {
let csv_format = Option.map_default (mk_format Csv) [] Config.procs_csv; let csv_format = Option.value_map f::(mk_format Csv) default::[] Config.procs_csv;
let xml_format = Option.map_default (mk_format Xml) [] Config.procs_xml; let xml_format = Option.value_map f::(mk_format Xml) default::[] Config.procs_xml;
csv_format @ xml_format csv_format @ xml_format
}; };
let init_calls_format_list () => { let init_calls_format_list () => {
let csv_format = Option.map_default (mk_format Csv) [] Config.calls_csv; let csv_format = Option.value_map f::(mk_format Csv) default::[] Config.calls_csv;
csv_format csv_format
}; };
let init_stats_format_list () => { let init_stats_format_list () => {
let csv_format = Option.map_default (mk_format Csv) [] Config.report; let csv_format = Option.value_map f::(mk_format Csv) default::[] Config.report;
csv_format csv_format
}; };
let init_summary_format_list () => { let init_summary_format_list () => {
let latex_format = Option.map_default (mk_format Latex) [] Config.latex; let latex_format = Option.value_map f::(mk_format Latex) default::[] Config.latex;
latex_format latex_format
}; };

@ -1114,7 +1114,8 @@ let check_junk ?original_prop pname tenv prop =
IList.iter do_entry entries; IList.iter do_entry entries;
!res in !res in
L.d_decrease_indent 1; L.d_decrease_indent 1;
let is_undefined = Option.map_default PredSymb.is_undef false alloc_attribute in let is_undefined =
Option.value_map ~f:PredSymb.is_undef ~default:false alloc_attribute in
let resource = match Errdesc.hpred_is_open_resource tenv prop hpred with let resource = match Errdesc.hpred_is_open_resource tenv prop hpred with
| Some res -> res | Some res -> res
| None -> PredSymb.Rmemory PredSymb.Mmalloc in | None -> PredSymb.Rmemory PredSymb.Mmalloc in

@ -49,7 +49,7 @@ let unregister_all_callbacks () =
let get_procedure_definition exe_env proc_name = let get_procedure_definition exe_env proc_name =
let tenv = Exe_env.get_tenv exe_env proc_name in let tenv = Exe_env.get_tenv exe_env proc_name in
Option.map Option.map
(fun proc_desc -> ~f:(fun proc_desc ->
let idenv = Idenv.create proc_desc let idenv = Idenv.create proc_desc
and language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in and language = (Procdesc.get_attributes proc_desc).ProcAttributes.language in
(idenv, tenv, proc_name, proc_desc, language)) (idenv, tenv, proc_name, proc_desc, language))
@ -81,8 +81,8 @@ let iterate_procedure_callbacks exe_env caller_pname =
Specs.add_summary proc_name summary Specs.add_summary proc_name summary
| None -> () in | None -> () in
Option.may Option.iter
(fun (idenv, tenv, proc_name, proc_desc, _) -> ~f:(fun (idenv, tenv, proc_name, proc_desc, _) ->
IList.iter IList.iter
(fun (language_opt, proc_callback) -> (fun (language_opt, proc_callback) ->
let language_matches = match language_opt with let language_matches = match language_opt with
@ -121,9 +121,9 @@ let iterate_cluster_callbacks all_procs exe_env proc_names =
(* Procedures matching the given language or all if no language is specified. *) (* Procedures matching the given language or all if no language is specified. *)
let relevant_procedures language_opt = let relevant_procedures language_opt =
Option.map_default Option.value_map
(fun l -> IList.filter (fun p -> l = get_language p) proc_names) ~f:(fun l -> IList.filter (fun p -> l = get_language p) proc_names)
proc_names ~default:proc_names
language_opt in language_opt in
IList.iter IList.iter

@ -17,7 +17,7 @@ module CLOpt = CommandLineOption
let cluster_should_be_analyzed cluster = let cluster_should_be_analyzed cluster =
let fname = DB.source_dir_to_string cluster in let fname = DB.source_dir_to_string cluster in
let in_ondemand_config = Option.map (StringSet.mem fname) Ondemand.dirs_to_analyze in let in_ondemand_config = Option.map ~f:(StringSet.mem fname) Ondemand.dirs_to_analyze in
let check_modified () = let check_modified () =
let modified = let modified =
DB.file_was_updated_after_start (DB.filename_from_string fname) in DB.file_was_updated_after_start (DB.filename_from_string fname) in

@ -407,7 +407,7 @@ and _exp_rv_dexp tenv (_seen : Exp.Set.t) node e : DExp.t option =
_exp_rv_dexp tenv seen node e1 _exp_rv_dexp tenv seen node e1
| Exp.Sizeof (typ, len, sub) -> | Exp.Sizeof (typ, len, sub) ->
if verbose then (L.d_str "exp_rv_dexp: type "; Sil.d_exp e; L.d_ln ()); if verbose then (L.d_str "exp_rv_dexp: type "; Sil.d_exp e; L.d_ln ());
Some (DExp.Dsizeof (typ, Option.map_default (_exp_rv_dexp tenv seen node) None len, sub)) Some (DExp.Dsizeof (typ, Option.bind len (_exp_rv_dexp tenv seen node), sub))
| _ -> | _ ->
if verbose then (L.d_str "exp_rv_dexp: no match for "; Sil.d_exp e; L.d_ln ()); if verbose then (L.d_str "exp_rv_dexp: no match for "; Sil.d_exp e; L.d_ln ());
None None

@ -137,7 +137,7 @@ let get_file_data exe_env pname =
(** return the source file associated to the procedure *) (** return the source file associated to the procedure *)
let get_source exe_env pname = let get_source exe_env pname =
Option.map Option.map
(fun file_data -> file_data.source) ~f:(fun file_data -> file_data.source)
(get_file_data exe_env pname) (get_file_data exe_env pname)
let file_data_to_tenv file_data = let file_data_to_tenv file_data =
@ -196,7 +196,7 @@ let iter_files f exe_env =
then seen_files_acc then seen_files_acc
else else
begin begin
Option.may (fun cfg -> f fname cfg) (file_data_to_cfg file_data); Option.iter ~f:(fun cfg -> f fname cfg) (file_data_to_cfg file_data);
SourceFile.Set.add fname seen_files_acc SourceFile.Set.add fname seen_files_acc
end in end in
ignore (Procname.Hash.fold do_file exe_env.proc_map SourceFile.Set.empty) ignore (Procname.Hash.fold do_file exe_env.proc_map SourceFile.Set.empty)

@ -239,7 +239,7 @@ let run_parallel_analysis () =
~prog:"make" ~args:( ~prog:"make" ~args:(
"-k" :: "-k" ::
"-j" :: (string_of_int Config.jobs) :: "-j" :: (string_of_int Config.jobs) ::
(Option.map_default (fun l -> ["-l"; string_of_float l]) [] Config.load_average) @ (Option.value_map ~f:(fun l -> ["-l"; string_of_float l]) ~default:[] Config.load_average) @
(if Config.debug_mode then [] else ["-s"]) (if Config.debug_mode then [] else ["-s"])
) (fun _ -> ()); ) (fun _ -> ());
Unix.chdir cwd Unix.chdir cwd

@ -186,7 +186,8 @@ module OverridesMatcher = struct
let is_matching = function let is_matching = function
| Config.Method_pattern (language, mp) -> | Config.Method_pattern (language, mp) ->
is_subtype mp.Config.class_name is_subtype mp.Config.class_name
&& Option.map_default (match_method language proc_name) false mp.Config.method_name && (Option.value_map ~f:(match_method language proc_name) ~default:false
mp.Config.method_name)
| _ -> failwith "Expecting method pattern" in | _ -> failwith "Expecting method pattern" in
IList.exists is_matching patterns IList.exists is_matching patterns

@ -1471,10 +1471,8 @@ let do_analysis exe_env =
match Exe_env.get_proc_desc exe_env proc_name with match Exe_env.get_proc_desc exe_env proc_name with
| Some pdesc -> Some pdesc | Some pdesc -> Some pdesc
| None when Config.dynamic_dispatch = `Lazy -> | None when Config.dynamic_dispatch = `Lazy ->
Option.map_default Option.bind (Specs.get_summary proc_name)
(fun summary -> summary.Specs.proc_desc_option) (fun summary -> summary.Specs.proc_desc_option)
None
(Specs.get_summary proc_name)
| None -> None in | None -> None in
let analyze_ondemand source proc_desc = let analyze_ondemand source proc_desc =
let proc_name = Procdesc.get_proc_name proc_desc in let proc_name = Procdesc.get_proc_name proc_desc in

@ -196,8 +196,8 @@ let process_merge_file deps_file =
then slink ~stats ~skiplevels infer_out_src infer_out_dst then slink ~stats ~skiplevels infer_out_src infer_out_dst
| _ -> | _ ->
() in () in
Option.may Option.iter
(fun lines -> IList.iter process_line lines) ~f:(fun lines -> IList.iter process_line lines)
(read_file deps_file); (read_file deps_file);
create_multilinks (); create_multilinks ();
L.stdout "Captured results merged.@."; L.stdout "Captured results merged.@.";

@ -23,7 +23,7 @@ let dirs_to_analyze =
StringSet.add (DB.source_dir_to_string source_dir) source_dir_set StringSet.add (DB.source_dir_to_string source_dir) source_dir_set
) )
changed_files StringSet.empty in changed_files StringSet.empty in
Option.map process_changed_files SourceFile.changed_files_set Option.map ~f:process_changed_files SourceFile.changed_files_set
type analyze_ondemand = SourceFile.t -> Procdesc.t -> unit type analyze_ondemand = SourceFile.t -> Procdesc.t -> unit
@ -117,14 +117,15 @@ let run_proc_analysis ~propagate_exceptions analyze_proc curr_pdesc callee_pdesc
incr nesting; incr nesting;
let attributes_opt = let attributes_opt =
Specs.proc_resolve_attributes callee_pname in Specs.proc_resolve_attributes callee_pname in
let source = Option.map_default let source =
(fun (attributes : ProcAttributes.t) -> Option.value_map
~f:(fun (attributes : ProcAttributes.t) ->
let attribute_pname = attributes.proc_name in let attribute_pname = attributes.proc_name in
if not (Procname.equal callee_pname attribute_pname) then if not (Procname.equal callee_pname attribute_pname) then
failwith ("ERROR: "^(Procname.to_string callee_pname) failwith ("ERROR: "^(Procname.to_string callee_pname)
^" not equal to "^(Procname.to_string attribute_pname)); ^" not equal to "^(Procname.to_string attribute_pname));
attributes.loc.file) attributes.loc.file)
SourceFile.empty ~default:SourceFile.empty
attributes_opt in attributes_opt in
let call_graph = let call_graph =
let cg = Cg.create (Some source) in let cg = Cg.create (Some source) in

@ -152,9 +152,9 @@ module NullifyTransferFunctions = struct
VarDomain.add (Var.of_id lhs_id) active_defs, to_nullify VarDomain.add (Var.of_id lhs_id) active_defs, to_nullify
| Sil.Call (lhs_id, _, _, _, _) -> | Sil.Call (lhs_id, _, _, _, _) ->
let active_defs' = let active_defs' =
Option.map_default Option.value_map
(fun (id, _) -> VarDomain.add (Var.of_id id) active_defs) ~f:(fun (id, _) -> VarDomain.add (Var.of_id id) active_defs)
active_defs ~default:active_defs
lhs_id in lhs_id in
active_defs', to_nullify active_defs', to_nullify
| Sil.Store (Exp.Lvar lhs_pvar, _, _, _) -> | Sil.Store (Exp.Lvar lhs_pvar, _, _, _) ->

@ -862,7 +862,7 @@ module Normalize = struct
| _ -> BinOp (ominus, x, y) in | _ -> BinOp (ominus, x, y) in
(* test if the extensible array at the end of [typ] has elements of type [elt] *) (* test if the extensible array at the end of [typ] has elements of type [elt] *)
let extensible_array_element_typ_equal elt typ = let extensible_array_element_typ_equal elt typ =
Option.map_default (Typ.equal elt) false Option.value_map ~f:(Typ.equal elt) ~default:false
(StructTyp.get_extensible_array_element_typ ~lookup typ) in (StructTyp.get_extensible_array_element_typ ~lookup typ) in
begin begin
match e1', e2' with match e1', e2' with
@ -1094,7 +1094,7 @@ module Normalize = struct
let texp_normalize tenv sub (exp : Exp.t) : Exp.t = match exp with let texp_normalize tenv sub (exp : Exp.t) : Exp.t = match exp with
| Sizeof (typ, len, st) -> | Sizeof (typ, len, st) ->
Sizeof (typ, Option.map (exp_normalize tenv sub) len, st) Sizeof (typ, Option.map ~f:(exp_normalize tenv sub) len, st)
| _ -> | _ ->
exp_normalize tenv sub exp exp_normalize tenv sub exp
@ -1975,7 +1975,7 @@ let rec exp_captured_ren ren (e : Exp.t) : Exp.t = match e with
| Const _ -> | Const _ ->
e e
| Sizeof (t, len, st) -> | Sizeof (t, len, st) ->
Sizeof (t, Option.map (exp_captured_ren ren) len, st) Sizeof (t, Option.map ~f:(exp_captured_ren ren) len, st)
| Cast (t, e) -> | Cast (t, e) ->
Cast (t, exp_captured_ren ren e) Cast (t, exp_captured_ren ren e)
| UnOp (op, e, topt) -> | UnOp (op, e, topt) ->

@ -394,9 +394,9 @@ end = struct
if type_opt_is_unsigned t then add_lt_minus1_e e if type_opt_is_unsigned t then add_lt_minus1_e e
| Sil.Estruct (fsel, _), t -> | Sil.Estruct (fsel, _), t ->
let get_field_type f = let get_field_type f =
Option.map_default (fun t' -> Option.bind t (fun t' ->
Option.map fst @@ StructTyp.get_field_type_and_annotation ~lookup f t' Option.map ~f:fst @@ StructTyp.get_field_type_and_annotation ~lookup f t'
) None t in ) in
IList.iter (fun (f, se) -> strexp_extract (se, get_field_type f)) fsel IList.iter (fun (f, se) -> strexp_extract (se, get_field_type f)) fsel
| Sil.Earray (len, isel, _), t -> | Sil.Earray (len, isel, _), t ->
let elt_t = match t with let elt_t = match t with

@ -432,7 +432,7 @@ let get_signature summary =
decl ^ "(" ^ !s ^ ")" decl ^ "(" ^ !s ^ ")"
let get_specs_from_preposts preposts = let get_specs_from_preposts preposts =
Option.map_default NormSpec.tospecs [] preposts Option.value_map ~f:NormSpec.tospecs ~default:[] preposts
let get_specs_from_payload summary = let get_specs_from_payload summary =
get_specs_from_preposts summary.payload.preposts get_specs_from_preposts summary.payload.preposts

@ -644,8 +644,8 @@ let resolve_and_analyze
Ondemand.analyze_proc_name ~propagate_exceptions:true caller_pdesc callee_proc_name Ondemand.analyze_proc_name ~propagate_exceptions:true caller_pdesc callee_proc_name
else else
(* Create the type sprecialized procedure description and analyze it directly *) (* Create the type sprecialized procedure description and analyze it directly *)
Option.may Option.iter
(fun specialized_pdesc -> ~f:(fun specialized_pdesc ->
Ondemand.analyze_proc_desc ~propagate_exceptions:true caller_pdesc specialized_pdesc) Ondemand.analyze_proc_desc ~propagate_exceptions:true caller_pdesc specialized_pdesc)
(match Ondemand.get_proc_desc resolved_pname with (match Ondemand.get_proc_desc resolved_pname with
| Some resolved_proc_desc -> | Some resolved_proc_desc ->
@ -653,7 +653,7 @@ let resolve_and_analyze
| None -> | None ->
begin begin
Option.map Option.map
(fun callee_proc_desc -> ~f:(fun callee_proc_desc ->
Cfg.specialize_types callee_proc_desc resolved_pname args) Cfg.specialize_types callee_proc_desc resolved_pname args)
(Ondemand.get_proc_desc callee_proc_name) (Ondemand.get_proc_desc callee_proc_name)
end) in end) in
@ -1118,7 +1118,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
Ondemand.analyze_proc_name Ondemand.analyze_proc_name
~propagate_exceptions:true current_pdesc resolved_pname; ~propagate_exceptions:true current_pdesc resolved_pname;
let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in let callee_pdesc_opt = Ondemand.get_proc_desc resolved_pname in
let ret_typ_opt = Option.map Procdesc.get_ret_type callee_pdesc_opt in let ret_typ_opt = Option.map ~f:Procdesc.get_ret_type callee_pdesc_opt in
let sentinel_result = let sentinel_result =
if !Config.curr_language = Config.Clang then if !Config.curr_language = Config.Clang then
check_variadic_sentinel_if_present check_variadic_sentinel_if_present
@ -1126,10 +1126,10 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
else [(prop_r, path)] in else [(prop_r, path)] in
let do_call (prop, path) = let do_call (prop, path) =
let resolved_summary_opt = Specs.get_summary resolved_pname in let resolved_summary_opt = Specs.get_summary resolved_pname in
if Option.map_default call_should_be_skipped true resolved_summary_opt then if Option.value_map ~f:call_should_be_skipped ~default:true resolved_summary_opt then
(* If it's an ObjC getter or setter, call the builtin rather than skipping *) (* If it's an ObjC getter or setter, call the builtin rather than skipping *)
let attrs_opt = let attrs_opt =
let attr_opt = Option.map Procdesc.get_attributes callee_pdesc_opt in let attr_opt = Option.map ~f:Procdesc.get_attributes callee_pdesc_opt in
match attr_opt, resolved_pname with match attr_opt, resolved_pname with
| Some attrs, Procname.ObjC_Cpp _ -> Some attrs | Some attrs, Procname.ObjC_Cpp _ -> Some attrs
| None, Procname.ObjC_Cpp _ -> AttributesTable.load_attributes resolved_pname | None, Procname.ObjC_Cpp _ -> AttributesTable.load_attributes resolved_pname
@ -1162,7 +1162,7 @@ let rec sym_exec tenv current_pdesc _instr (prop_: Prop.normal Prop.t) path
skip_call ~is_objc_instance_method prop path resolved_pname ret_annots skip_call ~is_objc_instance_method prop path resolved_pname ret_annots
loc ret_id ret_typ_opt n_actual_params loc ret_id ret_typ_opt n_actual_params
else else
proc_call (Option.get resolved_summary_opt) proc_call (Option.value_exn resolved_summary_opt)
(call_args prop resolved_pname n_actual_params ret_id loc) in (call_args prop resolved_pname n_actual_params ret_id loc) in
IList.flatten (IList.map do_call sentinel_result) IList.flatten (IList.map do_call sentinel_result)
) )
@ -1433,7 +1433,7 @@ and unknown_or_scan_call ~is_scan ret_type_option ret_annots
else else
(* otherwise, add undefined attribute to retvals and actuals passed by ref *) (* otherwise, add undefined attribute to retvals and actuals passed by ref *)
let exps_to_mark = let exps_to_mark =
let ret_exps = Option.map_default (fun (id, _) -> [Exp.Var id]) [] ret_id in let ret_exps = Option.value_map ~f:(fun (id, _) -> [Exp.Var id]) ~default:[] ret_id in
IList.fold_left IList.fold_left
(fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in (fun exps_to_mark (exp, _, _) -> exp :: exps_to_mark) ret_exps actuals_by_ref in
let prop_with_undef_attr = let prop_with_undef_attr =

@ -107,7 +107,7 @@ let suspend_existing_timeout ~keep_symop_total =
let resume_previous_timeout () = let resume_previous_timeout () =
let status_opt = unwind () in let status_opt = unwind () in
Option.may set_status status_opt Option.iter ~f:set_status status_opt
let exe_timeout f x = let exe_timeout f x =
let suspend_existing_timeout_and_start_new_one () = let suspend_existing_timeout_and_start_new_one () =

@ -262,7 +262,7 @@ let mk_bool ?(deprecated_no=[]) ?(default=false) ?(f=fun b -> b)
else else
"no-" ^ long "no-" ^ long
and noshort = and noshort =
Option.map (fun short -> Option.map ~f:(fun short ->
let len = String.length short in let len = String.length short in
if len > 1 && String.sub short ~pos:0 ~len:1 = "n" then if len > 1 && String.sub short ~pos:0 ~len:1 = "n" then
String.sub short ~pos:1 ~len:(len - 1) String.sub short ~pos:1 ~len:(len - 1)
@ -596,11 +596,11 @@ let parse ?(incomplete=false) ?(accept_unknown=false) ?config_file current_exe e
; ;
full_speclist := add_or_suppress_help (normalize !full_desc_list) full_speclist := add_or_suppress_help (normalize !full_desc_list)
; ;
let env_args = decode_env_to_argv (Core.Std.Option.value (Sys.getenv args_env_var) ~default:"") in let env_args = decode_env_to_argv (Option.value (Sys.getenv args_env_var) ~default:"") in
(* begin transitional support for INFERCLANG_ARGS *) (* begin transitional support for INFERCLANG_ARGS *)
let c_args = let c_args =
Str.split (Str.regexp_string (String.make 1 ':')) Str.split (Str.regexp_string (String.make 1 ':'))
(Core.Std.Option.value (Sys.getenv "INFERCLANG_ARGS") ~default:"") in (Option.value (Sys.getenv "INFERCLANG_ARGS") ~default:"") in
let env_args = c_args @ env_args in let env_args = c_args @ env_args in
(* end transitional support for INFERCLANG_ARGS *) (* end transitional support for INFERCLANG_ARGS *)
let exe_name = Sys.executable_name in let exe_name = Sys.executable_name in

@ -84,7 +84,7 @@ let run_jobs_in_parallel jobs_stack gen_prog prog_to_string =
Pervasives.incr current_jobs_count; Pervasives.incr current_jobs_count;
match Unix.fork () with match Unix.fork () with
| `In_the_child -> | `In_the_child ->
Core.Std.Option.iter dir_opt ~f:Unix.chdir ; Option.iter dir_opt ~f:Unix.chdir ;
Unix.exec ~prog ~args:(prog :: args) ~env ~use_path:false Unix.exec ~prog ~args:(prog :: args) ~env ~use_path:false
|> Unix.handle_unix_error |> Unix.handle_unix_error
|> never_returns |> never_returns

@ -140,7 +140,7 @@ let of_header header_file =
with Not_found -> None with Not_found -> None
) )
| _ -> None in | _ -> None in
Option.map from_abs_path file_opt Option.map ~f:from_abs_path file_opt
let changed_files_set = let changed_files_set =
let create_source_file path = let create_source_file path =
@ -149,8 +149,8 @@ let changed_files_set =
RelativeProjectRoot path RelativeProjectRoot path
else else
from_abs_path path in from_abs_path path in
Option.map_default read_file None Config.changed_files_index |> Option.bind Config.changed_files_index read_file |>
Option.map ( Option.map ~f:(
IList.fold_left IList.fold_left
(fun changed_files line -> (fun changed_files line ->
let source_file = create_source_file line in let source_file = create_source_file line in

@ -13,13 +13,13 @@
module Bool = Core.Std.Bool module Bool = Core.Std.Bool
module Caml = Core.Std.Caml module Caml = Core.Std.Caml
module Filename = Core.Std.Filename module Filename = Core.Std.Filename
module Fn = Core.Std.Fn
module In_channel = Core.Std.In_channel module In_channel = Core.Std.In_channel
module Int = Core.Std.Int module Int = Core.Std.Int
module Option = Core.Std.Option
module Pid = Core.Std.Pid module Pid = Core.Std.Pid
module String = Core.Std.String
module Unix = Core.Std.Unix
module Signal = Core.Std.Signal module Signal = Core.Std.Signal
module String = Core.Std.String
module Sys = struct module Sys = struct
include Core.Std.Sys include Core.Std.Sys
@ -37,6 +37,7 @@ module Sys = struct
try is_file ?follow_symlinks path try is_file ?follow_symlinks path
with Unix.Unix_error _ -> `Unknown with Unix.Unix_error _ -> `Unknown
end end
module Unix = Core.Std.Unix
module F = Format module F = Format
@ -251,12 +252,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
let string_value_or_empty_string
(string_option: string option): string =
match string_option with
| Some s -> s
| None -> ""
(** read a source file and return a list of lines, or None in case of error *) (** read a source file and return a list of lines, or None in case of error *)
let read_file fname = let read_file fname =
let res = ref [] in let res = ref [] in

@ -13,13 +13,15 @@
module Bool = Core.Std.Bool module Bool = Core.Std.Bool
module Caml = Core.Std.Caml module Caml = Core.Std.Caml
module Filename = Core.Std.Filename module Filename = Core.Std.Filename
module Fn = Core.Std.Fn
module In_channel = Core.Std.In_channel module In_channel = Core.Std.In_channel
module Int = Core.Std.Int module Int = Core.Std.Int
module Option = Core.Std.Option
module Pid = Core.Std.Pid module Pid = Core.Std.Pid
module String = Core.Std.String
module Unix = Core.Std.Unix
module Signal = Core.Std.Signal module Signal = Core.Std.Signal
module String = Core.Std.String
module Sys : module type of Core.Std.Sys module Sys : module type of Core.Std.Sys
module Unix = Core.Std.Unix
(** {2 Generic Utility Functions} *) (** {2 Generic Utility Functions} *)
@ -165,9 +167,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
(** The value of a string option or the empty string.: *)
val string_value_or_empty_string : string option -> string
(** copy a source file, return the number of lines, or None in case of error *) (** copy a source file, return the number of lines, or None in case of error *)
val copy_file : string -> string -> int option val copy_file : string -> string -> int option

@ -29,7 +29,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let is_compile_time_constructed pdesc pv = let is_compile_time_constructed pdesc pv =
let init_pname = Pvar.get_initializer_pname pv in let init_pname = Pvar.get_initializer_pname pv in
match Option.map_default (Summary.read_summary pdesc) None init_pname with match Option.bind init_pname (Summary.read_summary pdesc) with
| Some Domain.Bottom -> | Some Domain.Bottom ->
(* we analyzed the initializer for this global and found that it doesn't require any runtime (* we analyzed the initializer for this global and found that it doesn't require any runtime
initialization so cannot participate in SIOF *) initialization so cannot participate in SIOF *)
@ -112,7 +112,7 @@ let is_foreign tu_opt v =
let orig_path = SourceFile.to_abs_path orig_file in let orig_path = SourceFile.to_abs_path orig_file in
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.value_map ~f:(fun f -> not (is_orig_file f)) ~default:false (Pvar.get_source_file v)
let report_siof trace pdesc gname loc = let report_siof trace pdesc gname loc =
let tu_opt = let tu_opt =

@ -120,7 +120,7 @@ module Make (TraceDomain : AbstractDomain.S) = struct
None None
let get_trace ap tree = let get_trace ap tree =
Option.map fst (get_node ap tree) Option.map ~f:fst (get_node ap tree)
let rec access_tree_lteq ((lhs_trace, lhs_tree) as lhs) ((rhs_trace, rhs_tree) as rhs) = let rec access_tree_lteq ((lhs_trace, lhs_tree) as lhs) ((rhs_trace, rhs_tree) as rhs) =
if lhs == rhs if lhs == rhs

@ -56,8 +56,8 @@ module ST = struct
end end
let store_summary proc_name = let store_summary proc_name =
Option.may Option.iter
(fun summary -> ~f:(fun summary ->
let summary' = let summary' =
{ summary with { summary with
Specs.timestamp = summary.Specs.timestamp + 1 } in Specs.timestamp = summary.Specs.timestamp + 1 } in
@ -78,7 +78,7 @@ module ST = struct
let lookup = Tenv.lookup tenv in let lookup = Tenv.lookup tenv in
let localized_description = Localise.custom_desc_with_advice let localized_description = Localise.custom_desc_with_advice
description description
(Option.default "" advice) (Option.value ~default:"" advice)
[("always_report", string_of_bool always_report)] in [("always_report", string_of_bool always_report)] in
let exn = exception_kind kind localized_description in let exn = exception_kind kind localized_description in
let proc_attributes = Specs.pdesc_resolve_attributes proc_desc in let proc_attributes = Specs.pdesc_resolve_attributes proc_desc in
@ -602,8 +602,8 @@ let callback_print_access_to_globals { Callbacks.tenv; proc_desc; proc_name } =
None in None in
let do_instr _ = function let do_instr _ = function
| Sil.Load (_, e, _, loc) when get_global_var e <> None -> | Sil.Load (_, e, _, loc) when get_global_var e <> None ->
Option.may (fun pvar -> do_pvar true pvar loc) (get_global_var e) Option.iter ~f:(fun pvar -> do_pvar true pvar loc) (get_global_var e)
| Sil.Store (e, _, _, loc) when get_global_var e <> None -> | Sil.Store (e, _, _, loc) when get_global_var e <> None ->
Option.may (fun pvar -> do_pvar false pvar loc) (get_global_var e) Option.iter ~f:(fun pvar -> do_pvar false pvar loc) (get_global_var e)
| _ -> () in | _ -> () in
Procdesc.iter_instrs do_instr proc_desc Procdesc.iter_instrs do_instr proc_desc

@ -103,7 +103,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let kill_actuals_by_ref astate_acc = function let kill_actuals_by_ref astate_acc = function
| (Exp.Lvar pvar, Typ.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc | (Exp.Lvar pvar, Typ.Tptr _) -> Domain.kill_copies_with_var (Var.of_pvar pvar) astate_acc
| _ -> astate_acc in | _ -> astate_acc in
let astate' = Option.map_default kill_ret_id astate ret_id in let astate' = Option.value_map ~f:kill_ret_id ~default:astate ret_id in
if !Config.curr_language = Config.Java if !Config.curr_language = Config.Java
then astate' (* Java doesn't have pass-by-reference *) then astate' (* Java doesn't have pass-by-reference *)
else IList.fold_left kill_actuals_by_ref astate' actuals else IList.fold_left kill_actuals_by_ref astate' actuals

@ -46,8 +46,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| Sil.Prune (exp, _, _, _) -> | Sil.Prune (exp, _, _, _) ->
exp_add_live exp astate exp_add_live exp astate
| Sil.Call (ret_id, call_exp, params, _, _) -> | Sil.Call (ret_id, call_exp, params, _, _) ->
Option.map_default (fun (ret_id, _) -> Domain.remove (Var.of_id ret_id) astate) Option.value_map ~f:(fun (ret_id, _) -> Domain.remove (Var.of_id ret_id) astate)
astate ret_id ~default:astate ret_id
|> exp_add_live call_exp |> exp_add_live call_exp
|> IList.fold_right exp_add_live (IList.map fst params) |> IList.fold_right exp_add_live (IList.map fst params)
| Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ -> | Sil.Declare_locals _ | Remove_temps _ | Abstract _ | Nullify _ ->

@ -128,7 +128,7 @@ let get_translate_as_friend_decl decl_list =
match get_friend_decl_opt decl with match get_friend_decl_opt decl with
| Some decl -> | Some decl ->
let named_decl_tuple_opt = Clang_ast_proj.get_named_decl_tuple decl in let named_decl_tuple_opt = Clang_ast_proj.get_named_decl_tuple decl in
Option.map_default is_translate_as_friend_name false named_decl_tuple_opt Option.value_map ~f:is_translate_as_friend_name ~default:false named_decl_tuple_opt
| None -> false in | None -> false in
match get_friend_decl_opt (IList.find is_translate_as_friend_decl decl_list) with match get_friend_decl_opt (IList.find is_translate_as_friend_decl decl_list) with
| Some (Clang_ast_t.ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, _, [`Type t_ptr])) -> | Some (Clang_ast_t.ClassTemplateSpecializationDecl (_, _, _, _, _, _, _, _, [`Type t_ptr])) ->
@ -165,7 +165,7 @@ and get_record_custom_type tenv decl =
match decl with match decl with
| ClassTemplateSpecializationDecl (_, _, _, _, decl_list, _, _, _, _) | ClassTemplateSpecializationDecl (_, _, _, _, decl_list, _, _, _, _)
| CXXRecordDecl (_, _, _, _, decl_list, _, _, _) -> | CXXRecordDecl (_, _, _, _, decl_list, _, _, _) ->
Option.map (type_ptr_to_sil_type tenv) (get_translate_as_friend_decl decl_list) Option.map ~f:(type_ptr_to_sil_type tenv) (get_translate_as_friend_decl decl_list)
| _ -> None | _ -> None
and get_record_declaration_struct_type tenv decl = and get_record_declaration_struct_type tenv decl =

@ -142,12 +142,7 @@ let run_plugin_and_frontend source_path frontend clang_args => {
let infer_clang_options = let infer_clang_options =
String.concat String.concat
sep::"^" sep::"^"
( (Option.to_list (Sys.getenv CLOpt.args_env_var) @ ["--clang-biniou-file", biniou_fname]);
Core.Std.Option.to_list (Sys.getenv CLOpt.args_env_var) @ [
"--clang-biniou-file",
biniou_fname
]
);
Format.fprintf Format.fprintf
debug_script_fmt debug_script_fmt
"%s=\"%s\" %s@\n" "%s=\"%s\" %s@\n"

@ -199,7 +199,7 @@ let component_with_unconventional_superclass_advice context an =
let if_decl_opt = let if_decl_opt =
Ast_utils.get_decl_opt_with_decl_ref impl_decl_info.oidi_class_interface in Ast_utils.get_decl_opt_with_decl_ref impl_decl_info.oidi_class_interface in
if Option.is_some if_decl_opt && is_ck_context context an then if Option.is_some if_decl_opt && is_ck_context context an then
check_interface (Option.get if_decl_opt) check_interface (Option.value_exn if_decl_opt)
else else
CTL.False, None CTL.False, None
| _ -> CTL.False, None | _ -> CTL.False, None
@ -252,7 +252,8 @@ let component_with_multiple_factory_methods_advice context an =
| _ -> CTL.False, None | _ -> CTL.False, None
let in_ck_class (context: CLintersContext.context) = let in_ck_class (context: CLintersContext.context) =
Option.map_default is_component_or_controller_descendant_impl false context.current_objc_impl Option.value_map ~f:is_component_or_controller_descendant_impl ~default:false
context.current_objc_impl
&& General_utils.is_objc_extension context.translation_unit_context && General_utils.is_objc_extension context.translation_unit_context
(** Components shouldn't have side-effects in its initializer. (** Components shouldn't have side-effects in its initializer.

@ -102,7 +102,7 @@ let get_curr_class_decl_ptr curr_class =
let curr_class_to_string curr_class = let curr_class_to_string curr_class =
match curr_class with match curr_class with
| ContextCls (name, superclass, protocols) -> | ContextCls (name, superclass, protocols) ->
("class " ^ name ^ ", superclass: " ^ (Option.default "" superclass) ^ ("class " ^ name ^ ", superclass: " ^ (Option.value ~default:"" superclass) ^
", protocols: " ^ (IList.to_string (fun x -> x) protocols)) ", protocols: " ^ (IList.to_string (fun x -> x) protocols))
| ContextCategory (name, cls) -> ("category " ^ name ^ " of class " ^ cls) | ContextCategory (name, cls) -> ("category " ^ name ^ " of class " ^ cls)
| ContextProtocol name -> ("protocol " ^ name) | ContextProtocol name -> ("protocol " ^ name)

@ -211,7 +211,7 @@ struct
| CXXConversionDecl (decl_info, _, _, _, _) | CXXConversionDecl (decl_info, _, _, _, _)
| CXXDestructorDecl (decl_info, _, _, _, _) -> | CXXDestructorDecl (decl_info, _, _, _, _) ->
(* di_parent_pointer has pointer to lexical context such as class.*) (* di_parent_pointer has pointer to lexical context such as class.*)
let parent_ptr = Option.get decl_info.Clang_ast_t.di_parent_pointer in let parent_ptr = Option.value_exn decl_info.Clang_ast_t.di_parent_pointer in
let class_decl = Ast_utils.get_decl parent_ptr in let class_decl = Ast_utils.get_decl parent_ptr in
(match class_decl with (match class_decl with
| Some (CXXRecordDecl _) | Some (CXXRecordDecl _)
@ -230,7 +230,7 @@ struct
initializer *) initializer *)
let global = General_utils.mk_sil_global_var trans_unit_ctx named_decl_info vdi qt in let global = General_utils.mk_sil_global_var trans_unit_ctx named_decl_info vdi qt in
(* safe to Option.get because it's a global *) (* safe to Option.get because it's a global *)
Option.get (Pvar.get_initializer_pname global) in Option.value_exn (Pvar.get_initializer_pname global) in
let ms = CMethod_signature.make_ms procname [] Ast_expressions.create_void_type let ms = CMethod_signature.make_ms procname [] Ast_expressions.create_void_type
[] decl_info.Clang_ast_t.di_source_range false trans_unit_ctx.CFrontend_config.lang [] decl_info.Clang_ast_t.di_source_range false trans_unit_ctx.CFrontend_config.lang
None None None in None None None in

@ -454,7 +454,7 @@ struct
else else
let return_type_decl_opt = type_ptr_to_objc_interface rtp in let return_type_decl_opt = type_ptr_to_objc_interface rtp in
let return_type_decl_pointer_opt = let return_type_decl_pointer_opt =
Option.map if_decl_to_di_pointer_opt return_type_decl_opt in Option.map ~f:if_decl_to_di_pointer_opt return_type_decl_opt in
(Some type_decl_pointer) = return_type_decl_pointer_opt (Some type_decl_pointer) = return_type_decl_pointer_opt
let is_objc_factory_method if_decl meth_decl = let is_objc_factory_method if_decl meth_decl =
@ -660,7 +660,7 @@ struct
(match function_decl_info.Clang_ast_t.fdi_storage_class with (match function_decl_info.Clang_ast_t.fdi_storage_class with
| Some "static" -> | Some "static" ->
let file_opt = (fst decl_info.Clang_ast_t.di_source_range).Clang_ast_t.sl_file in let file_opt = (fst decl_info.Clang_ast_t.di_source_range).Clang_ast_t.sl_file in
Option.map_default SourceFile.to_string "" file_opt Option.value_map ~f:SourceFile.to_string ~default:"" file_opt
| _ -> "") | _ -> "")
| None -> "" in | None -> "" in
let mangled_opt = match function_decl_info_opt with let mangled_opt = match function_decl_info_opt with
@ -748,14 +748,14 @@ struct
let is_constexpr = var_decl_info.Clang_ast_t.vdi_is_const_expr in let is_constexpr = var_decl_info.Clang_ast_t.vdi_is_const_expr in
let is_pod = let is_pod =
Ast_utils.get_desugared_type qt.Clang_ast_t.qt_type_ptr Ast_utils.get_desugared_type qt.Clang_ast_t.qt_type_ptr
|> Option.map_default (function |> Fn.flip Option.bind (function
| Clang_ast_t.RecordType(_, decl_ptr) -> Ast_utils.get_decl decl_ptr | Clang_ast_t.RecordType(_, decl_ptr) -> Ast_utils.get_decl decl_ptr
| _ -> None) None | _ -> None)
|> Option.map_default (function |> Option.value_map ~default:true ~f:(function
| Clang_ast_t.CXXRecordDecl(_, _, _, _, _, _, _, {xrdi_is_pod}) | Clang_ast_t.CXXRecordDecl(_, _, _, _, _, _, _, {xrdi_is_pod})
| Clang_ast_t.ClassTemplateSpecializationDecl(_, _, _, _, _, _, _, {xrdi_is_pod}, _) -> | Clang_ast_t.ClassTemplateSpecializationDecl(_, _, _, _, _, _, _, {xrdi_is_pod}, _) ->
xrdi_is_pod xrdi_is_pod
| _ -> true) true in | _ -> true) in
Pvar.mk_global ~is_constexpr ~is_pod Pvar.mk_global ~is_constexpr ~is_pod
~is_static_local:(var_decl_info.Clang_ast_t.vdi_is_static_local) ~is_static_local:(var_decl_info.Clang_ast_t.vdi_is_static_local)
(mk_name name_string simple_name) translation_unit (mk_name name_string simple_name) translation_unit

@ -12,10 +12,11 @@ open! Utils
(** Module for function to retrieve the location (file, line, etc) of instructions *) (** Module for function to retrieve the location (file, line, etc) of instructions *)
let clang_to_sil_location trans_unit_ctx clang_loc = let clang_to_sil_location trans_unit_ctx clang_loc =
let line = Option.default (-1) clang_loc.Clang_ast_t.sl_line in let line = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_line in
let col = Option.default (-1) clang_loc.Clang_ast_t.sl_column in let col = Option.value ~default:(-1) clang_loc.Clang_ast_t.sl_column in
let file = let file =
Option.default trans_unit_ctx.CFrontend_config.source_file clang_loc.Clang_ast_t.sl_file in Option.value ~default:trans_unit_ctx.CFrontend_config.source_file
clang_loc.Clang_ast_t.sl_file in
Location.{line; col; file} Location.{line; col; file}
let source_file_in_project source_file = let source_file_in_project source_file =
@ -52,7 +53,7 @@ let should_translate trans_unit_ctx (loc_start, loc_end) decl_trans_context ~tra
let equal_header_of_current_source maybe_header = let equal_header_of_current_source maybe_header =
(* SourceFile.of_header will cache calls to filesystem *) (* SourceFile.of_header will cache calls to filesystem *)
let source_of_header_opt = SourceFile.of_header maybe_header in let source_of_header_opt = SourceFile.of_header maybe_header in
Option.map_default equal_current_source false source_of_header_opt Option.value_map ~f:equal_current_source ~default:false source_of_header_opt
in in
let file_in_project = map_file_of source_file_in_project loc_end let file_in_project = map_file_of source_file_in_project loc_end
|| map_file_of source_file_in_project loc_start in || map_file_of source_file_in_project loc_start in

@ -171,7 +171,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
| CXXConversionDecl (decl_info, _, qt, fdi, mdi), _ | CXXConversionDecl (decl_info, _, qt, fdi, mdi), _
| CXXDestructorDecl (decl_info, _, qt, fdi, mdi), _ -> | CXXDestructorDecl (decl_info, _, qt, fdi, mdi), _ ->
let procname = General_utils.procname_of_decl trans_unit_ctx meth_decl in let procname = General_utils.procname_of_decl trans_unit_ctx meth_decl in
let parent_ptr = Option.get decl_info.di_parent_pointer in let parent_ptr = Option.value_exn decl_info.di_parent_pointer in
let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt.Clang_ast_t.qt_type_ptr) in let method_decl = Cpp_Meth_decl_info (fdi, mdi, parent_ptr, qt.Clang_ast_t.qt_type_ptr) in
let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in
let ms = build_method_signature let ms = build_method_signature
@ -181,7 +181,7 @@ let method_signature_of_decl trans_unit_ctx tenv meth_decl block_data_opt =
ms, fdi.Clang_ast_t.fdi_body, (init_list_instrs @ non_null_instrs) ms, fdi.Clang_ast_t.fdi_body, (init_list_instrs @ non_null_instrs)
| ObjCMethodDecl (decl_info, _, mdi), _ -> | ObjCMethodDecl (decl_info, _, mdi), _ ->
let procname = General_utils.procname_of_decl trans_unit_ctx meth_decl in let procname = General_utils.procname_of_decl trans_unit_ctx meth_decl in
let parent_ptr = Option.get decl_info.di_parent_pointer in let parent_ptr = Option.value_exn decl_info.di_parent_pointer in
let method_decl = ObjC_Meth_decl_info (mdi, parent_ptr) in let method_decl = ObjC_Meth_decl_info (mdi, parent_ptr) in
let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in let parent_pointer = decl_info.Clang_ast_t.di_parent_pointer in
let pointer_to_property_opt = let pointer_to_property_opt =

@ -438,7 +438,7 @@ struct
coming from ASTExporter.h in facebook-clang-plugins *) coming from ASTExporter.h in facebook-clang-plugins *)
assert false) assert false)
| None -> None in | None -> None in
let function_attr_opt = Option.map_default get_deprecated_attr_arg None decl_opt in let function_attr_opt = Option.bind decl_opt get_deprecated_attr_arg in
match function_attr_opt with match function_attr_opt with
| Some attr when CTrans_models.is_modeled_attribute attr -> | Some attr when CTrans_models.is_modeled_attribute attr ->
Some (Procname.from_string_c_fun attr) Some (Procname.from_string_c_fun attr)
@ -459,7 +459,7 @@ struct
let context = trans_state.context in let context = trans_state.context in
let name_info, decl_ptr, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in
let decl_opt = Ast_utils.get_function_decl_with_body decl_ptr in let decl_opt = Ast_utils.get_function_decl_with_body decl_ptr in
Option.may (call_translation context) decl_opt; Option.iter ~f:(call_translation context) decl_opt;
let name = Ast_utils.get_qualified_name name_info in let name = Ast_utils.get_qualified_name name_info in
let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in let typ = CType_decl.type_ptr_to_sil_type context.tenv type_ptr in
let pname = let pname =
@ -511,7 +511,7 @@ struct
let sil_loc = CLocation.get_sil_location stmt_info context in let sil_loc = CLocation.get_sil_location stmt_info context in
let name_info, decl_ptr, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in let name_info, decl_ptr, type_ptr = Ast_utils.get_info_from_decl_ref decl_ref in
let decl_opt = Ast_utils.get_function_decl_with_body decl_ptr in let decl_opt = Ast_utils.get_function_decl_with_body decl_ptr in
Option.may (call_translation context) decl_opt; Option.iter ~f:(call_translation context) decl_opt;
let method_name = Ast_utils.get_unqualified_name name_info in let method_name = Ast_utils.get_unqualified_name name_info in
let class_name = Ast_utils.get_class_name_from_member name_info in let class_name = Ast_utils.get_class_name_from_member name_info in
Logging.out_debug "!!!!! Dealing with method '%s' @." method_name; Logging.out_debug "!!!!! Dealing with method '%s' @." method_name;
@ -853,7 +853,7 @@ struct
(* we cannot translate the arguments of __builtin_object_size because preprocessing copies (* we cannot translate the arguments of __builtin_object_size because preprocessing copies
them verbatim from a call to a different function, and they might be side-effecting *) them verbatim from a call to a different function, and they might be side-effecting *)
let should_translate_args = let should_translate_args =
not (Option.map_default CTrans_models.is_builtin_object_size false callee_pname_opt) in not (Option.value_map ~f:CTrans_models.is_builtin_object_size ~default:false callee_pname_opt) in
let params_stmt = if should_translate_args then params_stmt let params_stmt = if should_translate_args then params_stmt
else [] in else [] in
(* As we may have nodes coming from different parameters we need to *) (* As we may have nodes coming from different parameters we need to *)
@ -865,12 +865,14 @@ struct
let instruction' = exec_with_self_exception (exec_with_glvalue_as_reference instruction) in let instruction' = exec_with_self_exception (exec_with_glvalue_as_reference instruction) in
let res_trans_p = IList.map (instruction' trans_state_param) params_stmt in let res_trans_p = IList.map (instruction' trans_state_param) params_stmt in
res_trans_callee :: res_trans_p in res_trans_callee :: res_trans_p in
match Option.map_default (CTrans_utils.builtin_trans trans_state_pri sil_loc si function_type match Option.bind callee_pname_opt
result_trans_subexprs) None callee_pname_opt with (CTrans_utils.builtin_trans
trans_state_pri sil_loc si function_type result_trans_subexprs) with
| Some builtin -> builtin | Some builtin -> builtin
| None -> | None ->
let is_cf_retain_release = Option.map_default let is_cf_retain_release =
CTrans_models.is_cf_retain_release false callee_pname_opt in Option.value_map
~f:CTrans_models.is_cf_retain_release ~default:false callee_pname_opt in
let act_params = let act_params =
let params = IList.tl (collect_exprs result_trans_subexprs) in let params = IList.tl (collect_exprs result_trans_subexprs) in
if IList.length params = IList.length params_stmt then if IList.length params = IList.length params_stmt then
@ -884,7 +886,7 @@ struct
else act_params in else act_params in
let res_trans_call = let res_trans_call =
let cast_trans_fun = cast_trans act_params sil_loc function_type in let cast_trans_fun = cast_trans act_params sil_loc function_type in
match Option.map_default cast_trans_fun None callee_pname_opt with match Option.bind callee_pname_opt cast_trans_fun with
| Some (instr, cast_exp) -> | Some (instr, cast_exp) ->
{ empty_res_trans with { empty_res_trans with
instrs = [instr]; instrs = [instr];
@ -902,7 +904,7 @@ struct
let add_cg_edge callee_pname = let add_cg_edge callee_pname =
Cg.add_edge context.CContext.cg procname callee_pname Cg.add_edge context.CContext.cg procname callee_pname
in in
Option.may add_cg_edge callee_pname_opt; Option.iter ~f:add_cg_edge callee_pname_opt;
{ res_trans_to_parent with exps = res_trans_call.exps } { res_trans_to_parent with exps = res_trans_call.exps }
and cxx_method_construct_call_trans trans_state_pri result_trans_callee params_stmt and cxx_method_construct_call_trans trans_state_pri result_trans_callee params_stmt

@ -63,7 +63,7 @@ let pointer_attribute_of_objc_attribute attr_info =
let rec build_array_type translate_decl tenv type_ptr n_opt = let rec build_array_type translate_decl tenv type_ptr n_opt =
let array_type = type_ptr_to_sil_type translate_decl tenv type_ptr in let array_type = type_ptr_to_sil_type translate_decl tenv type_ptr in
let len = Option.map (fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in let len = Option.map ~f:(fun n -> IntLit.of_int64 (Int64.of_int n)) n_opt in
Typ.Tarray (array_type, len) Typ.Tarray (array_type, len)
and sil_type_of_attr_type translate_decl tenv type_info attr_info = and sil_type_of_attr_type translate_decl tenv type_info attr_info =

@ -259,7 +259,7 @@ let report_error_now tenv
name, name,
P.sprintf P.sprintf
"The condition %s is always %b according to the existing annotations." "The condition %s is always %b according to the existing annotations."
(string_value_or_empty_string s_opt) (Option.value s_opt ~default:"")
b, b,
Some "Consider adding a `@Nullable` annotation or removing the redundant check.", Some "Consider adding a `@Nullable` annotation or removing the redundant check.",
None, None,
@ -338,7 +338,7 @@ let report_error_now tenv
"ERADICATE_NULL_FIELD_ACCESS", "ERADICATE_NULL_FIELD_ACCESS",
P.sprintf P.sprintf
"Object `%s` could be null when accessing %s `%s`. %s" "Object `%s` could be null when accessing %s `%s`. %s"
(string_value_or_empty_string s_opt) (Option.value s_opt ~default:"")
at_index at_index
(Ident.fieldname_to_simplified_string fn) (Ident.fieldname_to_simplified_string fn)
origin_description, origin_description,
@ -351,14 +351,14 @@ let report_error_now tenv
"ERADICATE_NULL_METHOD_CALL", "ERADICATE_NULL_METHOD_CALL",
P.sprintf P.sprintf
"The value of `%s` in the call to `%s` could be null. %s" "The value of `%s` in the call to `%s` could be null. %s"
(string_value_or_empty_string s_opt) (Option.value s_opt ~default:"")
(Procname.to_simplified_string pn) (Procname.to_simplified_string pn)
origin_description origin_description
| Annotations.Present -> | Annotations.Present ->
"ERADICATE_VALUE_NOT_PRESENT", "ERADICATE_VALUE_NOT_PRESENT",
P.sprintf P.sprintf
"The value of `%s` in the call to `%s` is not @Present. %s" "The value of `%s` in the call to `%s` is not @Present. %s"
(string_value_or_empty_string s_opt) (Option.value s_opt ~default:"")
(Procname.to_simplified_string pn) (Procname.to_simplified_string pn)
origin_description in origin_description in
true, true,

@ -250,7 +250,7 @@ let search_sources () =
let load_from_arguments classes_out_path = let load_from_arguments classes_out_path =
let roots, classes = search_classes classes_out_path in let roots, classes = search_classes classes_out_path in
let split cp_option = let split cp_option =
Option.map_default split_classpath [] cp_option in Option.value_map ~f:split_classpath ~default:[] cp_option in
let combine path_list classpath = let combine path_list classpath =
IList.fold_left append_path classpath (IList.rev path_list) in IList.fold_left append_path classpath (IList.rev path_list) in
let classpath = let classpath =

@ -396,7 +396,7 @@ module Make (TaintSpecification : TaintSpec.S) = struct
astate_acc in astate_acc in
let propagations = let propagations =
TaintSpecification.handle_unknown_call callee_pname (Option.map snd ret) in TaintSpecification.handle_unknown_call callee_pname (Option.map ~f:snd ret) in
IList.fold_left handle_unknown_call_ astate propagations in IList.fold_left handle_unknown_call_ astate propagations in
let analyze_call astate_acc callee_pname = let analyze_call astate_acc callee_pname =

@ -148,7 +148,7 @@ module StructuredSil = struct
let call_unknown ret_id_str_opt arg_strs = let call_unknown ret_id_str_opt arg_strs =
let args = IList.map (fun param_str -> (var_of_str param_str, dummy_typ)) arg_strs in let args = IList.map (fun param_str -> (var_of_str param_str, dummy_typ)) arg_strs in
let ret_id = Option.map (fun (str, typ) -> (ident_of_str str, typ)) ret_id_str_opt in let ret_id = Option.map ~f:(fun (str, typ) -> (ident_of_str str, typ)) ret_id_str_opt in
make_call ret_id args make_call ret_id args
let call_unknown_no_ret arg_strs = let call_unknown_no_ret arg_strs =
@ -246,7 +246,7 @@ module Make
pdesc, assert_map pdesc, assert_map
let create_test test_program extras pp_opt test_pname _ = let create_test test_program extras pp_opt test_pname _ =
let pp_state = Option.default I.TransferFunctions.Domain.pp pp_opt in let pp_state = Option.value ~default:I.TransferFunctions.Domain.pp pp_opt in
let pdesc, assert_map = structured_program_to_cfg test_program test_pname in let pdesc, assert_map = structured_program_to_cfg test_program test_pname in
let inv_map = I.exec_pdesc (ProcData.make pdesc (Tenv.create ()) extras) in let inv_map = I.exec_pdesc (ProcData.make pdesc (Tenv.create ()) extras) in

Loading…
Cancel
Save